Created
February 17, 2019 20:17
-
-
Save manio143/108c39f4ad53e67e071bf79c53f5975e to your computer and use it in GitHub Desktop.
F# implementation of (StateT s Async)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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