-
Notifications
You must be signed in to change notification settings - Fork 15
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Added F# data structures like (Reader and State monads) as well as T… (…
…#67) * Added F# data structures like (Reader and State monads) as well as Traversable implementations
- Loading branch information
Showing
11 changed files
with
331 additions
and
26 deletions.
There are no files selected for viewing
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
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
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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,66 @@ | ||
| namespace NBB.Core.Effects.FSharp.Data.ReaderEffect | ||
|
|
||
| open NBB.Core.Effects.FSharp | ||
| open NBB.Core.FSharp.Data | ||
| open NBB.Core.FSharp.Data.Reader | ||
|
|
||
| type ReaderEffect<'s, 't> = 's -> Effect<'t> | ||
| module ReaderEffect = | ||
| let run (x: ReaderEffect<'s, 't>) : 's -> Effect<'t> = | ||
| x | ||
|
|
||
| let map (f: 't->'u) (m : ReaderEffect<'s, 't>) : ReaderEffect<'s,'u> = | ||
| m >> Effect.map f | ||
|
|
||
| let bind (f: 't-> ReaderEffect<'s, 'u>) (m : ReaderEffect<'s, 't>) : ReaderEffect<'s, 'u> = | ||
| fun s -> Effect.bind (fun a -> run (f a) s) (run m s) | ||
|
|
||
| let apply (f: ReaderEffect<'s, ('t -> 'u)>) (m: ReaderEffect<'s, 't>) : ReaderEffect<'s, 'u> = | ||
| fun s -> Effect.bind (fun g -> Effect.map (fun (a: 't) -> (g a)) (run m s)) (f s) | ||
|
|
||
| let pure' x = | ||
| fun _ -> Effect.pure' x | ||
|
|
||
| let lift (eff : Effect<'t>) : ReaderEffect<'s, 't> = | ||
| fun _ -> eff | ||
|
|
||
| let hoist (reader : Reader<'s, 't>) : ReaderEffect<'s, 't> = | ||
| fun s -> Effect.pure' (reader s) | ||
|
|
||
| module ReaderEffectBulder = | ||
| type ReaderEffectBulder() = | ||
| member _.Bind (m, f) = ReaderEffect.bind f m : ReaderEffect<'s,'u> | ||
| member _.Return x = ReaderEffect.pure' x : ReaderEffect<'s,'u> | ||
| member _.ReturnFrom x = x : ReaderEffect<'s,'u> | ||
| member _.Combine (m1, m2) = ReaderEffect.bind (fun _ -> m1) m2 : ReaderEffect<'s,'u> | ||
| member _.Zero () = ReaderEffect.pure' () : ReaderEffect<'s, unit> | ||
|
|
||
| [<AutoOpen>] | ||
| module ReaderEffectExtensions = | ||
| let readerEffect = new ReaderEffectBulder.ReaderEffectBulder() | ||
|
|
||
| let (<!>) = ReaderEffect.map | ||
| let (<*>) = ReaderEffect.apply | ||
| let (>>=) eff func = ReaderEffect.bind func eff | ||
|
|
||
|
|
||
| [<RequireQualifiedAccess>] | ||
| module List = | ||
| let traverseReaderEffect f list = | ||
| let pure' = ReaderEffect.pure' | ||
| let (<*>) = ReaderEffect.apply | ||
| let cons head tail = head :: tail | ||
| let initState = pure' [] | ||
| let folder head tail = pure' cons <*> (f head) <*> tail | ||
| List.foldBack folder list initState | ||
|
|
||
| let sequenceReaderEffect list = traverseReaderEffect id list | ||
|
|
||
| [<RequireQualifiedAccess>] | ||
| module Result = | ||
| let traverseReaderEffect (f: 'a-> ReaderEffect<'s, 'b>) (result:Result<'a,'e>) : ReaderEffect<'s, Result<'b, 'e>> = | ||
| match result with | ||
| |Error err -> ReaderEffect.pure' (Error err) | ||
| |Ok v -> ReaderEffect.map Result.Ok (f v) | ||
|
|
||
| let sequenceReaderEffect result = traverseReaderEffect id result |
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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,76 @@ | ||
| namespace NBB.Core.Effects.FSharp.Data.StateEffect | ||
|
|
||
| open NBB.Core.Effects.FSharp | ||
| open NBB.Core.FSharp.Data | ||
| open NBB.Core.FSharp.Data.State | ||
|
|
||
| type StateEffect<'s, 't> = 's -> Effect<'t * 's> | ||
| module StateEffect = | ||
| let run (x: StateEffect<'s, 't>) : 's -> Effect<'t * 's> = | ||
| x | ||
|
|
||
| let map (f: 't->'u) (m : StateEffect<'s, 't>) : StateEffect<'s,'u> = | ||
| fun s -> Effect.map (fun (a, s') -> (f a, s')) (run m s) | ||
|
|
||
| let bind (f: 't-> StateEffect<'s, 'u>) (m : StateEffect<'s, 't>) : StateEffect<'s, 'u> = | ||
| fun s -> Effect.bind (fun (a, s') -> run (f a) s') (run m s) | ||
|
|
||
| let apply (f: StateEffect<'s, ('t -> 'u)>) (m: StateEffect<'s, 't>) : StateEffect<'s, 'u> = | ||
| fun s -> Effect.bind (fun (g, s') -> Effect.map (fun (a: 't, s'': 's) -> ((g a), s'')) (run m s')) (f s) | ||
|
|
||
| let pure' x = | ||
| fun s -> Effect.pure' (x, s) | ||
|
|
||
| let get () : StateEffect<'s, 's> = | ||
| fun s -> Effect.pure' (s, s) | ||
|
|
||
| let put (x: 's) : StateEffect<'s, unit> = | ||
| fun _ -> Effect.pure' ((), x) | ||
|
|
||
| let flatten x = | ||
| bind id x | ||
|
|
||
| let lift (eff : Effect<'t>) : StateEffect<'s, 't> = | ||
| fun s -> eff |> Effect.map (fun a -> (a, s)) | ||
|
|
||
| let hoist (state: State<'s, 't>) : StateEffect<'s, 't> = | ||
| fun s -> Effect.pure' (State.run state s) | ||
|
|
||
| module StateEffectBulder = | ||
| type StateEffectBulder() = | ||
| member _.Bind (m, f) = StateEffect.bind f m : StateEffect<'s,'u> | ||
| member _.Return x = StateEffect.pure' x : StateEffect<'s,'u> | ||
| member _.ReturnFrom x = x : StateEffect<'s,'u> | ||
| member _.Combine (m1, m2) = StateEffect.bind (fun _ -> m1) m2 : StateEffect<'s,'u> | ||
| member _.Zero () = StateEffect.pure' () : StateEffect<'s, unit> | ||
|
|
||
| let stateEffectssss = new StateEffectBulder() | ||
|
|
||
| [<AutoOpen>] | ||
| module StateEffectExtensions = | ||
| let stateEffect = new StateEffectBulder.StateEffectBulder() | ||
|
|
||
| let (<!>) = StateEffect.map | ||
| let (<*>) = StateEffect.apply | ||
| let (>>=) eff func = StateEffect.bind func eff | ||
|
|
||
| [<RequireQualifiedAccess>] | ||
| module List = | ||
| let traverseStateEffect f list = | ||
| let pure' = StateEffect.pure' | ||
| let (<*>) = StateEffect.apply | ||
| let cons head tail = head :: tail | ||
| let initState = pure' [] | ||
| let folder head tail = pure' cons <*> (f head) <*> tail | ||
| List.foldBack folder list initState | ||
|
|
||
| let sequenceStateEffect list = traverseStateEffect id list | ||
|
|
||
| [<RequireQualifiedAccess>] | ||
| module Result = | ||
| let traverseStateEffect (f: 'a-> StateEffect<'s, 'b>) (result:Result<'a,'e>) : StateEffect<'s, Result<'b, 'e>> = | ||
| match result with | ||
| | Error err -> StateEffect.map Result.Error (StateEffect.pure' err) | ||
| | Ok v -> StateEffect.map Result.Ok (f v) | ||
|
|
||
| let sequenceStateEffect result = traverseStateEffect id result |
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
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
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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,60 @@ | ||
| namespace NBB.Core.FSharp.Data.Reader | ||
|
|
||
| type Reader<'s, 't> = 's -> 't | ||
| module Reader = | ||
| let run (x: Reader<'s, 't>) : 's -> 't = | ||
| x | ||
|
|
||
| let map (f: 't->'u) (m : Reader<'s, 't>) : Reader<'s,'u> = | ||
| m >> f | ||
|
|
||
| let bind (f: 't-> Reader<'s, 'u>) (m : Reader<'s, 't>) : Reader<'s, 'u> = | ||
| fun s -> let a = run m s in run (f a) s | ||
|
|
||
| let apply (f: Reader<'s, ('t -> 'u)>) (m: Reader<'s, 't>) : Reader<'s, 'u> = | ||
| fun s -> let f = run f s in let a = run m s in f a | ||
|
|
||
| let ask : Reader<'s, 's> = | ||
| id | ||
|
|
||
| let pure' x = | ||
| fun _ -> x | ||
|
|
||
|
|
||
| module ReaderBulder = | ||
| type ReaderBulder() = | ||
| member _.Bind (m, f) = Reader.bind f m : Reader<'s,'u> | ||
| member _.Return x = Reader.pure' x : Reader<'s,'u> | ||
| member _.ReturnFrom x = x : Reader<'s,'u> | ||
| member _.Combine (m1, m2) = Reader.bind (fun _ -> m1) m2 : Reader<'s,'u> | ||
| member _.Zero () = Reader.pure' () : Reader<'s, unit> | ||
|
|
||
| [<AutoOpen>] | ||
| module ReaderExtensions = | ||
| let reader = new ReaderBulder.ReaderBulder() | ||
|
|
||
| let (<!>) = Reader.map | ||
| let (<*>) = Reader.apply | ||
| let (>>=) st func = Reader.bind func st | ||
|
|
||
|
|
||
| [<RequireQualifiedAccess>] | ||
| module List = | ||
| let traverseReader f list = | ||
| let pure' = Reader.pure' | ||
| let (<*>) = Reader.apply | ||
| let cons head tail = head :: tail | ||
| let initState = pure' [] | ||
| let folder head tail = pure' cons <*> (f head) <*> tail | ||
| List.foldBack folder list initState | ||
|
|
||
| let sequenceReader list = traverseReader id list | ||
|
|
||
| [<RequireQualifiedAccess>] | ||
| module Result = | ||
| let traverseReader (f: 'a-> Reader<'s, 'b>) (result:Result<'a,'e>) : Reader<'s, Result<'b, 'e>> = | ||
| match result with | ||
| | Error err -> Reader.pure' (Error err) | ||
| | Ok v -> Reader.map Result.Ok (f v) | ||
|
|
||
| let sequenceReader result = traverseReader id result |
16 changes: 16 additions & 0 deletions
16
src/Core/NBB.Core.FSharp/NBB.Core.FSharp/Data/ResultExtensions.fs
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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,16 @@ | ||
| namespace NBB.Core.FSharp.Data | ||
|
|
||
| [<AutoOpen>] | ||
| module ResultExtensions = | ||
|
|
||
| [<RequireQualifiedAccess>] | ||
| module List = | ||
| let traverseResult f list = | ||
| let pure' = Result.Ok | ||
| let (<*>) fn = Result.bind (fun x-> Result.map (fun f -> f x) fn) | ||
| let cons head tail = head :: tail | ||
| let initState = pure' [] | ||
| let folder head tail = pure' cons <*> (f head) <*> tail | ||
| List.foldBack folder list initState | ||
|
|
||
| let sequenceResult list = traverseResult id list |
Oops, something went wrong.