Skip to content

Instantly share code, notes, and snippets.

@manio143
Created February 17, 2019 20:17
Show Gist options
  • Save manio143/108c39f4ad53e67e071bf79c53f5975e to your computer and use it in GitHub Desktop.
Save manio143/108c39f4ad53e67e071bf79c53f5975e to your computer and use it in GitHub Desktop.
F# implementation of (StateT s Async)
module AsyncState
type AsyncState<'s, 'a> = private AsyncState of ('s -> Async<'s * 'a>)
module AsyncState =
//Monad
let result x = AsyncState <| fun s -> async {return (s, x)}
let run (AsyncState f) = f
let bind f m = AsyncState <| fun s -> async {
let! (s', a) = run m s
return! run (f a) s'
}
let private (>>=) m f = bind f m
let private (>*>) m n = m >>= fun _ -> n
//MonadTrans
let lift a = AsyncState <| fun s -> async {
let! x = a
return (s, x)
}
//MonadState
let get() = AsyncState <| fun s -> async {
return (s, s)
}
let put x = AsyncState <| fun s -> async {
return (x, ())
}
let modify f = get() >>= (put << f)
//Functor
let map f m = m >>= (result << f)
let private (<?>) f m = map f m
//Applicative
let apply m n = m >>= fun f -> map f n
let private (<*>) m n = apply m n
let liftA2 f m n = f <?> m <*> n
let rec concatM ms =
match ms with
| [] -> result []
| (m::ms) -> m >>= fun x -> concatM ms >>= fun xs -> result (x::xs)
let mapM f xs = concatM <| List.map f xs
type AsyncStateBuilder() =
member x.Return(a) = result a
member x.Bind(m, f) = m >>= f
member x.ReturnFrom(m) = m
member x.Combine(m, n) = m >*> n
member x.For(s,f) =
Seq.map f s |> Seq.fold (>*>) (result ())
member x.While(pred, m) =
let rec loop p m =
if p() then m >*> loop p m
else result ()
in loop pred m
member x.Zero() = result ()
member x.Delay(f) = result () >>= f
type AsyncState<'s, 'a> with
member this.Run(s) = AsyncState.run this s
member this.Map(f) = AsyncState.map f this
let asyncState = AsyncState.AsyncStateBuilder()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment