agent (async) with state monad

Question

I have a series of operations. The operations have been modeled as state monads.

type StateMonadBuilder<'State>() =

    // M<'T> -> M<'T>
    member b.ReturnFrom a : StateFunc<'State, 'T> = a

    // 'T -> M<'T>
    member b.Return a : StateFunc<'State, 'T> = ( fun s ->  a, s)

    // M<'T> * ('T -> M<'U>) -> M<'U>
    member b.Bind(p : StateFunc<_, 'T>, rest : 'T -> StateFunc<_,_>) : StateFunc<'State, 'U>  = 
        (fun s ->
            let a, s' = p s
            rest a s')

    member b.Zero() =
        (fun s -> (), s)


    // Getter for the whole state, this type signature is because it passes along the state & returns the state
    member b.getState : StateFunc<'State, _> = (fun s -> s, s)

    // Setter for the state
    member b.putState (s:'State) : StateFunc<'State, _> = (fun _ -> (), s) 

let runState f init = f init

The operations have been designed to run in parallel. In most of the applications the operations are executed independently. There might be a user case where the operations must receive status updates from one environmental entity. In theory, the environmental entity carries its own state and it could be modeled as a state monad itself.

I was wondering how this could be solved in functional style. I have read something about monad trasnformers, but I am not sure this it is the way to go.

(I am trying to work on an example, but I am not sure about a proper toy problem)

EDIT 3

Based on the comments and the suggestions below, I have tried to build an agent. My goal is to mount the State Monad on the agent. That will allow me to reuse the code already built. I'd also would like to understand and solve this problem, in order to gain insights about how F# works.

I have prepared the following toy example:

/////////////////////////////////////////////////////////////////////////////////////
// Definition of the state 
/////////////////////////////////////////////////////////////////////////////////////
type StateFunc<'State, 'T> = 'State -> 'T * 'State



/////////////////////////////////////////////////////////////////////////////////////
// Definition of the State monad 
/////////////////////////////////////////////////////////////////////////////////////
type StateMonadBuilder<'State>() =

    // M<'T> -> M<'T>
    member b.ReturnFrom a : StateFunc<'State, 'T> = a

    // 'T -> M<'T>
    member b.Return a : StateFunc<'State, 'T> = ( fun s ->  a, s)

    // M<'T> * ('T -> M<'U>) -> M<'U>
    member b.Bind(p : StateFunc<_, 'T>, rest : 'T -> StateFunc<_,_>) : StateFunc<'State, 'U>  = 
        (fun s ->
            let a, s' = p s
            rest a s')

    member b.Zero() = fun s -> (), s

    member b.Delay (f : unit -> StateFunc<_,_>) : StateFunc<'State, 'T> =
        b.Bind (b.Return (), f)

    // Getter for the whole state, this type signature is because it passes along the state & returns the state
    member b.getState : StateFunc<'State, _> = (fun s -> s, s)

    // Setter for the state
    member b.putState (s:'State) : StateFunc<'State, _> = (fun _ -> (), s) 

    // (unit -> bool) * M<'T> -> M<'T>
    member this.While (guard, body : StateFunc<_,_>) : StateFunc<'State, unit> =
        if guard () then
            this.Bind (body, (fun () -> this.While (guard, body)))
        else
            this.Zero ()





/////////////////////////////////////////////////////////////////////////////////////
// The agent
/////////////////////////////////////////////////////////////////////////////////////

let state = StateMonadBuilder<int> ()

type SonM (sonName: string) =
    let name = sonName
    member this.GetMoneyFromDad (x: int) = state {
        printfn " I am getting money from dad"
        let! currState = state.getState
        do! state.putState (currState + x)  
        do! this.ToConsole () }
    member this.GoShopping (x: int) = state {
        printfn " I am taken to the mall"
        let! currState = state.getState   
        do! state.putState (currState - x) 
        do! this.ToConsole () }
    member this.TellDad = state {
        printfn " I'll tell dad my balance "
        return! state.getState }
    member this.ToConsole () = state {
        let! mystate = state.getState
        printfn " Balance: %i" mystate }

type Agent<'T> = MailboxProcessor<'T>

type message = 
    | Shopping of int
    | Allowance of int
    | GetBalance
    | Stop

let setupAgent iv = Agent.Start (fun inbox ->   

    let aSon = new SonM ("Paul")

    let processMsg msg = state {
        match msg with
        | Shopping money ->
            printfn "Go shopping with %i " money
            do! (aSon.GoShopping money)
        | Allowance money -> 
            printfn " I got some money for you, son"
            do! (aSon.GetMoneyFromDad money) 
        | GetBalance -> 
            printfn " Calling: TellDad"
            let! balance = aSon.TellDad
            printfn " Current Balance: %i" balance 
            printfn " The balance should have been printed"
        | _ -> do printfn "Nothing to do.." }

    let rec loop () = 
        let getMsgAsync () = async {
            let! msg = inbox.Receive() 
            return  processMsg msg } 
        let p = 
            (fun s -> 
                let _, s' = (getMsgAsync () |> Async.Start) s
                getMsgAsync s')
        state.Bind ( /// ??? WIP HERE ??? )

    iv |> loop () ) 





let agent = setupAgent 100
agent.Post (GetBalance)    
agent.Post(Allowance 15)
agent.Post (GetBalance)    
agent.Post (Shopping 10)
agent.Post (Stop)

I am unsure on how to proceed to 'bind' states within the async recursive loop that defines the agent. Thanks.

Threading around a state makes it difficult to run things in parallel - what makes the operations independent of each other given they are using the state? — Ganesh Sittampalam, Jan 21 '14 at 19:38
Good question. The operations are run in parallel and independently. However, there is a user case where they are still run on different threads, but they are no longer independent because they must receive updates from a separate entitiy. I'd like to find a work-around for this user-case. Thanks! — NoIdeaHowToFixThis, Jan 21 '14 at 19:45
You mentioned two state monads, one for the external updates. What's the other for? — Ganesh Sittampalam, Jan 21 '14 at 19:55
The other one are the operations themselves. I figured out a toy problem: there are `n` sons (state monads where the state is their money). They go around and spend their money. There is one father (state monad where the state is the father`s money). The sons can go and get money from father, under certain circumstances. How do I model this with a FP approach? — NoIdeaHowToFixThis, Jan 21 '14 at 19:59
I do not know about your specific problem, but if you have some parallel computations that must receive updates from a separate entity, then it might be a better idea to implement this using F# agents: http://www.developerfusion.com/article/139804/an-introduction-to-f-agents/ — Tomas Petricek, Jan 21 '14 at 20:16
I did not implement the separate entity (the controller, father) yet. The choice of state monads for the operations (the parallel computations, the sons) was due to F# computational expressions that really made the code look clear and simple. — NoIdeaHowToFixThis, Jan 21 '14 at 20:32
I think agents would be the best fit for this problem. You could in theory use state monads for each agent but to be honest state monads in F# are pretty artificial anywhere compared to using them in Haskell. You pay a big syntactic overhead and you don't gain any guarantees of purity, so you might as well just use a mutable or a ref. — Ganesh Sittampalam, Jan 21 '14 at 20:42
I see. I'll have a look to f# agents. Thanks. PS: for the sake of expanding my knowledge of functional programming, how would an Haskell programmer have solved this program? — NoIdeaHowToFixThis, Jan 21 '14 at 20:44
Not actually sure - a state monad wouldn't work too well even in Haskell given the external influence from the father. Could use `StateT IO` or `StateT STM` but not really sure it'd be worth it. — Ganesh Sittampalam, Jan 21 '14 at 21:14
Functional programming is not well-suited to fix all problems, just as procedural (or OO) programming is not well-suited to fix all problems. The power of F# is the ability to jump back and forth judiciously. I agree with @Ganesh - use something simple, straight-forward and easy to maintain. — JDB, Jan 22 '14 at 02:23

NoIdeaHowToFixThis · Accepted Answer · 2014-01-28T11:47:55.517

This piece of code below works.

The idea is to consider each step's calculations as a State Monad. However, the state monad is not binded in the agent's async loop. Instead, the state is unwrapped out of the state monad and put forward in loop.

I don't know if this is a good solution but the results appear to be correct.

/////////////////////////////////////////////////////////////////////////////////////
// Definition of the state 
/////////////////////////////////////////////////////////////////////////////////////
type StateFunc<'State, 'T> = 'State -> 'T * 'State



/////////////////////////////////////////////////////////////////////////////////////
// Definition of the State monad 
/////////////////////////////////////////////////////////////////////////////////////
type StateMonadBuilder<'State>() =

    // M<'T> -> M<'T>
    member b.ReturnFrom a : StateFunc<'State, 'T> = a

    // 'T -> M<'T>
    member b.Return a : StateFunc<'State, 'T> = ( fun s ->  a, s)

    // M<'T> * ('T -> M<'U>) -> M<'U>
    member b.Bind(p : StateFunc<_, 'T>, rest : 'T -> StateFunc<_,_>) : StateFunc<'State, 'U>  = 
        (fun s ->
            let a, s' = p s
            rest a s')

    member b.Zero() = fun s -> (), s

    member b.Delay (f : unit -> StateFunc<_,_>) : StateFunc<'State, 'T> =
        b.Bind (b.Return (), f)

    // Getter for the whole state, this type signature is because it passes along the state & returns the state
    member b.getState : StateFunc<'State, _> = (fun s -> s, s)

    // Setter for the state
    member b.putState (s:'State) : StateFunc<'State, _> = (fun _ -> (), s) 

    // (unit -> bool) * M<'T> -> M<'T>
    member this.While (guard, body : StateFunc<_,_>) : StateFunc<'State, unit> =
        if guard () then
            this.Bind (body, (fun () -> this.While (guard, body)))
        else
            this.Zero ()





/////////////////////////////////////////////////////////////////////////////////////
// The agent
/////////////////////////////////////////////////////////////////////////////////////

let state = StateMonadBuilder<int> ()

type SonM (sonName: string) =
    let name = sonName
    member this.GetMoneyFromDad (x: int) = state {
        printfn " I am getting money from dad"
        let! currState = state.getState
        do! state.putState (currState + x)  
        do! this.ToConsole () }
    member this.GoShopping (x: int) = state {
        printfn " I am taken to the mall"
        let! currState = state.getState   
        do! state.putState (currState - x) 
        do! this.ToConsole () }
    member this.TellDad = state {
        printfn " I'll tell dad my balance "
        return! state.getState }
    member this.ToConsole () = state {
        let! mystate = state.getState
        printfn " Balance: %i" mystate }

type Agent<'T> = MailboxProcessor<'T>

type message = 
    | Shopping of int
    | Allowance of int
    | GetBalance
    | Stop

let setupAgent iv = Agent.Start (fun inbox ->   

    let aSon = new SonM ("Paul")

    let processMsg msg = state {
        match msg with
        | Shopping money ->
            printfn "Go shopping with %i " money
            do! (aSon.GoShopping money)
        | Allowance money -> 
            printfn " I got some money for you, son"
            do! (aSon.GetMoneyFromDad money) 
        | GetBalance -> 
            printfn " Calling: TellDad"
            let! balance = aSon.TellDad
            printfn " Current Balance: %i" balance 
        | _ -> do printfn "Nothing to do.." }

    let rec loop s = async {
            let! msg = inbox.Receive() 
            let processedMsg = processMsg msg 
            let _, s' = s |> processedMsg
            return! loop s' }
    loop iv )


let agent = setupAgent 100
agent.Post (GetBalance)    
agent.Post(Allowance 15)
agent.Post (GetBalance)    
agent.Post (Shopping 10)
agent.Post (Stop)

agent (async) with state monad

1 Answers1