Phillip Trelford's Array

POKE 36879,255

UML Sequence Diagram: F# Script

A UML Sequence diagram can be a great tool for modelling interaction:

UML sequence diagrams model the flow of logic within your system in a visual manner, enabling you both to document and validate your logic, and are commonly used for both analysis and design purposes.  Sequence diagrams are the most popular UML artifact for dynamic modeling, which focuses on identifying the behavior within your system.

Yesterday I fancied moving some hand drawn diagrams to mouse drawn form; but instead found myself battling against a somewhat stubborn and forgetful modelling tool. It left me wondering if there might be an easier way to do this; perhaps by separating the concern of model description from layout. A few moments later I had a description language using an F# class and an F# discriminated union:

type Object(name) =     
    member this.Name = name    

type SequenceAction =
    | Activate of Object
    | Deactivate of Object
    | MessageCall of string * Object * Object
    | MessageAsync of string * Object * Object

Together the Object and SequenceAction types describe an internal Domain Specific Language (DSL) for Sequence Diagrams.

The following is a simple restaurant sample definition (taken from Wikipedia) using the DSL:

let fred = Object("Fred\r\nPatron")
let bob = Object("Bob\r\nWaiter")
let hank = Object("Hank\r\nCook")
let renee = Object("Renee\r\nCashier")
let objects = [fred;bob;hank;renee]   
let actions = 
    [
    MessageCall("order food",fred,bob)
    MessageCall("order food",bob,hank)
    MessageCall("serve wine",bob,fred)
    MessageCall("pickup",hank,bob)
    MessageCall("serve food",bob,fred)
    MessageCall("pay",fred,renee)
    ]

 

Onto the layout, and the .Net Framework has the necessary batteries included to easily do this using either WPF or Silverlight with the:

To get started I used Visual Studio 2010’s WPF XAML designer for prototyping the layout. Then several hours of hacking later I had an F# script (attached) for drawing basic diagrams.

The following was generated using the simple restaurant description above:

simple restaurant uml sequence diagram sample

The colouring of the objects was achieved by extending the Object to allow arbitary dynamic properties to be set which can later be fed to the control:

type DynamicObject () =
    let properties = System.Collections.Specialized.HybridDictionary()
    member this.Item 
        with get (index:string) = properties.[index] 
        and set (index:string) (value:obj) = properties.[index] <- value
    member this.Items =        
        let keys = seq { for key in properties.Keys do yield key :?> string }
        let values = seq { for value in properties.Values do yield value }
        Seq.zip keys values

// Define dynamic lookup get and set operators
let (?) (o:DynamicObject) (property:string) = 
    o.[property]
let (?<-) (o:DynamicObject) (property:string) (value:'a) = 
    o.[property] <- value

type Object(name) =  
    inherit DynamicObject()   
    member this.Name = name    

 

The object’s background colours are set thus:

fred?Background <- Brushes.LightGreen
bob?Background <- Brushes.LightBlue
hank?Background <- Brushes.LightBlue
renee?Background <- Brushes.Pink

 

Conclusion

Whiteboard and paper are still probably the best tools for modelling sequence diagrams. However the DSL approach does have the advantage of allowing easy insertion of objects and messages without the pain of manual layout (constant erasing and redrawing).

Resources

SequenceDiagram.fsx (11.97 kb)

Implementing IObservable and extending Observable

Following on from my post yesterday on implementing loosely coupled events; the following somewhat longer F# sample provides a simple System.IObservable<T> implementation for event consumers. This means that the loosely coupled events can now be easily consumed like vanilla .Net events using the sweeter syntactic sugar of either the F# Observable module and/or the Reactive Extensions (Rx).

Also included are some helper functions for IObservable<T>. The first is tap, based on Ruby’s function of the same name, that lets you tap into an expression sequence for debugging, logging, etc. The next is invoke which is used to implement both delay and onDispatcher, and could be used to provide functions for running on a background thread, etc. May your events be loose and happening.

Happening event broking interfaces:

/// Encapsulates a triggerable instance
type ITriggerable<'a> =
    abstract member Trigger : 'a -> unit
    
/// Encapsulates an event that is both triggerable and observable    
type IHappen<'a> = 
    inherit ITriggerable<'a> 
    inherit System.IObservable<'a>
            
/// Encapsulates repository of IHappen instances
type IHappenings =
    abstract member ObtainHappening<'a> : unit -> IHappen<'a>

 

The Happening implementation:

/// Repository of IHappen instances      
type Happenings () =
    let happenings = System.Collections.Generic.Dictionary<System.Type,_>()
    let happeningsLock = obj()
    interface IHappenings with
        member this.ObtainHappening<'a> () =            
            let CreateHappening () = 
                let observers = ref []
                let add observer = 
                    observers := 
                        observer::!observers
                let remove observer = 
                    observers := 
                       !observers |> List.filter(fun x -> observer.Equals(x))
                let trigger x =
                    !observers 
                    |> List.iter (fun (observer:System.IObserver<'a>) -> 
                        observer.OnNext(x))
                let happenLock = obj()                        
                { new IHappen<'a> with                        
                    member this.Subscribe (observer:System.IObserver<'a>) =                                                                                    
                        lock happenLock (fun _ -> add observer)
                        { new System.IDisposable with
                            member this.Dispose() = 
                                lock happenLock (fun _ -> remove observer)                                
                        }                               
                    member this.Trigger (x:'a) = trigger x                       
                }               
            lock happeningsLock (fun _ ->    
                match happenings.TryGetValue(typeof<'a>) with
                | true, happen -> unbox happen
                | false, _ ->                 
                    let happen = CreateHappening ()
                    happenings.Add(typeof<'a>,box happen)
                    happen
            )                    
    end

 

Observable helper methods (tap, invoke, delay, onDispatcher):

/// Functions operating on IObservable<T>
module Observable = 
    open System
    open System.Windows.Threading
        
    /// Observer helper lifted from lib\FSharp.Core\control.fs
    [<AbstractClass>]  
    type BasicObserver<'a>() =
        let mutable stopped = false
        abstract Next : value : 'a -> unit
        abstract Error : error : exn -> unit
        abstract Completed : unit -> unit
        interface IObserver<'a> with
            member x.OnNext value = 
                if not stopped then x.Next value
            member x.OnError e = 
                if not stopped then stopped <- true
                x.Error e
            member x.OnCompleted () = 
                if not stopped then stopped <- true
                x.Completed ()
    
    /// Tap into a sequence of Observable expressions
    let tap f (w:IObservable<_>) =
        let hook (observer:IObserver<_>) =
            { new BasicObserver<_>() with  
                member x.Next(v) = 
                    match (try f v; None with | exn -> Some(exn)) with
                    | Some(exn) -> observer.OnError exn
                    | None -> observer.OnNext v                    
                member x.Error(e) = 
                    observer.OnError(e)
                member x.Completed() = 
                   observer.OnCompleted() 
            } 
        { new IObservable<_> with 
            member x.Subscribe(observer) =
                w.Subscribe (hook(observer))                    
        }
   
    /// Invoke Observer function through specified function
    let invoke f (w:IObservable<_>) =
        let hook (observer:IObserver<_>) =
            { new BasicObserver<_>() with  
                member x.Next(v) = 
                    f (fun () -> observer.OnNext v)
                member x.Error(e) = 
                    f (fun () -> observer.OnError(e))
                member x.Completed() = 
                    f (fun () -> observer.OnCompleted()) 
            } 
        { new IObservable<_> with 
            member x.Subscribe(observer) =
                w.Subscribe (hook(observer))
        }
 
    /// Delay execution of Observer function
    let delay milliseconds (observable:IObservable<'a>) =
        let f g =
            async {
                do! Async.Sleep(milliseconds)
                do g ()
            } |> Async.Start
        invoke f observable 
     
    /// Execture Observer function on Dispatcher thread
    /// <Remarks>For WPF and Silverlight</remarks> 
    let onDispatcher (observable:IObservable<'a>) =
        let dispatcher = Dispatcher.CurrentDispatcher
        let f g =
            dispatcher.BeginInvoke(Action(fun _ -> g())) |> ignore
        invoke f observable

 

To wrap up, Matthew Podwysocki’s Time Flies Like An Arrow in F# and the Reactive Extensions for .NET redux (Note: also worth checking Brian McNamara’s version):

module Test =  
    open System
    open System.Windows
    open System.Windows.Controls
    open System.Windows.Input
    open System.Windows.Media
    open System.Windows.Threading           
        
    let getPosition (element : #UIElement) (args : MouseEventArgs) =
        let point = args.GetPosition(element)
        (point.X, point.Y)    
     
    type TimeFliesWindow(happenings:IHappenings) as this =
        inherit Window()        

        let canvas=Canvas(Width=800.0,Height=400.0,Background=Brushes.White) 
        do this.Content <- canvas       

        do "F# can react to second class events!"
            |> Seq.iteri(fun i c ->  
                let s = TextBlock(Width=20.0, 
                                Height=30.0, 
                                FontSize=20.0, 
                                Text=string c, 
                                Foreground=Brushes.Black, 
                                Background=Brushes.White)
                canvas.Children.Add(s) |> ignore              
                // Consume mouse movement happenings                 
                happenings.ObtainHappening<MouseEventArgs>()                                 
                |> Observable.map (getPosition canvas)       
                |> Observable.tap (fun p -> Console.WriteLine p)
                |> Observable.delay (i * 100)
                |> Observable.onDispatcher
                |> Observable.subscribe (fun (x, y) ->                                                        
                     Canvas.SetTop(s, y) 
                     Canvas.SetLeft(s, x + float ( i * 10)))              
                |> ignore
           )        
              
    let happenings = new Happenings() :> IHappenings
    let win = TimeFliesWindow(happenings,Title="Time files like an arrow")   
    
    do  // Publish mouse movement event happenings
        let happen = happenings.ObtainHappening<MouseEventArgs>()
        win.MouseMove         
        |> Observable.subscribe happen.Trigger |> ignore

    [<STAThread>]
    do (new Application()).Run(win) |> ignore

Happening.fs (7.12 kb)

What’s happening? Loosely coupled events

So the Reactive Extensions (Rx) demonstrate some sweet syntax for handling CLR events. How about doing the same thing for loosely coupled events exposed through an Event Broker like Prism’s IEventAggregator. For example if you wanted to publish an event from any window that could be observed by any other window without them all having intimate knowledge of each other.

The following is a simple F# event broker coded on the train this morning (Note: the interface ISubscribe<’a> could be replaced by IObservable<’a>):

type ITrigger<'a> =
    abstract member Trigger : 'a -> unit
    
type ISubscribe<'a> =     
    abstract member Subscribe : ('a -> unit) -> unit 

type IHappen<'a> = 
    inherit ITrigger<'a> 
    inherit ISubscribe<'a>
            
type IHappenings =
    abstract member ObtainHappening<'a> : unit -> IHappen<'a>
        
type Happenings () =
    let happenings = System.Collections.Generic.Dictionary<System.Type,_>()
    interface IHappenings with
        member this.ObtainHappening<'a> () =
            let CreateHappening () = 
                let subscribers = ref []
                { new IHappen<'a> with                        
                    member this.Subscribe f = 
                        lock(this) (fun _ -> 
                            subscribers := f::!subscribers)
                    member this.Trigger (x) =                      
                        !subscribers |> List.iter (fun f -> f x)                       
                }
            lock (this) (fun _ ->    
                match happenings.TryGetValue(typeof<'a>) with
                | true, happen -> unbox happen
                | false, _ ->                 
                    let happen = CreateHappening ()
                    happenings.Add(typeof<'a>,box happen)
                    happen
            )                    
    end

 

Then, in Starbucks for a coffee and some higher-order functions :

module Happening =   
    open System
    open System.Windows.Threading

    let Subscribe<'a> f (happening:ISubscribe<'a>) =         
        happening.Subscribe f
    let OnDispatcher<'a> (happening:ISubscribe<'a>) =
        let dispatcher = Dispatcher.CurrentDispatcher
        { new ISubscribe<'a> with  
            member this.Subscribe f = 
                happening.Subscribe (fun x -> 
                dispatcher.Invoke(Action(fun _ -> f x)) |> ignore
            )            
        }        
    let Filter<'a> filterF (happening:ISubscribe<'a>) =
        { new ISubscribe<'a> with  
            member this.Subscribe f = 
                happening.Subscribe (fun x -> if filterF x then f x)          
        }
    let Map<'a,'b> mapF (happening:ISubscribe<'a>) =        
        { new ISubscribe<'b> with  
            member this.Subscribe f = 
                happening.Subscribe (fun x -> let y = mapF x in f y)            
        }
    let Delay<'a> milliseconds (happening:ISubscribe<'a>) =
        { new ISubscribe<'a> with  
            member this.Subscribe f = 
                happening.Subscribe (fun x -> 
                    async { 
                        do! Async.Sleep(milliseconds) 
                        f x 
                    } |> Async.Start )            
        }

 

Finally, here is Matthew Podwysocki’s cool Time Flies Like An Arrow sample rewritten to use more loosely-coupled events:

module Test =  
    open System
    open System.Windows
    open System.Windows.Controls
    open System.Windows.Input
    open System.Windows.Media
 
    let getPosition (element : #UIElement) (args : MouseEventArgs) =
        let point = args.GetPosition(element)
        (point.X, point.Y)    
     
    type TimeFliesWindow(happenings:IHappenings) as this =
        inherit Window()

        do this.Title <- "Time files like an arrow"

        let canvas = 
           Canvas(Width=800.0, Height=400.0, Background = Brushes.White) 
        do this.Content <- canvas

        let happen = happenings.ObtainHappening<MouseEventArgs>()
        do this.MouseMove         
            |> Observable.subscribe happen.Trigger |> ignore

        do "F# can react to first class events!"
            |> Seq.iteri(fun i c ->  
                let s = TextBlock(Width=20.0, 
                                Height=30.0, 
                                FontSize=20.0, 
                                Text=string c, 
                                Foreground=Brushes.Black, 
                                Background=Brushes.White)
                canvas.Children.Add(s) |> ignore              
                happen                  
                |> Happening.Map (getPosition canvas)           
                |> Happening.Delay (i * 100)
                |> Happening.OnDispatcher                            
                |> Happening.Subscribe (fun (x, y) ->                                                        
                     Canvas.SetTop(s, y) 
                     Canvas.SetLeft(s, x + float ( i * 10)))              
           )        
              
    let happenings = new Happenings()
    let win = TimeFliesWindow(happenings)
    [<STAThread>]
    do (new Application()).Run(win) |> ignore