Last active
July 30, 2018 12:04
-
-
Save cowlike/07fc9f6b7f246c0dc0d72bf1b94009fa to your computer and use it in GitHub Desktop.
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 Monad | |
/// Maybe (Option) | |
type Maybe<'a> = | |
| Nothing | |
| Just of 'a | |
static member inline doReturn (v) = Just v | |
static member inline doReturnFrom (v) = v | |
static member (>>=) (v,f) = | |
match v with | |
| Just v' -> f v' | |
| Nothing -> Nothing | |
static member (<!>) (f,v) = | |
match v with | |
| Just v' -> f v' |> Just | |
| Nothing -> Nothing | |
static member (<*>) (f,v) = | |
match f,v with | |
| Just f, Just v' -> f v' |> Just | |
| _ -> Nothing | |
///Result - alternative to Choice | |
type Result<'a,'b> = | |
| Success of 'a | |
| Fail of 'b | |
static member inline doReturn (v) = Success v | |
static member inline doReturnFrom (v) = v | |
static member (>>=) (v,f) = | |
match v with | |
| Success v' -> f v' | |
| Fail v' -> Fail v' | |
static member (<!>) (f,v) = | |
match v with | |
| Success v' -> f v' |> Success | |
| Fail v' -> Fail v' | |
static member (<*>) (f,v) = | |
match f,v with | |
| Success f, Success v' -> f v' |> Success | |
| Fail v', _ -> Fail v' | |
| _, Fail v' -> Fail v' | |
type AR<'a,'b> = | |
| AR of Async<Result<'a,'b>> | |
static member inline doReturn (v) = async { return Success v } |> AR | |
static member inline doZero () = async { return Fail "Failed" } |> AR | |
static member inline doReturnFrom (v) = v | |
static member (<!>) (f, AR v) = AR <| async { | |
let! v = v | |
match v with | |
| Success v' -> return (f v' |> Success) | |
| Fail v' -> return Fail v' | |
} | |
static member (<*>) (AR fArg, AR vArg) = AR <| async { | |
let! fChild = Async.StartChild fArg | |
let! vChild = Async.StartChild vArg | |
// wait for the results | |
let! f = fChild | |
let! v = vChild | |
// return f v | |
match f,v with | |
| Success f, Success v' -> return (f v' |> Success) | |
| Fail v', _ -> return Fail v' | |
| _, Fail v' -> return Fail v' | |
} | |
static member inline (>>=) (AR v, f: ('a -> AR<'c,'b>)) = Async.RunSynchronously <| async { | |
let! v = v | |
let x = match v with | |
| Success vv -> f vv | |
| Fail vv -> async { return Fail vv } |> AR | |
return x | |
} | |
static member inline (>>==) (AR v, f: ('a -> AR<'c,'b>)) = async { | |
let! v = v | |
let x = match v with | |
| Success vv -> f vv | |
| Fail vv -> async { return Fail vv } |> AR | |
return x | |
} | |
let inline return' (v : ^a) : ^b = | |
(^b : (static member doReturn : ^a -> ^b) v) | |
let inline returnFrom (v: ^a): ^a = | |
(^a: (static member doReturnFrom: ^a -> ^a) v) | |
let inline bind v f = v >>= f | |
let inline map f v = f <!> v | |
let inline ap f v = f <*> v | |
///Generic do' blocks | |
type DoBuilder() = | |
member inline x.Bind (v,f) = bind v f | |
member inline x.Return v = return' v | |
member inline x.ReturnFrom v = returnFrom v | |
let do' = DoBuilder() | |
module Maybe = | |
let inline fromOption o = | |
match o with | |
| Some v -> Just v | |
| None -> Nothing | |
let inline toOption r = | |
match r with | |
| Just v -> Some v | |
| Nothing -> None | |
module Result = | |
let inline fromOption msg o = | |
match o with | |
| Some v -> Success v | |
| None -> Fail msg | |
let inline toOption r = | |
match r with | |
| Success v -> Some v | |
| Fail _ -> None | |
module AR = | |
let inline run (AR v) = Async.RunSynchronously v | |
let inline runParallel (xs: AR<'a,'b> seq) = | |
xs | |
|> Seq.map (fun (AR v) -> v) | |
|> Async.Parallel | |
|> Async.RunSynchronously | |
let inline fail s = async { return Fail s } |> AR | |
let sleep millis = AR <| async { | |
do! Async.Sleep millis | |
return Success () | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
code adapted from this blog