F# Computation Expression to build state and defer execution - f#

I am looking to build a computation expression where I can express the following:
let x = someComputationExpression {
do! "Message 1"
printfn "something 1"
do! "Message 2"
printfn "something 2"
do! "Message 3"
printfn "something 3"
let lastValue = 4
do! "Message 4"
// need to reference values across `do!`
printfn "something %s" lastValue
}
and be able to take from x a list:
[| "Message 1"
"Message 2"
"Message 3"
"Message 4" |]
without printfn ever getting called, but with the ability to later execute it (if that makes sense).
It doesn't need to be with the do! keyword, it could be yield or return, whatever is required for it to work.
To put it another way, I want to be able to collect some state in a computation express, and queue up work (the printfns) that can be executed later.
I have tried a few things, but am not sure it's possible.

It's a bit hard to figure out a precise solution from the OP question. Instead I am going to post some code that the OP perhaps can adjust to the needs.
I define Result and ResultGenerator
type Result =
| Direct of string
| Delayed of (unit -> unit)
type ResultGenerator<'T> = G of (Result list -> 'T*Result list )
The generator produces a value and a list of direct and delayed values, the direct values are the string list above but intermingled with them are the delayed values. I like returning intermingled so that the ordering is preserved.
Note this is a version of what is sometimes called a State monad.
Apart from the class CE components like bind and Builders I created two functions direct and delayed.
direct is used to create a direct value and delayed a delayed one (takes a function)
let direct v : ResultGenerator<_> =
G <| fun rs ->
(), Direct v::rs
let delayed d : ResultGenerator<_> =
G <| fun rs ->
(), Delayed d::rs
To improve the readability I defined delayed trace functions:
let trace m : ResultGenerator<_> =
G <| fun rs ->
(), Delayed (fun () -> printfn "%s" m)::rs
let tracef fmt = kprintf trace fmt
From an example generator:
let test =
builder {
do! direct "Hello"
do! tracef "A trace:%s" "!"
do! direct "There"
return 123
}
The following result was achieved:
(123, [Direct "Hello"; Delayed <fun:trace#37-1>; Direct "There"])
(Delayed will print the trace when executed).
Hope this can give some ideas on how to attack the actual problem.
Full source:
open FStharp.Core.Printf
type Result =
| Direct of string
| Delayed of (unit -> unit)
type ResultGenerator<'T> = G of (Result list -> 'T*Result list )
let value v : ResultGenerator<_> =
G <| fun rs ->
v, rs
let bind (G t) uf : ResultGenerator<_> =
G <| fun rs ->
let tv, trs = t rs
let (G u) = uf tv
u trs
let combine (G t) (G u) : ResultGenerator<_> =
G <| fun rs ->
let _, trs = t rs
u trs
let direct v : ResultGenerator<_> =
G <| fun rs ->
(), Direct v::rs
let delayed d : ResultGenerator<_> =
G <| fun rs ->
(), Delayed d::rs
let trace m : ResultGenerator<_> =
G <| fun rs ->
(), Delayed (fun () -> printfn "%s" m)::rs
let tracef fmt = kprintf trace fmt
type Builder() =
class
member x.Bind (t, uf) = bind t uf
member x.Combine (t, u) = combine t u
member x.Return v = value v
member x.ReturnFrom t = t : ResultGenerator<_>
end
let run (G t) =
let v, rs = t []
v, List.rev rs
let builder = Builder ()
let test =
builder {
do! direct "Hello"
do! tracef "A trace:%s" "!"
do! direct "There"
return 123
}
[<EntryPoint>]
let main argv =
run test |> printfn "%A"
0

Related

How to use bind and map in place of nested matches

F# 6.0.3
I have seen some solutions on Google that are close to what I need; but being a Newbie I can't quite get how to use bind and map to get the solution.
I have many working procedures of the following format:
Example #1:
let saveAllDiagnosis =
let savealldiagnosis = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.AllDiagnosisList
|> List.iter ( fun dx -> match dx.Key with
| None -> ()
| Some k -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
savealldiagnosis
Example #2
let saveEncounterDiagnosis =
let savedx = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.BillingDiagnosisList |> List.iter ( fun dx -> Async.RunSynchronously (saveDxAsync id dx))
savedx
As can be seen, these are nested methods with almost identical behavior--differing only in the async procedure being called and the initializing list. What I would like to do is something along the lines of:
let runProcedures (fn: Model->Async) Model = ????
That is, a single procedue that encapsulates everything except the Async method and it's parameters but manages all the "None"s in a better way.
I hope my intent is clear.
TIA
If you are happy with using exceptions, then you do not even need railway-oriented programming (ROP). ROP is useful for more complex validation tasks, but I think exceptions are often perfectly reasonable and easy way of handling errors. In your case, you could define a helper that extracts a value of option<'T> or fails with a given error message:
let orFailWith msg opt =
match opt with
| Some v -> v
| None -> failwithf "%s" msg
Using this, you can then rewrite your code as follows:
let saveAllDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.AllDiagnosisList do
dx.Key |> Option.iter (fun k ->
editAllDiagnosisInPreviousEncountersAsync id dx |> Async.RunSynchronously)
let saveEncounterDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.BillingDiagnosisList do
saveDxAsync id dx |> Async.RunSynchronously
As I do not know the broader context of this, it is hard to say more - your code is imperative, but that may be perfectly fine if you are following the sandwich pattern.
Using mentioned ROP code can be rewritten as such. Result is used to track error and throw it at the end of pipeline. With current design is possible to avoid exceptions by just logging error instead of throwing at before last line.
type Encounter = { EncounterId : int option }
type Diagnostic = { Key : int option }
type Thing = {
Encounter : Encounter option
AllDiagnosisList : Diagnostic list
}
let editAllDiagnosisInPreviousEncountersAsync id diag = async { return () }
module Result =
let ofOption err opt =
match opt with
| Some v -> Ok v
| None -> Error err
let join res =
match res with
| Error v
| Ok v -> v
let saveAllDiagnosis m =
m.Encounter
|> Result.ofOption "No encounter found" // get value from option or log error
|> Result.map (fun e -> e.EncounterId)
|> Result.bind (Result.ofOption "No Encounter id found") // get EncounterId or log error
|> Result.map (fun id -> (
m.AllDiagnosisList
|> Seq.where (fun dx -> dx.Key.IsSome)
|> Seq.iter (fun dx -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
))
|> Result.mapError failwith // throw error
|> Result.join // Convert Result<unit, unit> into unit
The solutions posted above are very helpful to this newbie. But adding my own two cents worth, I going with this:
let _deleteDxFromEncounterAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromEncounterAsync encounterId dx.Description
let _deleteDxFromAllPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromAllPreviousEncountersAsync encounterId dx.Description
let _saveDxAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = saveDxAsync encounterId dx
let _editAllDiagnosisInPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = editAllDiagnosisInPreviousEncountersAsync encounterId dx
let listchk (dxs:Diagnosis list) : Diagnosis list option =
match dxs with
| [] -> None
| _ -> Some dxs
let _save (fn:int -> Diagnosis-> Async<unit>) (dxs:Diagnosis list) : unit =
match dxs |> listchk, m.Encounter |> Option.bind (fun v -> v.EncounterId) with
| Some dxs, Some id -> dxs |> List.iter (fun dx -> Async.RunSynchronously(fn id dx))
| _,_ -> failwith "Missing Encounter or EncounterId or Empty List"
m.DeletedBillingDiagnosis |>_save _deleteDxFromEncounterAsync
m.DeletedAllDiagnosis |>_save _deleteDxFromAllPreviousEncountersAsync
m.BillingDiagnosisList |>_save _saveDxAsync
m.AllDiagnosisList |> List.filter (fun dx -> dx.Key.IsSome) |>_save _editAllDiagnosisInPreviousEncountersAsync
For speed, in the future, I will probably have the Async functions act on the entire list at one time rather then one item; but for now, this code comes closest to my intent in asking the question. IMPROVEMENTS AND CRITISM IS GLADDLY APPRECIATED! F# is fun!
Thanks to all.

FSharp Computation Expression: Cannot reference binding value in custom operation

I am trying to make a builder using FSharp Computation Expression, but get error FS0039:
type UpdatebBuilder() =
member this.Yield (x) = x
member this.Return (x) = x
member this.Bind (x, cont) = cont(x)
member this.Quote (x) = x
member this.For (x, a) = x
[<CustomOperation("set", MaintainsVariableSpace =true,AllowIntoPattern=true)>]
member this.Set (x, a, b) = x
let update = UpdatebBuilder()
let testUpdate () =
update {
for x in [| 1; 2 ; 3|] do
set x 123 // Compile Error FS0039: The value or constructor 'x' is not defined.
}
What I want to implement is something like query expression:
query {
for x in collection do
where x = 2 // Why no FS0039 error here?
select x
}
Also tried MaintainsVariableSpaceUsingBind=true, and get same error. What should I do to make it compile?
To me it looks like you are trying to define a State monad and implementing the Set operation as a custom operation.
I will admit I never fully got my head around custom operations in F# (and I used F# alot). IMHO it feels like custom operations had one purpose; enable a LINQ like syntax in F#. As time goes in it seems few C# developers are using the LINQ like syntax (ie from x where y select z) and few F# developers are using the query computation expression. I have no data here but just goes from example code I see.
This could explain why the documentation on custom operations are often succinct and hard to grasp. What does this even mean? MaintainsVariableSpaceUsingBind: Indicates if the custom operation maintains the variable space of the query or computation expression through the use of a bind operation.
Anyway, so in order to learn a bit more about custom operations I tried to implement the state monad with a custom operation for set and I got a bit farther but ran into a problem which I think is an intentional limitation of the compiler. Still thought I share it with the hope that it helps OP get a bit further.
I chose this definition for State<_>:
type [<Struct>] State<'T> = S of (Map<string, obj> -> 'T*Map<string, obj>)
State<_> is a function that given a global state (a map) produces a value (that could derive from the global state but not necessarily) and a potentially updated global state.
return or value as I tend to call it as return is an F# keyword is easy to define as we just return v and the non-updated global state:
let value v = S <| fun m -> v, m
bind is useful to bind several state computations together. First run t on the global state and from the returned value create the second computation and run the updated global state through it:
let bind uf (S t) = S <| fun m ->
let tv, tm = t m
let (S u) = uf tv
u tm
get and set are used to interact with the global state:
let get k : State<'T option> = S <| fun m ->
match m |> Map.tryFind k with
| Some (:? 'T as v) -> Some v, m
| _ -> None, m
let set k v = S <| fun m ->
let m = m |> Map.add k (box v)
(), m
I created some other methods as well but in the end the builder was created like this:
type Builder() =
class
member x.Bind (t, uf) = bind uf t
member x.Combine (t, u) = combine u t
member x.Delay tf = delay tf
member x.For (s, tf) = forEach s tf
member x.Return v = value v
member x.ReturnFrom t = t : State<'T>
member x.Yield v = value v
member x.Zero () = value ()
[<CustomOperation("set", MaintainsVariableSpaceUsingBind = true)>]
member x.Set (s, k, v) = s |> combine (set k v)
end
I used MaintainsVariableSpaceUsingBind because otherwise it doesn't see v. MaintainsVariableSpace yields strange errors asking for seq types which I vaguely suspect is an optimization for computations based around seq. Checking the generated code is seems to do the right thing in that it binds the custom operations together using my bind function in the proper order.
I am now ready to do define a state computation
state {
// Works fine
set "key" -1
for v in 0..2 do
// Won't work because: FS3086: A custom operation may not be used in conjunction with 'use', 'try/with', 'try/finally', 'if/then/else' or 'match' operators within this computation expression
set "hello" v
return! State.get "key"
}
Unfortunately the compiler stops me from using custom ops in conditional operations like if, try and also for (even though it's not in the list it's conditional in some sense). This seems to be an intentional limitation. It's possible to workaround it but it feels meh
state {
set "key" -1
for v in 0..2 do
// Meh
do! state { set "key" v }
return! State.get "key"
}
IMHO I prefer just using normal do!/let! over custom operations:
state {
for v in 0..2 do
do! State.set "key" v
return! State.get "key"
}
So not really a proper answer to the question from OP but perhaps it can help you get a bit further?
Full source code:
type [<Struct>] State<'T> = S of (Map<string, obj> -> 'T*Map<string, obj>)
module State =
let value v = S <| fun m -> v, m
let bind uf (S t) = S <| fun m ->
let tv, tm = t m
let (S u) = uf tv
u tm
let combine u (S t) = S <| fun m ->
let _, tm = t m
let (S u) = u
u tm
let delay tf = S <| fun m ->
let (S t) = tf ()
t m
let forEach s tf = S <| fun m ->
let mutable a = m
for v in s do
let (S t) = tf v
let (), tm = t m
a <- tm
(), a
let get k : State<'T option> = S <| fun m ->
match m |> Map.tryFind k with
| Some (:? 'T as v) -> Some v, m
| _ -> None, m
let set k v = S <| fun m ->
let m = m |> Map.add k (box v)
(), m
let run (S t) m = t m
type Builder() =
class
member x.Bind (t, uf) = bind uf t
member x.Combine (t, u) = combine u t
member x.Delay tf = delay tf
member x.For (s, tf) = forEach s tf
member x.Return v = value v
member x.ReturnFrom t = t : State<'T>
member x.Yield v = value v
member x.Zero () = value ()
[<CustomOperation("set", MaintainsVariableSpaceUsingBind = true)>]
member x.Set (s, k, v) = s |> combine (set k v)
end
let state = State.Builder ()
let testUpdate () =
state {
// Works fine
set "key" -1
for v in 0..2 do
// Won't work because: FS3086: A custom operation may not be used in conjunction with 'use', 'try/with', 'try/finally', 'if/then/else' or 'match' operators within this computation expression
// set "hello" v
// Workaround but kind of meh
// do! state { set "key" v }
// Better IMHO
do! State.set "key" v
return! State.get "key"
}
[<EntryPoint>]
let main argv =
let tv, tm = State.run (testUpdate ()) Map.empty
printfn "v:%A" tv
printfn "m:%A" tm
0

How do I set up multiple observables from an event in F#?

I'm trying to learn about the Observable module in F# by writing a program that connects to a web socket, listens for messages, and then handles them in some set of streams based on Observables. However, I'm having a hard time understanding the actual behavior.
First, I set up a web socket like this:
open System
open System.Net.WebSockets
open System.Threading
let connectFeed =
let feedUrl = "blah blah"
let buffer : byte array = Array.zeroCreate 1024
let segment = ArraySegment(buffer)
let socketEvent = new Event<string>()
let task = async {
let random = Random(DateTime.Now.Millisecond)
use socket = new ClientWebSocket()
let! token = Async.CancellationToken
do! Async.AwaitTask (socket.ConnectAsync(Uri(feedUrl), token))
while not token.IsCancellationRequested do
let! result = Async.AwaitTask (socket.ReceiveAsync(segment, token))
socketEvent.Trigger (Encoding.UTF8.GetString(buffer))
Array.fill buffer 0 buffer.Length 0uy
}
(task, socketEvent.Publish)
let deserializeMsg (raw:string) =
// returns a MsgType based on the received message
let tryGetData (msg:MsgType) =
// returns Some data for specific kind of message; None otherwise
[<EntryPoint>]
let main argv =
let feedProc, feedStream = connectFeed
let msgStream = feedStream |> Observable.map deserializeMsg
msgStream |> Observable.subscribe (fun m -> printfn "got msg: %A" m) |> ignore
let dataStream = feedStream |> Observable.choose tryGetData
dataStream |> Observable.subscribe (fun d -> printfn "got data: %A" d) |> ignore
Async.RunSynchronously feedProc
0
I'm expecting to see a printout like:
got msg: { some: "field" }
got msg: { some: "other" }
got msg: { some: "data" }
got data: { // whatever }
got msg: ...
...
Instead, only the "got msg" messages appear, even though there are messages that would cause tryGetData to return Some.
What's going on here? How do I set up multiple Observable streams from a single event?
Update: I've updated my code with this:
let isMsgA msg =
printfn "isMsgA"
match msg with
| MsgA -> true // where MsgA is a member of a DU defined elsewhere, and is the result of deserializeMsg
| _ -> false
let isStringMsgA msg =
printfn "isStringMsgA"
if msg.StartsWith("{ \"type\": \"msga\"") then true else false
[<EntryPoint>]
let main argv =
let feedProc, feedStream = connectFeed
let msgStream = feedStream |> Observable.map deserializeMsg
msgStream
|> Observable.filter isMsgA
|> Observable.subscribe (fun m -> printfn "got msg MsgA")
|> ignore
feedStream
|> Observable.filter isStringMsgA
|> Observable.subscribe (fun m -> printfn "got string MsgA")
|> ignore
And I get a screen full of "isStringMsgA" and "got string MsgA" messages, but exactly one each of "isMsgA" and "got msg MsgA".
I am baffled.
Here is a trimmed-down, reproducible example for anyone interesting in fiddling with it:
https://github.com/aggieben/test-observable
Update 2: looks like I may be seeing this behavior due to an exception being thrown in the deserializeMsg function. Still digging...
I do not see any obvious reason why this should be happening - can you add some logging to tryGetData to check what inputs it gets and what results it returns?
When using the Observable module, you construct a description of the processing pipeline and Observable.subscribe creates a concrete chain of listeners that do the work and attach handlers to the primary event source. However, the events do not get "consumed" - they should be sent to all the observers.
For example, try playing with the following minimal demo:
let evt = Event<int>()
let e1 = evt.Publish |> Observable.choose (fun n ->
if n % 2 = 0 then Some "woop!" else None)
let e2 = evt.Publish |> Observable.map (fun n -> n * 10)
e1 |> Observable.subscribe (printfn "E1: %s")
e2 |> Observable.subscribe (printfn "E2: %d")
evt.Trigger(1)
evt.Trigger(2)
If you run this, it prints the expected result:
E2: 10
E1: woop!
E2: 20

Wrangling TryWith in Computation expressions

(Having failed to 'grok' FParsec, I followed the advice I read somewhere and started trying to write a little parser myself. Somehow I spotted what looked like a chance to try and monadify it, and now I have N problems...)
This is my 'Result' type (simplified)
type Result<'a> =
| Success of 'a
| Failure of string
Here's the computation expression builder
type ResultBuilder() =
member m.Return a = Success(a)
member m.Bind(r,fn) =
match r with
| Success(a) -> fn a
| Failure(m) -> Failure(m)
In this first example, everything works (compiles) as expected:
module Parser =
let res = ResultBuilder()
let Combine p1 p2 fn =
fun a -> res { let! x = p1 a
let! y = p2 a
return fn(x,y) }
My problem is here: I'd like to be able to catch any failure in the 'combining' function and return a failure, but it says that I should define a 'Zero'.
let Combine2 p1 p2 fn =
fun a -> res { let! x = p1 a
let! y = p2 a
try
return fn(x,y)
with
| ex -> Failure(ex.Message) }
Having no idea what I should return in a Zero, I just threw in member m.Zero() = Failure("hello world"), and it now says I need TryWith.
So:
member m.TryWith(r,fn) =
try
r()
with
| ex -> fn ex
And now it wants Delay, so member m.Delay f = (fun () -> f()).
At which point it says (on the ex -> Failure), This expression should have type 'unit', but has type 'Result<'a>', and I throw up my arms and turn to you guys...
Link for playing: http://dotnetfiddle.net/Ho1sGS
The with block should also return a result from the computation expression. Since you want to return Result.Failure you need to define the member m.ReturnFrom a = a and use it to return the Failure from the with block. In the try block you should also specify that fn returns Success if it doesn't throw.
let Combine2 p1 p2 fn =
fun a -> res { let! x = p1 a
let! y = p2 a
return!
try
Success(fn(x,y))
with
| ex -> Failure(ex.Message)
}
Update:
The original implementation was showing a warning, not an error. The expression in the with block was not used since you returned from the try block, so you could simply add |> ignore. In that case if fn throws then the return value is m.Zero() and the only difference is that you would get "hello world" instead of ex.Message. Illustrated with an example below. Full script here: http://dotnetfiddle.net/mFbeZg
Original implementation with |> ignore to mute the warning:
let Combine3 p1 p2 fn =
fun a -> res { let! x = p1 a
let! y = p2 a
try
return fn(x,y)
with
| ex -> Failure(ex.Message) |> ignore // no warning
}
Run it:
let comb2 a =
let p1' x = Success(x)
let p2' y = Success(y)
let fn' (x,y) = 1/0 // div by zero
let func = Parser.Combine2 p1' p2' fn' a
func()
let comb3 a =
let p1' x = Success(x)
let p2' y = Success(y)
let fn' (x,y) = 1/0 // div by zero
let func = Parser.Combine3 p1' p2' fn' a
func()
let test2 = comb2 1
let test3 = comb3 1
Result:
val test2 : Result<int> = Failure "Attempted to divide by zero."
val test3 : Result<int> = Failure "hello world"
If you want to support try ... with inside a computation builder, you need to add TryWith (as you tried) as well as a few other members including Delay and Run (depending on how you want to implement Delay). In order to be able to return failure, you also need to support return! by adding ReturnFrom:
type ResultBuilder() =
member m.Return a = Success(a)
member m.Bind(r,fn) =
match r with
| Success(a) -> fn a
| Failure(m) -> Failure(m)
member m.TryWith(r,fn) =
try r() with ex -> fn ex
member m.Delay(f) = f
member m.Run(f) = f()
member m.ReturnFrom(r) = r
Now you can do the following:
let Combine2 p1 p2 fn = fun a -> res {
let! x = p1 a
let! y = p2 a
try
return fn(x,y)
with ex ->
return! Failure(ex.Message) }
The trick is that the normal branch uses just return (representing success), but the exception handler uses return! to return an explicitly created result using Failure.
That said, if you are interested in parsers, then you need to use a different type - what you are describing here is more like the option (or Maybe) monad. To implement parser combinators you need a type that represents a parser rather than result of a parser. See for example this article.

How do you create an F# workflow that enables something like single-stepping?

I'd like to create a builder that builds expressions that returns something like a continuation after each step.
Something like this:
module TwoSteps =
let x = stepwise {
let! y = "foo"
printfn "got: %A" y
let! z = y + "bar"
printfn "got: %A" z
return z
}
printfn "two steps"
let a = x()
printfn "something inbetween"
let b = a()
Where the 'let a' line returns something containing the rest of the expressions to be evaluated later on.
Doing this with a separate type for each number of steps is straightforward but of course not particularly useful:
type Stepwise() =
let bnd (v: 'a) rest = fun () -> rest v
let rtn v = fun () -> Some v
member x.Bind(v, rest) =
bnd v rest
member x.Return v = rtn v
let stepwise = Stepwise()
module TwoSteps =
let x = stepwise {
let! y = "foo"
printfn "got: %A" y
let! z = y + "bar"
printfn "got: %A" z
return z
}
printfn "two steps"
let a = x()
printfn "something inbetween"
let b = a()
module ThreeSteps =
let x = stepwise {
let! y = "foo"
printfn "got: %A" y
let! z = y + "bar"
printfn "got: %A" z
let! z' = z + "third"
printfn "got: %A" z'
return z
}
printfn "three steps"
let a = x()
printfn "something inbetween"
let b = a()
printfn "something inbetween"
let c = b()
And the results are what I'm looking for:
two steps
got: "foo"
something inbetween
got: "foobar"
three steps
got: "foo"
something inbetween
got: "foobar"
something inbetween
got: "foobarthird"
But I can't figure out what the general case of this would be.
What I'd like is to be able to feed events into this workflow, so you could write something like:
let someHandler = Stepwise<someMergedEventStream>() {
let! touchLocation = swallowEverythingUntilYouGetATouch()
startSomeSound()
let! nextTouchLocation = swallowEverythingUntilYouGetATouch()
stopSomeSound()
}
And have events trigger a move to the next step in the workflow. (In particular, I want to play with this sort of thing in MonoTouch - F# on the iPhone. Passing around objc selectors drives me insane.)
the problem with your implementation is that it returns "unit -> 'a" for each call to Bind, so you'll get a different type of result for different number of steps (in general, this is a suspicious definition of monad/computation expression).
A correct solution should be to use some other type, which can represent a computation with arbitrary number of steps. You'll also need to distinguish between two types of steps - some steps just evaluate next step of the computation and some steps return a result (via the return keyword). I'll use a type seq<option<'a>>. This is a lazy sequence, so reading the next element will evaluate the next step of the computation. The sequence will contain None values with the exception of the last value, which will be Some(value), representing the result returned using return.
Another suspicious thing in your implementation is a non-standard type of Bind member. The fact that your bind takes a value as the first parameter means that your code looks a bit simpler (you can write let! a = 1) however, you cannot compose stepwise computation. You may want to be able to write:
let foo() = stepwise {
return 1; }
let bar() = stepwise {
let! a = foo()
return a + 10 }
The type I described above will allow you to write this as well. Once you have the type, you just need to follow the type signature of Bind and Return in the implementation and you'll get this:
type Stepwise() =
member x.Bind(v:seq<option<_>>, rest:(_ -> seq<option<_>>)) = seq {
let en = v.GetEnumerator()
let nextVal() =
if en.MoveNext() then en.Current
else failwith "Unexpected end!"
let last = ref (nextVal())
while Option.isNone !last do
// yield None for each step of the source 'stepwise' computation
yield None
last := next()
// yield one more None for this step
yield None
// run the rest of the computation
yield! rest (Option.get !last) }
member x.Return v = seq {
// single-step computation that yields the result
yield Some(v) }
let stepwise = Stepwise()
// simple function for creating single-step computations
let one v = stepwise.Return(v)
Now, let's look at using the type:
let oneStep = stepwise {
// NOTE: we need to explicitly create single-step
// computations when we call the let! binder
let! y = one( "foo" )
printfn "got: %A" y
return y + "bar" }
let threeSteps = stepwise {
let! x = oneStep // compose computations :-)
printfn "got: %A" x
let! y = one( x + "third" )
printfn "got: %A" y
return "returning " + y }
If you want to run the computation step-by-step, you can simply iterate over the returned sequence, for example using the F# for keyword. The following also prints the index of the step:
for step, idx in Seq.zip threeSteps [ 1 .. 10] do
printf "STEP %d: " idx
match step with
| None _ -> ()
| Some(v) -> printfn "Final result: %s" v
Hope this helps!
PS: I found this problem very interesting! Would you mind if I addapted my answer into a blog post for my blog (http://tomasp.net/blog)? Thanks!
Monads and computation builders confuse the hell out of me, but I've adapted something I've made in an earlier SO post. Maybe some bits and pieces can be of use.
The code below contains an action queue, and a form where the Click event listens to the next action available in the action queue. The code below is an example with 4 actions in succession. Execute it in FSI and start clicking the form.
open System.Collections.Generic
open System.Windows.Forms
type ActionQueue(actions: (System.EventArgs -> unit) list) =
let actions = new Queue<System.EventArgs -> unit>(actions) //'a contains event properties
with
member hq.Add(action: System.EventArgs -> unit) =
actions.Enqueue(action)
member hq.NextAction =
if actions.Count=0
then fun _ -> ()
else actions.Dequeue()
//test code
let frm = new System.Windows.Forms.Form()
let myActions = [
fun (e:System.EventArgs) -> printfn "You clicked with %A" (e :?> MouseEventArgs).Button
fun _ -> printfn "Stop clicking me!!"
fun _ -> printfn "I mean it!"
fun _ -> printfn "I'll stop talking to you now."
]
let aq = new ActionQueue(myActions)
frm.Click.Add(fun e -> aq.NextAction e)
//frm.Click now executes the 4 actions in myActions in order and then does nothing on further clicks
frm.Show()
You can click the form 4 times and then nothing happens with further clicks.
Now execute the following code, and the form will respond two more times:
let moreActions = [
fun _ -> printfn "Ok, I'll talk to you again. Just don't click anymore, ever!"
fun _ -> printfn "That's it. I'm done with you."
]
moreActions |> List.iter (aq.Add)

Resources