State monad with traversable

State_monad_with_traversable.fs

type State<'st,'a> =
    | Ok of  'a * 'st
    | Error of ErrorState
and ErrorState = string

type S<'st,'a> = 'st -> State<'st,'a>
and StateMonadBuilder() =
    member b.Return(x) : S<_,_> = fun s -> Ok (x, s)
    member b.ReturnFrom(x) = x
    member b.Error msg = fun _ -> Error msg
    member b.Bind(p: S<_,_>, rest : _ ->  S<_,_>) :  S<_,_>=
        fun state ->
                 let result = p state in
                 match result with
                 | Ok (value,state2) -> (rest value) state2
                 | Error msg -> Error msg  
 
    member b.Get () :  S<_,_> = fun state -> Ok (state, state)
    member b.Put s  :  S<_,_>= fun state -> Ok ((), s)
 
let state = StateMonadBuilder()

let bind x f  = state.Bind(f,x)
let (>>=) = bind
let run i (s : S<_,_>)  = 
    let m = s i
    match m with
    | Ok (x,y) -> x,y
    | Error s -> failwith s

let map f (x:S<_,_>) = 
 state {
     let! a = x
     return f a
 }
let apply (f:S<_,_>)  (x:S<_,_>) = 
    state{
        let! a = x
        let! p = f
        return p a
}

let moveUp () =
     state {
         let! pos = state.Get()
         return! state.Error "d"
         //return! state.Put(fst pos + 0, snd pos - 1)
     }
  
let l f x =
    state{
        let r = f x
        return r
    }
let traverse (f: 'a -> S<_,'b>) x = 
    let (<*>) = apply
    let retn = state.Return
    match x with
    | None -> state.Return  None
    | Some o -> (retn Some) <*> (f o) 
       

type Input = unit ->Option<int>
type Calc<'st> =  int  -> S<'st, int>
type Foo = int -> int
open System


type DoWork<'st> = Input -> Calc<'st> -> Foo -> (unit -> S<'st,int option>) //(unit -> State<unit,unit>)

let doWork  : DoWork<'st> = 
    fun (input ) (calc) foo ->
       input >> (traverse calc) >> (map (Option.map foo))
        
let input () =  "1" |> int |> Some 

let calc i = state {
    let! (m : string) = state.Get()
    return m.Length + i
}

let foo x = x * 2

let d = doWork input calc foo
d () |> run "onur" |> fst |> printf "%A"