Advanced .Net UI

Tonight I will briefly describe a high level workflow for desktop UI. The syntactic sugar eases the difficulty of folding a sequence of asynchronous steps into a single process.

asynchronous-tap-00

When are async sequences useful?

Basically when you want to go back to the UI dispatcher to interactively report the workflow progresses.

 let tasks =
     let initStatus  = (OutLookSucces, 0)
     marked
     |> AsyncSeq.ofSeq
     |> AsyncSeq.foldAsync (fun (s,i) p -> async {
         match s with
         | OutLookSucces -> 
             let text = email_msg + "\n working on " + p.cpty.Name + ": " + (i+1).ToString() + " of " + tot.ToString()
             do! Async.SwitchToContext ctx
             self.Status <- text
             self.TaskProgress <- 100. *(float (i+1)) / (float tot)
             p.is_marked <- false
             do! Async.SwitchToThreadPool()
             return mailer p i ctx
         | OutLookException exc -> return OutLookException exc, i
         })  initStatus                

The above code is advanced but still readable. In Haskell and Category Theory they speak about a catamorphism  over an F-algebra

type StepAlgebra b = (b, b->b) the algebras, which we encode as pairs (nil, next)
data Nat = Zero | Succ Nat which is the initial algebra for the functor described above
foldSteps :: StepAlgebra b -> (Nat -> b) the catamorphisms map from Nat to b
foldSteps (nil, next) Zero = nil
foldSteps (nil, next) (Succ nat) = next $ foldSteps (nil, next) nat

view raw
Catamorphism.hs
hosted with ❤ by GitHub

 

How can I stop the workflow?

Again, it is autmagically managed by a cancellation token.

Cancellation Token

Look!

Ok, now I need some emphasis!

Start colouring the most important part of your text boxes.

 | false, true -> async {
         do! Async.SwitchToContext ctx  
         let run = new Run()
         run.Foreground <- Brushes.Red
         run.Text <- " no GBP invoices from Sap" 
         p.msg.Add(run)
         do! Async.SwitchToThreadPool()
         return OutLookSucces } |> Async.RunSynchronously

Find below a gist with the custom control for you

public class BindableTextBlock : TextBlock
{
public ObservableCollection<Inline> InlineList
{
get { return (ObservableCollection<Inline>)GetValue(InlineListProperty); }
set { SetValue(InlineListProperty, value); }
}
public static readonly DependencyProperty InlineListProperty =
DependencyProperty.Register("InlineList", typeof(ObservableCollection<Inline>), typeof(BindableTextBlock), new UIPropertyMetadata(null, OnPropertyChanged));
private static void OnPropertyChanged(DependencyObject sender, DependencyPropertyChangedEventArgs e)
{
BindableTextBlock textBlock = sender as BindableTextBlock;
ObservableCollection<Inline> list = e.NewValue as ObservableCollection<Inline>;
list.CollectionChanged += new System.Collections.Specialized.NotifyCollectionChangedEventHandler((o1,e1) => textBlock.InlineCollectionChanged(o1,e1, textBlock));
textBlock.Inlines.Clear();
foreach (Inline inline in list)
{
textBlock.Inlines.Add(inline);
}
}
private void InlineCollectionChanged(object sender, System.Collections.Specialized.NotifyCollectionChangedEventArgs e, BindableTextBlock textBlock)
{
if (e.Action == System.Collections.Specialized.NotifyCollectionChangedAction.Add)
{
int idx = e.NewItems.Count 1;
Inline inline = e.NewItems[idx] as Inline;
this.Inlines.Add(inline);
}
if (e.Action == System.Collections.Specialized.NotifyCollectionChangedAction.Remove)
{
int idx = e.OldItems.Count 1;
Inline inline = e.OldItems[idx] as Inline;
this.Inlines.Remove(inline);
}
if (e.Action == System.Collections.Specialized.NotifyCollectionChangedAction.Reset)
{
this.Inlines.Clear();
}
}
}

view raw
BindableTextBlock.cs
hosted with ❤ by GitHub

Of course you can safely mix C# and F#

One thought on “Advanced .Net UI

  1. See also
    Recursion Schemes for Higher Algebras
    https://wp.me/peToi-2uf

    And my F# port of John A De Goes “FP to the max”

    open System
    type Eff<'Ctx, 'T> = 'Ctx -> 'T
    type EffBuilder() =
    member __.Return x : Eff<'Ctx,'T> =
    fun _ -> x
    member __.Bind(f : Eff<'Ctx, 'T>, g : 'T -> Eff<'Ctx, 'S>) : Eff<'Ctx, 'S> =
    fun c -> g (f c) c
    member __.Zero() : Eff<'Ctx, unit> =
    ignore
    member __.ReturnFrom (x : Eff<'Ctx, 'T>) =
    x
    let eff = new EffBuilder()
    let getCtx<'Ctx> () : Eff<'Ctx, 'Ctx> =
    id
    let run ctx (eff : Eff<'Ctx, 'T>) =
    eff ctx
    module Logger =
    type ILogger =
    abstract Log : string -> unit
    let log (msg : string) = eff {
    let! logger = getCtx<#ILogger> ()
    logger.Log msg
    }
    let logf fmt = Printf.ksprintf log fmt
    module Reader =
    type IReader =
    abstract Read : unit -> string
    let read () = eff {
    let! reader = getCtx<#IReader> ()
    return reader.Read ()
    }
    module Producer =
    type IProducer =
    abstract Produce : int -> int
    let produce upper = eff {
    let! producer = getCtx<#IProducer> ()
    return producer.Produce upper
    }
    let askMe question name = eff {
    do! Logger.logf question name
    return! Reader.read()
    }
    let askContinue name =
    askMe "Do you want to continue, %s?" name
    let askNumber name =
    askMe "%s, guess a number!" name
    let rec checkContinue name = eff {
    let! answer = askContinue name
    do! Logger.logf "%s, you answered: %s" name answer
    match answer.ToLower() with
    | "y" -> return true
    | "n" -> return false
    | _ -> return! checkContinue name
    }
    let parseInt s = Int32.TryParse s |> function | true, x -> Some x | false, _ -> None
    let rec checkNumber name = eff {
    let! answer = askNumber name
    match parseInt answer with
    | Some n -> return n
    | _ ->
    do! Logger.logf "%s, you didn't type a number" name
    return! checkNumber name
    }
    let rec looper checker f name = eff {
    let! loop = checker name
    if loop then
    do! f name
    do! looper checker f name
    }
    let playGame name = eff {
    let! num = checkNumber name
    do! Logger.logf "Your number is %d." num
    let! guess = Producer.produce 100
    match num = guess with
    | true -> do! Logger.log "You guessed right."
    | _ -> do! Logger.logf "Wrong, the number was %d." guess
    }
    let combinedEffects() = eff {
    do! Logger.logf "What is your name?"
    let! name = Reader.read()
    do! Logger.logf "Hello %s! Welcome to the game." name
    do! playGame name
    do! looper checkContinue playGame name
    }
    type ConsoleLogger() =
    interface Logger.ILogger with
    member __.Log msg = printfn "%s" msg
    type ConsoleReader () =
    interface Reader.IReader with
    member __.Read () = Console.ReadLine ()
    type RandomProducer() =
    let r = Random()
    interface Producer.IProducer with
    member __.Produce upper =
    r.Next(0, upper)
    type combinedHandlers() =
    let logger = new ConsoleLogger() :> Logger.ILogger
    let reader = new ConsoleReader() :> Reader.IReader
    let producer = new RandomProducer() :> Producer.IProducer
    interface Logger.ILogger with
    member __.Log m = logger.Log m
    interface Reader.IReader with
    member __.Read () = reader.Read ()
    interface Producer.IProducer with
    member __.Produce upper = producer.Produce upper
    run (combinedHandlers()) (combinedEffects())
    type TestLogger() =
    let mutable output = []
    member __.show() = output
    interface Logger.ILogger with
    member __.Log msg =
    output <- output @ [msg+"\n"]
    type TestReader (test_input) =
    let mutable input = test_input
    interface Reader.IReader with
    member __.Read () =
    match input with
    | h :: l ->
    input <- l
    h
    | _ -> failwith "not enough inputs"
    type TestProducer(test_numbers) =
    let mutable numbers = test_numbers
    interface Producer.IProducer with
    member __.Produce upper =
    match numbers with
    | h :: l ->
    numbers <- l
    h
    | _ -> failwith "not enough numbers"
    type TestHandlers(data, numbers) =
    let log = new TestLogger()
    let logger = log :> Logger.ILogger
    let reader = new TestReader(data) :> Reader.IReader
    let producer = new TestProducer(numbers) :> Producer.IProducer
    member __.show() = log.show()
    interface Logger.ILogger with
    member __.Log m = logger.Log m
    interface Reader.IReader with
    member __.Read () = reader.Read ()
    interface Producer.IProducer with
    member __.Produce upper = producer.Produce upper
    let data = ["giulio";"blabla";"37";"again?";"y";"98";"n"]
    let numbers = [37;73]
    let test = TestHandlers(data, numbers)
    combinedEffects() |> run test
    test.show() |> List.fold (+) "" |> printfn "%s"

    view raw
    FP2TheMax.fs
    hosted with ❤ by GitHub

    Like

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s