Rash thoughts about .NET, C#, F# and Dynamics NAV.

Target? GenerateDocumentation <-

    fun _ ->

        Docu (fun p ->

            {p with

               ToolPath = @".\tools\FAKE\docu.exe"

               TemplatesPath = @".\tools\FAKE\templates"

               OutputPath = docDir })

            (buildDir + "MyAssembly.dll")

let buildDir = "./build/"

Target "Clean" (fun _ ->

  CleanDir buildDir

)

Target "Default" (fun _ ->

  trace "Hello World from FAKE"

)

"Default" <== ["Clean"]

run "Default"

let buildDir = "./build/"

Target? Clean <-

    fun _ -> CleanDir buildDir

Target? Default <-

    fun _ -> trace "Hello World from FAKE"

For? Default <- Dependency? Clean

Run? Default

let buildDir = "./build/"

let Clean = target { CleanDir buildDir }

let Default =

  target {

    trace "Hello World from FAKE"

    trace "Another line"

  }

Default <== [Clean]

Run Default

let SyncHttp (url:string) =

  let request = WebRequest.Create url

  let response = request.GetResponse()

  use stream = response.GetResponseStream()

  use reader = new StreamReader(stream)

  let result = reader.ReadToEnd()

  url,result

let AsyncHttp (url:string) =

  async { // using asynchronous workflows

    let request = WebRequest.Create url

    // async call of GetResponse

    let! response = request.AsyncGetResponse()

    use stream = response.GetResponseStream()

    use reader = new StreamReader(stream)

    // async call of ReadToEnd

    let! result = reader.AsyncReadToEnd()

    return url,result} 

/// Async<string * string> list

let downloads =

  ["http://www.google.com";

   "http://www.twitter.com";

   "http://www.nytimes.com/";

   "http://www.navision-blog.de/";

   "http://www.nba.com/"] 

    |> List.map AsyncHttp

/// IObservable<string * string>

let observableDownloads =

  downloads

    |> Seq.map Observable.ofAsync

    |> Observable.merge

observableDownloads

  |> Observable.subscribe (fun (url,result) ->

       printfn "%A: %d" url result.Length)

let line width j =

  List.init

    width

    (fun i -> if abs(width/2 – i) <= j then "*" else " ")

let tree n =

  List.init (n/2) (line n) @        // treetop

    List.init 2 (fun _ -> line n 0) // trunk

let printTree =

  tree >> Seq.iter (Seq.fold (+) "" >> printfn "%s")

printTree 11

/// <summary>

/// A Win32 native window that delegates window messages to

/// handlers. So several

/// components can use the same native window to save

/// "USER resources". This class

/// is useful when writing your own components.

/// </summary>

public sealed class EventDispatchingNativeWindow : NativeWindow

{

    private static readonly Object MyLock = new Object();

    private static EventDispatchingNativeWindow _instance;

    /// <summary>

    /// Create your own event dispatching window.

    /// </summary>

    public EventDispatchingNativeWindow()

    {

        CreateHandle(new CreateParams());

    }

    /// <summary>

    /// A global instance which can be used by components

    /// that do not need their own window.

    /// </summary>

    public static EventDispatchingNativeWindow Instance

    {

        get

        {

            lock (MyLock)

            {

                return

                  _instance ??

                     (_instance =

                       new EventDispatchingNativeWindow());

            }

        }

    }

    /// <summary>

    /// Attach your event handlers here.

    /// </summary>

    public event WndProcEventHandler EventHandler;

    /// <summary>

    /// Parse messages passed to this window and send

    /// them to the event handlers.

    /// </summary>

    /// <param name="m">A System.Windows.Forms.Message

    /// that is associated with the

    /// current Windows message.</param>

    protected override void WndProc(ref Message m)

    {

        bool handled = false;

        if (EventHandler != null)

            EventHandler(ref m, ref handled);

        if (!handled)

            base.WndProc(ref m);

    }

}

/// <summary>

/// Specifies a class that creates a global keyboard hotkey.

/// </summary>

public class GlobalHotkey

{

    private static readonly Object MyStaticLock = new Object();

    private static int _hotkeyCounter = 0xA000;

    private readonly int _hotkeyIndex;

    private readonly IntPtr _hWnd;

    /// <summary>

    /// Initializes a new instance of this class.

    /// </summary>

    /// <param name="keys">The keys.</param>

    /// <param name="ctrl">if <c>true</c> [CTRL].</param>

    /// <param name="alt">if <c>true</c> [alt].</param>

    /// <param name="shift">if <c>true</c> [shift].</param>

    /// <param name="winKey">if <c>true</c> [win key].</param>

    public GlobalHotkey(Keys keys, bool ctrl,

               bool alt, bool shift, bool winKey)

    {

        KeyCode = keys;

        Ctrl = ctrl;

        Alt = alt;

        Shift = shift;

        WindowsKey = winKey;

        EventDispatchingNativeWindow.Instance.EventHandler

                += NwEventHandler;

        lock (MyStaticLock)

        {

            _hotkeyIndex = ++_hotkeyCounter;

        }

        _hWnd = EventDispatchingNativeWindow.Instance.Handle;

        Enable();

    }

    /// <summary>

    /// The key code of the hotkey.

    /// </summary>

    public Keys KeyCode { get; private set; }

    /// <summary>

    /// Whether the shortcut includes the Control modifier.

    /// </summary>

    public bool Ctrl { get; private set; }

    /// <summary>

    /// Whether this shortcut includes the Alt modifier.

    /// </summary>

    public bool Alt { get; private set; }

    /// <summary>

    /// Whether this shortcut includes the shift modifier.

    /// </summary>

    public bool Shift { get; private set; }

    /// <summary>

    /// Whether this shortcut includes the Windows key modifier.

      /// </summary>

    public bool WindowsKey { get; private set; }

    ~GlobalHotkey()

    {

        Disable();

        EventDispatchingNativeWindow.Instance.EventHandler

            -= NwEventHandler;

    }

    /// <summary>

    /// Enables the hotkey. When the hotkey is enabled,

    /// pressing it causes a

    /// <c>HotkeyPressed</c> event instead of being

    /// handled by the active application.

    /// </summary>

    private void Enable()

    {

        // register hotkey

        int fsModifiers = 0;

        if (Shift) fsModifiers += ModShift;

        if (Ctrl) fsModifiers += ModControl;

        if (Alt) fsModifiers += ModAlt;

        if (WindowsKey) fsModifiers += ModWin;

        bool success =

           RegisterHotKey(_hWnd, _hotkeyIndex,

                fsModifiers, (int) KeyCode);

        if (!success)

            throw new

              Exception(

                "Could not register hotkey (already in use).");

    }

    /// <summary>

    /// Disables this instance.

    /// </summary>

    private void Disable()

    {

        // unregister hotkey

        UnregisterHotKey(_hWnd, _hotkeyIndex);

    }

    /// <summary>

    /// Occurs when the hotkey is pressed.

    /// </summary>

    public event EventHandler HotkeyPressed;

    private void NwEventHandler(ref Message m, ref bool handled)

    {

        if (handled) return;

        if (m.Msg != WmHotkey ||

                m.WParam.ToInt32() != _hotkeyIndex)

            return;

        if (HotkeyPressed != null)

            HotkeyPressed(this, EventArgs.Empty);

        handled = true;

    }

    #region PInvoke Declarations

    private const int ModAlt = 0×0001;

    private const int ModControl = 0×0002;

    private const int ModShift = 0×0004;

    private const int ModWin = 0×0008;

    private const int WmHotkey = 0×0312;

    [DllImport("user32.dll", SetLastError = true)]

    private static extern bool RegisterHotKey(IntPtr hWnd,

          int id, int fsModifiers, int vlc);

    [DllImport("user32.dll", SetLastError = true)]

    private static extern bool UnregisterHotKey(IntPtr hWnd,

          int id);

    #endregion

}

/// system-wide keyboard hook

let hotkey = new GlobalHotkey(Keys.Q,true,false,false,false)

let hookObserver =

  hotkey.HotkeyPressed 

    |> Observable.subscribe (fun _ -> printfn "Hotkey pressed")

type Tree<’a> =

| Leaf of ‘a

| Branch of Tree<’a> * Tree<’a> 

let tree =

  Branch(

    Leaf "Max",

    Branch(

      Leaf "Bernd",

      Branch(

        Branch(

          Leaf "Holger",

          Leaf "Ralf"),

        Branch(

          Leaf "Kerstin",

          Leaf "Steffen"))))

/// prints a binary tree

let printTree t =

  let rec print t level  =

    let indent = new String(‘ ‘, level * 2)

    match t with

    | Leaf l -> printfn "%sLeaf: %A" indent l

    | Branch (left,right) ->

        printfn "%sBranch:" indent

        print left (level+1)

        print right (level+1)

  print t 0

printfn "Unlabeled:"

printTree tree 

Unlabeled:

Branch:

  Leaf: "Max"

  Branch:

    Leaf: "Bernd"

    Branch:

      Branch:

        Leaf: "Holger"

        Leaf: "Ralf"

      Branch:

        Leaf: "Kerstin"

        Leaf: "Steffen"

let mutable label = -1

let rec labelTreeMS t =

  match t with

  | Leaf l ->

      label <- label + 1 // changing the state

      Leaf(l,label) 

  | Branch(oldL,oldR) ->

      let newL = labelTreeMS oldL

      let newR = labelTreeMS oldR

      Branch(newL,newR)        

let treeMS = labelTreeMS tree

printfn "Labeled (with global mutable state):"

printTree treeMS     

Labeled (with global mutable state):

Branch:

  Leaf: ("Max", 0)

  Branch:

    Leaf: ("Bernd", 1)

    Branch:

      Branch:

        Leaf: ("Holger", 2)

        Leaf: ("Ralf", 3)

      Branch:

        Leaf: ("Kerstin", 4)

        Leaf: ("Steffen", 5)

// non-monadic version

// passing the state around explicitly

let rec labelTreeNM t s =

  match t with

  | Leaf l -> s+1,Leaf(l,s)  // changing the state

  | Branch(oldL,oldR) ->

      let stateL,newL =

        labelTreeNM oldL s

      let stateR,newR =

        labelTreeNM oldR stateL  // passing the state around

      stateR,Branch(newL,newR)              

let _,treeNM = labelTreeNM tree 0

printfn "Labeled (non-monadic):"

printTree treeNM

/// labels a tree by using the state monad

/// (uses F#’s sugared syntax)

let rec labelTree t = state {

   match t with

   | Leaf l ->

       let! s = getState

       do! setState (s+1)  // changing the state

       return Leaf(l,s)

   | Branch(oldL,oldR) ->

      let! newL = labelTree oldL

      let! newR = labelTree oldR

      return Branch(newL,newR)}

printfn "Labeled (monadic):"

let treeM = Execute (labelTree tree) 0

printTree treeM

/// labels a tree and uses de-sugared syntax

/// (implementation looks different to labelTreeNM)

let rec labelTreeDesugared t =

   match t with

   | Leaf l -> (fun s -> Leaf(l,s),(s+1))

   | Branch(oldL,oldR) ->

       labelTreeDesugared oldL >>=

        (fun newL ->

           labelTreeDesugared oldR >>=

             (fun newR ->

                 Branch(newL,newR) |> returnS))   

module StateMonad

let (>>=) x f =

   (fun s0 ->

      let a,s = x s0

      f a s)      

let returnS a = (fun s -> a, s)

type StateBuilder() =

  member m.Bind(x, f) = x >>= f

  member m.Return a = returnS a

let state = new StateBuilder()

let getState = (fun s -> s, s)

let setState s = (fun _ -> (),s) 

let Execute m s = m s |> fst

open System.Windows.Forms

let form = new Form(Visible=true, Text="Async dict",

                       TopMost=true)

let textBox1 =

  new TextBox(

    Location = new System.Drawing.Point(12, 12),

    Size = new System.Drawing.Size(260, 20))

form.Controls.Add textBox1

let resultsBox =

  new ListBox(

    Location = new System.Drawing.Point(13, 39),

    Size = new System.Drawing.Size(259, 211))

form.Controls.Add resultsBox

// create a list with common words

// this might be very large

let data =

  ["hell"; "Hello"; "Halle"; "Html";

      "Bonn"; "Bonjour"; "Steffen"] 

// create observable for text changes

let textChanged =

  textBox1.TextChanged

    |> Observable.map (fun _ -> textBox1.Text)

module Observable

/// A Observable base class which notifies

/// all observers in parallel 

type ‘a Observable() =

  let mutable observers = []

  /// Notifies all observers in parallel about the new value

  let notifyObservers f =

    observers

      |> Seq.map (fun (observer:IObserver<’a>) –>

                         async { return f observer})

      |> Async.Parallel

      |> Async.RunSynchronously

      |> ignore

  interface IObservable<’a> with

    member observable.Subscribe(observer)  =

      // subscribe observer

      observers <- observer :: observers

      // create Disposable to unsubscribe observer later

      {new IDisposable with

         member this.Dispose() =

            observers <-

                observers |> List.filter ((<>) observer)}

  /// Notifies all observers in parallel about the new value

  member observable.OnNext value =

   notifyObservers (fun observer -> observer.OnNext value)

  /// Notifies all observers in parallel about the error

  /// and finishes all observations

  member observable.OnError error =

    notifyObservers (fun observer -> observer.OnError error)

    observers <- []

  /// Notifies all observers in parallel about the completion

  /// and finishes all observations

  member observable.Completed =

    notifyObservers (fun observer -> observer.OnCompleted())

    observers <- [] 

let wordsObservable = new Observable.Observable<_>()

let findWords prefix =

  if prefix <> "" then

    let prefix’ = prefix.ToUpper()

    for word in data do

      if word.ToUpper().StartsWith(prefix’) then

        wordsObservable.OnNext (prefix,word)

// create observers

let clean =

  textChanged

    |> Observable.subscribe (fun _ -> resultsBox.Items.Clear())

let searchForWords =

  // Every time the text changes

  // we start our wordsObservable to push words

  textChanged

    |> Observable.subscribe (fun text -> findWords text)

let wordFound =

  // subscribe to the "word found"-event

  wordsObservable   

    |> Observable.subscribe

        (fun (_,word) -> resultsBox.Items.Add word |> ignore)

open System.Windows.Forms

let form = new Form(Visible=true, TopMost=true)

/// Creates two observables

///  – left is triggered when the left mouse button is down

         and the mouse is in the area (x < 100 && y < 100)

///  – right is triggered when the right mouse button is down

         and the mouse is in the area (x < 100 && y < 100)

let left,right =

  form.MouseDown

    |> Observable.merge form.MouseMove

    |> Observable.filter (fun args -> 

          args.Button = MouseButtons.Left ||

          args.Button = MouseButtons.Right)

    |> Observable.map (fun args -> args.X, args.Y, args.Button)

    |> Observable.filter (fun (x,y,b) -> x < 100 && y < 100)

    |> Observable.partition (fun (_,_,button) -> button = MouseButtons.Left)

let leftSubscription =

  left

    |> Observable.subscribe

         (fun (x,y,_) -> printfn "Left (%d,%d)" x y)

// unsubscribe

leftSubscription.Dispose()

module Observable

/// Creates an observer with the given functions

let createObserver next error completed =

    {new System.IObserver<_> with

        member this.OnCompleted() = completed()

        member this.OnError(e) = error e

        member this.OnNext(args) = next args}

/// Subscribes an observer with the given functions

///   param1: OnNext        (T -> unit)

///   param2: OnError       (Exception -> unit)

///   param3: OnCompleted   (unit -> unit)

///   param4: observable

let subscribeComplete next error completed (observable:System.IObservable<_>) =

  createObserver next error completed

    |> observable.Subscribe

let rightSubscription =

  right

    |> Observable.subscribeComplete

         (fun (x,y,_) -> printfn "Right (%d,%d)" x y)

         (fun error   -> printfn "Error: %s" error.Message)

         (fun ()      -> printfn "Ready.")