6 people like it.
Like the snippet!
An Elmish pattern with centralized commands.
A useful pattern for I/O heavy or view-less apps.
User defines an order type to use instead of Cmd<'msg> and an "execute" function processing said orders and dispatching message.
It frees the update function from command code, centralizes I/O in a elmishy way and exempts from the Cmd module.
Inspired by the CmdMsg pattern, see:
https://fsprojects.github.io/Fabulous/Fabulous.XamarinForms/update.html#replacing-commands-with-command-messages-for-better-testability
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
|
//#r "nuget: Elmish,3.0.1"
open System
open Elmish
let description = "Count-o-matic : watch integers being counted on your console.
Press Space to start, pause or resume.
Press Enter to step while in pause.
Press +/- to increase/decrease speed while running.
Press Q to quit."
module Program =
/// <summary>
/// Program with user-defined orders instead of usual command.
/// Orders are processed by <code>execute</code> which can dispatch messages,
/// called in place of usual command processing.
/// </summary>
let mkProgramWithOrderExecute
(init: 'arg' -> 'model * 'order)
(update: 'msg -> 'model -> 'model * 'order)
(view: 'model -> Dispatch<'msg> -> 'view)
(execute: 'order -> Dispatch<'msg> -> unit) =
let convert (model, cmdMsg) =
model, cmdMsg |> execute |> Cmd.ofSub
Program.mkProgram
(init >> convert)
(fun msg model -> update msg model |> convert)
view
type Model = { Running: bool ; Count: int ; Interval: int }
type Msg =
| TimerTick
| KeyboardTick
| Toggle
| ChangeInterval of offset: int
/// user-defined order type
type Order =
| StartKeyListener
| Print of value: int
| DelayTick of delay: int
| CancelDelay
| Orders of Order list
| NoOrder
let init (running, interval) =
let model = { Running=running ; Count=0 ; Interval=interval }
model, Orders [ StartKeyListener ; if running then DelayTick 0 ]
let update msg model =
match msg, model.Running with
| TimerTick, true
| Toggle, false ->
let model' = { model with Running = true; Count = model.Count+1 }
model', Orders [ Print (model.Count+1) ; DelayTick model.Interval ]
| Toggle, true ->
{ model with Running = false }, CancelDelay
| KeyboardTick, false ->
{ model with Count = model.Count+1 }, Print (model.Count+1)
| ChangeInterval x, true ->
{ model with Interval = model.Interval+x |> min 2500 |> max 50 }, NoOrder
| KeyboardTick, true | ChangeInterval _, false | TimerTick, false ->
model, NoOrder
/// Function executing orders, with a dispatch function as second argument.
let rec execute order dispatch =
match order with
| StartKeyListener ->
async {
seq { while true do (Console.ReadKey true).KeyChar }
|> Seq.takeWhile (fun key -> key <> 'q' && key <> 'Q') // press q to quit
|> Seq.iter (function
| ' ' -> dispatch Toggle
| '\013' -> dispatch KeyboardTick // Enter key
| '-' -> dispatch (ChangeInterval 50)
| '+' -> dispatch (ChangeInterval -50)
| _ -> ())
Async.CancelDefaultToken () }
|> Async.StartImmediate
| Print value -> Console.WriteLine value
| DelayTick delay ->
async { do! Async.Sleep delay
dispatch TimerTick }
|> Async.Start
| CancelDelay -> Async.CancelDefaultToken ()
| Orders orders -> for order in orders do execute order dispatch
| NoOrder -> ()
let view _ _ = ()
Console.WriteLine description
Program.mkProgramWithOrderExecute init update view execute
|> Program.runWith (false, 350)
|
namespace System
namespace Elmish
val description : string
Multiple items
module Program
from Elmish
--------------------
type Program<'arg,'model,'msg,'view> =
private { init: 'arg -> 'model * Cmd<'msg>
update: 'msg -> 'model -> 'model * Cmd<'msg>
subscribe: 'model -> Cmd<'msg>
view: 'model -> Dispatch<'msg> -> 'view
setState: 'model -> Dispatch<'msg> -> unit
onError: string * exn -> unit
syncDispatch: Dispatch<'msg> -> Dispatch<'msg> }
val mkProgramWithOrderExecute : init:('arg' -> 'model * 'order) -> update:('msg -> 'model -> 'model * 'order) -> view:('model -> Dispatch<'msg> -> 'view) -> execute:('order -> Dispatch<'msg> -> unit) -> Program<'arg','model,'msg,'view>
<summary>
Program with user-defined orders instead of usual command.
Orders are processed by <code>execute</code> which can dispatch messages,
called in place of usual command processing.
</summary>
val init : ('arg' -> 'model * 'order)
val update : ('msg -> 'model -> 'model * 'order)
val view : ('model -> Dispatch<'msg> -> 'view)
type Dispatch<'msg> = 'msg -> unit
val execute : ('order -> Dispatch<'msg> -> unit)
type unit = Unit
val convert : ('a * 'order -> 'a * Cmd<'msg>)
val model : 'a
val cmdMsg : 'order
Multiple items
module Cmd
from Elmish
--------------------
type Cmd<'msg> = Sub<'msg> list
val ofSub : sub:Sub<'msg> -> Cmd<'msg>
val mkProgram : init:('arg -> 'model * Cmd<'msg>) -> update:('msg -> 'model -> 'model * Cmd<'msg>) -> view:('model -> Dispatch<'msg> -> 'view) -> Program<'arg,'model,'msg,'view>
val msg : 'msg
val model : 'model
type Model =
{ Running: bool
Count: int
Interval: int }
Model.Running: bool
type bool = Boolean
Model.Count: int
Multiple items
val int : value:'T -> int (requires member op_Explicit)
--------------------
type int = int32
--------------------
type int<'Measure> = int
Model.Interval: int
type Msg =
| TimerTick
| KeyboardTick
| Toggle
| ChangeInterval of offset: int
union case Msg.TimerTick: Msg
union case Msg.KeyboardTick: Msg
union case Msg.Toggle: Msg
union case Msg.ChangeInterval: offset: int -> Msg
type Order =
| StartKeyListener
| Print of value: int
| DelayTick of delay: int
| CancelDelay
| Orders of Order list
| NoOrder
user-defined order type
union case Order.StartKeyListener: Order
union case Order.Print: value: int -> Order
union case Order.DelayTick: delay: int -> Order
union case Order.CancelDelay: Order
union case Order.Orders: Order list -> Order
type 'T list = List<'T>
union case Order.NoOrder: Order
val init : running:bool * interval:int -> Model * Order
val running : bool
val interval : int
val model : Model
val update : msg:Msg -> model:Model -> Model * Order
val msg : Msg
val model' : Model
val x : int
val min : e1:'T -> e2:'T -> 'T (requires comparison)
val max : e1:'T -> e2:'T -> 'T (requires comparison)
val execute : order:Order -> dispatch:(Msg -> unit) -> unit
Function executing orders, with a dispatch function as second argument.
val order : Order
val dispatch : (Msg -> unit)
val async : AsyncBuilder
Multiple items
val seq : sequence:seq<'T> -> seq<'T>
--------------------
type seq<'T> = Collections.Generic.IEnumerable<'T>
type Console =
static member BackgroundColor : ConsoleColor with get, set
static member Beep : unit -> unit + 1 overload
static member BufferHeight : int with get, set
static member BufferWidth : int with get, set
static member CapsLock : bool
static member Clear : unit -> unit
static member CursorLeft : int with get, set
static member CursorSize : int with get, set
static member CursorTop : int with get, set
static member CursorVisible : bool with get, set
...
Console.ReadKey() : ConsoleKeyInfo
Console.ReadKey(intercept: bool) : ConsoleKeyInfo
module Seq
from Microsoft.FSharp.Collections
val takeWhile : predicate:('T -> bool) -> source:seq<'T> -> seq<'T>
val key : char
val iter : action:('T -> unit) -> source:seq<'T> -> unit
Multiple items
type Async =
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task -> Async<unit>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member Choice : computations:seq<Async<'T option>> -> Async<'T option>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
...
--------------------
type Async<'T> =
static member Async.CancelDefaultToken : unit -> unit
static member Async.StartImmediate : computation:Async<unit> * ?cancellationToken:Threading.CancellationToken -> unit
val value : int
Console.WriteLine() : unit
(+0 other overloads)
Console.WriteLine(value: string) : unit
(+0 other overloads)
Console.WriteLine(value: obj) : unit
(+0 other overloads)
Console.WriteLine(value: uint64) : unit
(+0 other overloads)
Console.WriteLine(value: int64) : unit
(+0 other overloads)
Console.WriteLine(value: uint32) : unit
(+0 other overloads)
Console.WriteLine(value: int) : unit
(+0 other overloads)
Console.WriteLine(value: float32) : unit
(+0 other overloads)
Console.WriteLine(value: float) : unit
(+0 other overloads)
Console.WriteLine(value: decimal) : unit
(+0 other overloads)
val delay : int
static member Async.Sleep : millisecondsDueTime:int -> Async<unit>
static member Async.Start : computation:Async<unit> * ?cancellationToken:Threading.CancellationToken -> unit
val orders : Order list
val view : 'a -> 'b -> unit
Multiple items
module Program
from Script
--------------------
module Program
from Elmish
--------------------
type Program<'arg,'model,'msg,'view> =
private { init: 'arg -> 'model * Cmd<'msg>
update: 'msg -> 'model -> 'model * Cmd<'msg>
subscribe: 'model -> Cmd<'msg>
view: 'model -> Dispatch<'msg> -> 'view
setState: 'model -> Dispatch<'msg> -> unit
onError: string * exn -> unit
syncDispatch: Dispatch<'msg> -> Dispatch<'msg> }
val runWith : arg:'arg -> program:Program<'arg,'model,'msg,'view> -> unit
More information