updateMonad.fsx

type Update<'env, 'model, 'result> = 'env -> 'model -> 'model * 'result

[<AutoOpen>]
module UpdateOpens =
    let inline zero env model = model,()
    let getModel () : Update<'e, 'm, 'm> = fun _ model -> model,model
    let getEnv () : Update<'e, 'm, 'e> = fun env model -> model,env
    let getAll () : Update<'e, 'm, 'e * 'm> = fun env model -> model,(env,model)
    let updateModel (newModel: 'm) : Update<'e, 'm, unit> = fun env model -> newModel,()

module Update =
    let run env model (upd: Update<'e, 'm, _>) : 'm = upd env model |> fst
    let withoutResult x = x,()
    let optionIter f (opt: 'a Option) =
        match opt with
        | Some value -> f value
        | None -> zero

type UpdateBuilder<'e, 'm>() =
    member this.Zero() = zero
    member this.Return(v) : Update<'e, 'm, 'r> = fun _ model -> model,v
    member this.ReturnFrom(v) = v
    member this.Bind(m: Update<'e, 'm, 'r1>, f: _ -> Update<'e, 'm, 'r2>) : Update<'e, 'm, 'r2> =
        fun env model ->
            let newModel,res = m env model
            let nextUpdate = f res
            nextUpdate env newModel
    member this.Combine (x1: Update<'e, 'm, 'r1>, x2: Update<'e, 'm, 'r2>) =
        fun env model ->
            let newModel,_ = x1 env model
            x2 env newModel
    member this.Delay f : Update<'e, 'm, 'r> = f ()
    member this.For (s: 'a seq, (f: 'a -> Update<'e, 'm, 'r>)) =
        s
        |> Seq.map f
        |> Seq.reduceBack (fun x1 x2 -> this.Combine (x1, x2))
    member this.While (f, x) =
        if f () then this.Combine (x, this.While (f, x))
        else this.Zero ()

module private Test =

    open Update

    type Env = int
    type Model = { value: string }

    let update = UpdateBuilder<Env, Model>()

    let e1 =
        update {
            let! model = getModel()
            let! env = getEnv()
            do! updateModel({ value = $"{model.value}_Env={env}" })
        }
        |> run 1 { value = "initial" }

    let e2 =
        update {
            for x in [0..5] do
                let! model = getModel()
                do! updateModel({ value = $"{model.value}_{x}" })
        }
        |> run 1 { value = "initial" }


    let e3 =
        let x = Some "Hurz"
        update {
            match x with
            | Some value ->
                do! updateModel({ value = value })
            | None -> return ()
        }
        |> run 1 { value = "initial" }

    let e4 =
        let x = Some "Hurz"
        update {
            do!
                x
                |> Option.map (fun value -> update {
                    do! updateModel({ value = value })
                })
                |> Option.defaultValue zero
        }
        |> run 1 { value = "initial" }


    let e5 =
        let x = Some "Hurz"
        update {
            do! x |> Update.optionIter (fun value ->
                updateModel({ value = value }))
        }
        |> run 1 { value = "initial" }