From ef60f802370e8dd979df1d1df6040c19fb6a0300 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Fri, 23 Aug 2019 11:36:29 +0200 Subject: [PATCH 01/33] Initial implementation --- src/FSharpPlus/List.fs | 150 ++++++++++++++++++++++++++++++++--------- 1 file changed, 118 insertions(+), 32 deletions(-) diff --git a/src/FSharpPlus/List.fs b/src/FSharpPlus/List.fs index a5288cf58..e6aae1ac1 100644 --- a/src/FSharpPlus/List.fs +++ b/src/FSharpPlus/List.fs @@ -33,51 +33,137 @@ open FSharpPlus.Control /// Monad Transformer for list<'T> [] -type ListT<'``monad>``> = ListT of '``monad>`` +type ListT<'``monad<'t>``> = ListT of obj +type ListTNode<'``monad<'t>``,'t> = Nil | Cons of 't * ListT<'``monad<'t>``> /// Basic operations on ListT [] module ListT = - let run (ListT m) = m : '``Monad>`` - let inline internal sequence ms = - let k m m' = m >>= fun (x: 'a) -> m' >>= fun xs -> (result: list<'a> -> 'M) (x::xs) - List.foldBack k ms ((result :list<'a> -> 'M) []) - - let inline internal mapM f as' = sequence (List.map f as') - - let inline bind (f: 'T-> ListT<'``Monad``>) (ListT m: ListT<'``Monad``>) = (ListT (m >>= mapM (run << f) >>= ((List.concat: list<_>->_) >> result))) - let inline apply (ListT f: ListT<'``Monad 'U)>``>) (ListT x: ListT<'``Monad``>) = ListT (map List.apply f <*> x) : ListT<'``Monad``> - let inline map (f: 'T->'U) (ListT m: ListT<'``Monad``>) = ListT (map (List.map f) m) : ListT<'``Monad``> - -type ListT<'``monad>``> with - static member inline Return (x: 'T) = [x] |> result |> ListT : ListT<'``Monad``> + let inline internal wrap (mit: 'mit) = + let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) -> (result ListTNode<'mt,'t>.Nil ) : 'mit + ListT mit : ListT<'mt> + + let inline internal unwrap (ListT mit : ListT<'mt>) = + let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) -> (result ListTNode<'mt,'t>.Nil ) : 'mit + unbox mit : 'mit + + let inline empty () = wrap ((result ListTNode<'mt,'t>.Nil) : 'mit) : ListT<'mt> + + /// Concatenates the elements of two lists + let inline concat l1 l2 = + let rec loop (l1: ListT<'mt>) (lst2: ListT<'mt>) = + let (l1, l2) = unwrap l1, unwrap lst2 + ListT (l1 >>= function Nil -> l2 | Cons (x: 't, xs) -> ((result (Cons (x, loop xs lst2))) : 'mit)) + loop l1 l2 : ListT<'mt> + + let inline bind f (source: ListT<'mt>) : ListT<'mu> = + let rec loop f input = + wrap ( + (unwrap input : 'mit) >>= function + | Nil -> result <| (Nil : ListTNode<'mu,'u>) : 'miu + | Cons (h:'t, t: ListT<'mt>) -> + let ( res) = concat (f h: ListT<'mu>) (loop f t ) + unwrap res : 'miu) + loop f source : ListT<'mu> + + let inline unfold (f:'State -> '``M<('T * 'State) option>``) (s:'State) : ListT<'MT> = + let rec loop f s = f s |> map (function + | Some (a, s) -> Cons(a, loop f s) + | None -> Nil) |> wrap + loop f s + + let inline map f (input : ListT<'mt>) : ListT<'mu> = + let rec collect f (input : ListT<'mt>) : ListT<'mu> = + wrap ( + (unwrap input : 'mit) >>= function + | Nil -> result <| (Nil : ListTNode<'mu,'u>) : 'miu + | Cons (h: 't, t: ListT<'mt>) -> + let ( res) = Cons (f h, collect f t) + result res : 'miu) + collect f (input: ListT<'mt>) : ListT<'mu> + + let inline singleton (v:'t) = + let mresult x = result x + let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= konst (mresult ListTNode<'mt,'t>.Nil ) : 'mit + wrap ((mresult <| ListTNode<'mt,'t>.Cons (v, (wrap (mresult ListTNode<'mt,'t>.Nil): ListT<'mt> ))) : 'mit) : ListT<'mt> + + let inline apply f x = bind (fun (x1: _) -> bind (fun x2 -> singleton (x1 x2)) x) f + + let inline append (head: 't) tail = wrap ((result <| ListTNode<'mt,'t>.Cons (head, (tail: ListT<'mt> ))) : 'mit) : ListT<'mt> + + let inline head (x : ListT<'mt>) = + unwrap x >>= function + | Nil -> failwith "empty list" + | Cons (head, _) -> result head : 'mt + + let inline tail (x: ListT<'mt>) : ListT<'mt> = + (unwrap x >>= function + | Nil -> failwith "empty list" + | Cons (_: 't, tail) -> unwrap tail) |> wrap + + let inline iter action lst = + let rec loop (seq: ListT<'MT>) (action: 'T -> '``M``) : '``M`` = + unwrap seq >>= function + | Nil -> result () + | Cons (h, t) -> action h >>= (fun () -> loop t action) + loop lst action + + let inline lift (x: '``Monad<'T>``) = wrap (x >>= (result << (fun x -> Cons (x, empty () )))) : ListT<'``Monad<'T>``> + + let inline take count (input : ListT<'MT>) : ListT<'MT> = + let rec loop count (input : ListT<'MT>) : ListT<'MT> = wrap <| monad { + if count > 0 then + let! v = unwrap input + match v with + | Cons (h, t) -> return Cons (h, loop (count - 1) t) + | Nil -> return Nil + else return Nil } + loop count (input: ListT<'MT>) + + let inline run (lst: ListT<'MT>) : '``Monad>`` = + let rec loop acc x = unwrap x >>= function + | Nil -> result (List.rev acc) + | Cons (x, xs) -> loop (x::acc) xs + loop [] lst + + +[] +module ListTPrimitives = + let inline listT (al: '``Monad>``) : ListT<'``Monad<'T>``> = + ListT.unfold (fun i -> map (fun (lst:list<_>) -> if lst.Length > i then Some (lst.[i], i+1) else None) al) 0 + + +type ListT<'``monad<'t>``> with + static member inline Return (x: 'T) = ListT.singleton x : ListT<'M> [] - static member inline Map (x: ListT<'``Monad``>, f: 'T->'U) = ListT.map f x : ListT<'``Monad``> + static member inline Map (x, f) = ListT.map f x - static member inline (<*>) (f: ListT<'``Monad 'U)>``>, x: ListT<'``Monad``>) = ListT.apply f x : ListT<'``Monad``> - static member inline (>>=) (x: ListT<'``Monad``>, f: 'T -> ListT<'``Monad``>) = ListT.bind f x + static member inline (<*>) (f, x) = ListT.apply f x - static member inline get_Empty () = ListT <| result [] : ListT<'``MonadPlus``> - static member inline (<|>) (ListT x, ListT y) = ListT (x >>= (fun a -> y >>= (fun b -> result (a @ b)))) : ListT<'``MonadPlus``> + static member inline (>>=) (x, f) = ListT.bind f x + static member inline get_Empty () = ListT.empty () + static member inline (<|>) (x, y) = ListT.concat x y - static member inline TryWith (source: ListT<'``Monad>``>, f: exn -> ListT<'``Monad>``>) = ListT (TryWith.Invoke (ListT.run source) (ListT.run << f)) - static member inline TryFinally (computation: ListT<'``Monad>``>, f) = ListT (TryFinally.Invoke (ListT.run computation) f) - static member inline Using (resource, f: _ -> ListT<'``Monad>``>) = ListT (Using.Invoke resource (ListT.run << f)) - static member inline Delay (body : unit -> ListT<'``Monad>``>) = ListT (Delay.Invoke (fun _ -> ListT.run (body ()))) : ListT<'``Monad>``> + static member inline TryWith (source: ListT<'``Monad<'T>``>, f: exn -> ListT<'``Monad<'T>``>) = ListT (TryWith.Invoke (ListT.unwrap source) (ListT.unwrap << f)) + static member inline TryFinally (computation: ListT<'``Monad<'T>``>, f) = ListT (TryFinally.Invoke (ListT.unwrap computation) f) + static member inline Using (resource, f: _ -> ListT<'``Monad<'T>``>) = ListT (Using.Invoke resource (ListT.unwrap << f)) + static member inline Delay (body : unit -> ListT<'``Monad<'T>``>) = ListT (Delay.Invoke (fun _ -> ListT.unwrap (body ()))) : ListT<'``Monad<'T>``> + + static member inline Lift (x:'``Monad<'T>``) = ListT.wrap (x >>= (result << (fun x -> Cons (x, ListT.empty () )))) : ListT<'``Monad<'T>``> - static member inline Lift (x: '``Monad<'T>``) = x |> liftM List.singleton |> ListT : ListT<'``Monad>``> - static member inline LiftAsync (x: Async<'T>) = lift (liftAsync x) : '``ListT<'MonadAsync<'T>>`` - + static member inline Throw (x: 'E) = x |> throw |> lift - static member inline Catch (m: ListT<'``MonadError<'E1,'T>``>, h: 'E1 -> ListT<'``MonadError<'E2,'T>``>) = ListT ((fun v h -> Catch.Invoke v h) (ListT.run m) (ListT.run << h)) : ListT<'``MonadError<'E2,'T>``> - - static member inline CallCC (f: (('T -> ListT<'``MonadCont<'R,list<'U>>``>) -> _)) = ListT (callCC <| fun c -> ListT.run (f (ListT << c << List.singleton))) : ListT<'``MonadCont<'R, list<'T>>``> - + static member inline Catch (m: ListT<'``MonadError<'E1,'T>``>, h: 'E1 -> ListT<'``MonadError<'E2,'T>``>) = listT ((fun v h -> Catch.Invoke v h) (ListT.run m) (ListT.run << h)) : ListT<'``MonadError<'E2,'T>``> + + static member inline CallCC (f: (('T -> ListT<'``MonadCont<'R,list<'U>>``>) -> _)) = listT (callCC <| fun c -> ListT.run (f (listT << c << List.singleton))) : ListT<'``MonadCont<'R, list<'T>>``> + static member inline get_Get () = lift get : '``ListT<'MonadState<'S,'S>>`` static member inline Put (x: 'T) = x |> put |> lift : '``ListT<'MonadState>`` - + static member inline get_Ask () = lift ask : '``ListT<'MonadReader<'R, list<'R>>>`` - static member inline Local (ListT (m: '``MonadReader<'R2,'T>``), f: 'R1->'R2) = ListT (local f m) \ No newline at end of file + static member inline Local (m: ListT<'``MonadReader<'R2,'T>``>, f: 'R1->'R2) = listT (local f (ListT.run m)) + + static member inline Take (lst, c, _: Take) = ListT.take c lst From 032f0e512ffab3902c22b57c5223f55f9e59ca9d Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Fri, 23 Aug 2019 15:11:45 +0200 Subject: [PATCH 02/33] + Some basic tests --- .../FSharpPlus.Tests/FSharpPlus.Tests.fsproj | 1 + tests/FSharpPlus.Tests/ListT.fs | 24 +++++++++++++++++++ 2 files changed, 25 insertions(+) create mode 100644 tests/FSharpPlus.Tests/ListT.fs diff --git a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj index 4db77a790..af0dbb345 100644 --- a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj +++ b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj @@ -13,6 +13,7 @@ + diff --git a/tests/FSharpPlus.Tests/ListT.fs b/tests/FSharpPlus.Tests/ListT.fs new file mode 100644 index 000000000..4685e9d77 --- /dev/null +++ b/tests/FSharpPlus.Tests/ListT.fs @@ -0,0 +1,24 @@ +module FSharpPlus.Tests.ListT + +open System +open FSharpPlus +open FSharpPlus.Data +open NUnit.Framework +open FsCheck +open Helpers +open System.Collections.Generic + +module BasicTests = + [] + let wrap_unwrap () = + let c = listT (lazy (['a'..'g'])) + let res = c |> ListT.run |> listT |> ListT.run |> extract + let exp = c |> ListT.run |> extract + CollectionAssert.AreEqual (res, exp) + + [] + let infiniteLists = + let (infinite: ListT>) = ListT.unfold (fun x -> monad { return (Some (x, x + 1) ) }) 0 + let finite = take 12 infinite + let res = finite <|> infinite + CollectionAssert.AreEqual (res |> take 13 |> ListT.run |> extract, [0;1;2;3;4;5;6;7;8;9;10;11;0]) \ No newline at end of file From 7070c94a20de8610ac9ade9415614584bb712522 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Fri, 23 Aug 2019 18:01:05 +0200 Subject: [PATCH 03/33] Roundtrip test fails with Lazy, use Async --- tests/FSharpPlus.Tests/ListT.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharpPlus.Tests/ListT.fs b/tests/FSharpPlus.Tests/ListT.fs index 4685e9d77..36de6904c 100644 --- a/tests/FSharpPlus.Tests/ListT.fs +++ b/tests/FSharpPlus.Tests/ListT.fs @@ -11,7 +11,7 @@ open System.Collections.Generic module BasicTests = [] let wrap_unwrap () = - let c = listT (lazy (['a'..'g'])) + let c = listT (async.Return (['a'..'g'])) let res = c |> ListT.run |> listT |> ListT.run |> extract let exp = c |> ListT.run |> extract CollectionAssert.AreEqual (res, exp) From 231da23c99db8438b2e1e97aac61dff50940cf92 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Fri, 23 Aug 2019 19:00:30 +0200 Subject: [PATCH 04/33] + More tests --- tests/FSharpPlus.Tests/ListT.fs | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/tests/FSharpPlus.Tests/ListT.fs b/tests/FSharpPlus.Tests/ListT.fs index 36de6904c..3e119c5c9 100644 --- a/tests/FSharpPlus.Tests/ListT.fs +++ b/tests/FSharpPlus.Tests/ListT.fs @@ -17,8 +17,30 @@ module BasicTests = CollectionAssert.AreEqual (res, exp) [] - let infiniteLists = + let infiniteLists () = let (infinite: ListT>) = ListT.unfold (fun x -> monad { return (Some (x, x + 1) ) }) 0 let finite = take 12 infinite let res = finite <|> infinite - CollectionAssert.AreEqual (res |> take 13 |> ListT.run |> extract, [0;1;2;3;4;5;6;7;8;9;10;11;0]) \ No newline at end of file + CollectionAssert.AreEqual (res |> take 13 |> ListT.run |> extract, [0;1;2;3;4;5;6;7;8;9;10;11;0]) + + // Compile tests + let binds () = + let res = listT ( [| [1..4] |]) >>= fun x -> listT ( [| [x * 2] |]) + () // but for some reason it doesn't work for Task, ResizeArray, Lazy and seq + + let bind_for_ideantity () = + let res = listT (Identity [1..4]) >>= fun x -> listT (Identity [x * 2]) + () + + let computation_expressions () = + let oneTwoThree : ListT<_> = monad.plus { + do! lift <| Async.Sleep 10 + yield 1 + do! lift <| Async.Sleep 50 + yield 2 + yield 3} + () + + let applicative_with_options () = + let x = (+) listT None <*> listT (Some [1;2;3;4]) + () // It doesn't work with asyncs From ad89c2a3f9f637ec5d3ed59d73810b8b79aacae1 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Fri, 23 Aug 2019 23:58:56 +0200 Subject: [PATCH 05/33] Adapt bind for non-sealed types --- src/FSharpPlus/List.fs | 11 ++++++----- tests/FSharpPlus.Tests/ListT.fs | 9 +++++++-- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/src/FSharpPlus/List.fs b/src/FSharpPlus/List.fs index e6aae1ac1..950ff8e06 100644 --- a/src/FSharpPlus/List.fs +++ b/src/FSharpPlus/List.fs @@ -58,13 +58,14 @@ module ListT = loop l1 l2 : ListT<'mt> let inline bind f (source: ListT<'mt>) : ListT<'mu> = - let rec loop f input = - wrap ( - (unwrap input : 'mit) >>= function + let _mnil _ = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_: 't) -> (result Unchecked.defaultof<'u>) : 'mu + let rec loop f (ListT input) = + ListT ( + (unbox input : 'mit) >>= function | Nil -> result <| (Nil : ListTNode<'mu,'u>) : 'miu | Cons (h:'t, t: ListT<'mt>) -> - let ( res) = concat (f h: ListT<'mu>) (loop f t ) - unwrap res : 'miu) + let res = concat (f h: ListT<'mu>) (loop f t) + unwrap res : 'miu) loop f source : ListT<'mu> let inline unfold (f:'State -> '``M<('T * 'State) option>``) (s:'State) : ListT<'MT> = diff --git a/tests/FSharpPlus.Tests/ListT.fs b/tests/FSharpPlus.Tests/ListT.fs index 3e119c5c9..61e805a25 100644 --- a/tests/FSharpPlus.Tests/ListT.fs +++ b/tests/FSharpPlus.Tests/ListT.fs @@ -7,6 +7,7 @@ open NUnit.Framework open FsCheck open Helpers open System.Collections.Generic +open System.Threading.Tasks module BasicTests = [] @@ -25,8 +26,12 @@ module BasicTests = // Compile tests let binds () = - let res = listT ( [| [1..4] |]) >>= fun x -> listT ( [| [x * 2] |]) - () // but for some reason it doesn't work for Task, ResizeArray, Lazy and seq + let res1 = listT [| [1..4] |] >>= fun x -> listT [| [x * 2] |] + let res2 = listT (Task.FromResult [1..4]) |> ListT.bind (fun x -> listT (Task.FromResult [x * 2])) + let res3 = listT (ResizeArray [ [1..4] ]) |> ListT.bind (fun x -> listT (ResizeArray [ [x * 2] ])) + let res4 = listT (lazy [1..4]) |> ListT.bind (fun x -> listT (lazy ( [x * 2]))) + let (res5: ListT<_ seq>) = listT (seq [ [1..4] ]) |> ListT.bind (fun x -> listT (seq [ [x * 2] ])) + () // Note: seq needs type annotation, the non-sealead types don't work with generic >>= (internal error, unsolved type var) let bind_for_ideantity () = let res = listT (Identity [1..4]) >>= fun x -> listT (Identity [x * 2]) From 1e0ad438a90aa20d9c21bb4d9fd25cc2ff993755 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sat, 24 Aug 2019 00:59:54 +0200 Subject: [PATCH 06/33] Workaround F# bug for generic bind --- src/FSharpPlus/List.fs | 6 +++--- tests/FSharpPlus.Tests/ListT.fs | 10 +++++----- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/FSharpPlus/List.fs b/src/FSharpPlus/List.fs index 950ff8e06..40ec66198 100644 --- a/src/FSharpPlus/List.fs +++ b/src/FSharpPlus/List.fs @@ -58,10 +58,10 @@ module ListT = loop l1 l2 : ListT<'mt> let inline bind f (source: ListT<'mt>) : ListT<'mu> = - let _mnil _ = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_: 't) -> (result Unchecked.defaultof<'u>) : 'mu - let rec loop f (ListT input) = + let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_: 't) -> (result Unchecked.defaultof<'u>) : 'mu + let rec loop f input = ListT ( - (unbox input : 'mit) >>= function + (unwrap input : 'mit) >>= function | Nil -> result <| (Nil : ListTNode<'mu,'u>) : 'miu | Cons (h:'t, t: ListT<'mt>) -> let res = concat (f h: ListT<'mu>) (loop f t) diff --git a/tests/FSharpPlus.Tests/ListT.fs b/tests/FSharpPlus.Tests/ListT.fs index 61e805a25..bc99bc430 100644 --- a/tests/FSharpPlus.Tests/ListT.fs +++ b/tests/FSharpPlus.Tests/ListT.fs @@ -27,11 +27,11 @@ module BasicTests = // Compile tests let binds () = let res1 = listT [| [1..4] |] >>= fun x -> listT [| [x * 2] |] - let res2 = listT (Task.FromResult [1..4]) |> ListT.bind (fun x -> listT (Task.FromResult [x * 2])) - let res3 = listT (ResizeArray [ [1..4] ]) |> ListT.bind (fun x -> listT (ResizeArray [ [x * 2] ])) - let res4 = listT (lazy [1..4]) |> ListT.bind (fun x -> listT (lazy ( [x * 2]))) - let (res5: ListT<_ seq>) = listT (seq [ [1..4] ]) |> ListT.bind (fun x -> listT (seq [ [x * 2] ])) - () // Note: seq needs type annotation, the non-sealead types don't work with generic >>= (internal error, unsolved type var) + let res2 = listT (Task.FromResult [1..4]) >>= (fun x -> listT (Task.FromResult [x * 2])) + let res3 = listT (ResizeArray [ [1..4] ]) >>= (fun x -> listT (ResizeArray [ [x * 2] ])) + let res4 = listT (lazy [1..4]) >>= (fun x -> listT (lazy ( [x * 2]))) + let (res5: ListT<_ seq>) = listT (seq [ [1..4] ]) >>= (fun x -> listT (seq [ [x * 2] ])) + () // Note: seq needs type annotation. let bind_for_ideantity () = let res = listT (Identity [1..4]) >>= fun x -> listT (Identity [x * 2]) From 9d646a63b0862811d831c43359f6dd64c48b87d1 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Mon, 26 Aug 2019 22:02:55 +0200 Subject: [PATCH 07/33] Rename iter to iterM and add a (non-M) iter --- src/FSharpPlus/List.fs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/FSharpPlus/List.fs b/src/FSharpPlus/List.fs index 40ec66198..36dc62f19 100644 --- a/src/FSharpPlus/List.fs +++ b/src/FSharpPlus/List.fs @@ -84,7 +84,7 @@ module ListT = result res : 'miu) collect f (input: ListT<'mt>) : ListT<'mu> - let inline singleton (v:'t) = + let inline singleton (v: 't) = let mresult x = result x let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= konst (mresult ListTNode<'mt,'t>.Nil ) : 'mit wrap ((mresult <| ListTNode<'mt,'t>.Cons (v, (wrap (mresult ListTNode<'mt,'t>.Nil): ListT<'mt> ))) : 'mit) : ListT<'mt> @@ -103,12 +103,14 @@ module ListT = | Nil -> failwith "empty list" | Cons (_: 't, tail) -> unwrap tail) |> wrap - let inline iter action lst = - let rec loop (seq: ListT<'MT>) (action: 'T -> '``M``) : '``M`` = - unwrap seq >>= function + let inline iterM (action: 'T -> '``M``) (lst: ListT<'MT>) : '``M`` = + let rec loop lst action = + unwrap lst >>= function | Nil -> result () | Cons (h, t) -> action h >>= (fun () -> loop t action) loop lst action + + let inline iter (action: 'T -> unit) (lst: ListT<'MT>) = iterM (action >> singleton) lst let inline lift (x: '``Monad<'T>``) = wrap (x >>= (result << (fun x -> Cons (x, empty () )))) : ListT<'``Monad<'T>``> From 3dfad1c2520ec93b3f3a42603595146afe5050ca Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Mon, 26 Aug 2019 22:39:25 +0200 Subject: [PATCH 08/33] fix --- src/FSharpPlus/List.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharpPlus/List.fs b/src/FSharpPlus/List.fs index 36dc62f19..7859dfbf1 100644 --- a/src/FSharpPlus/List.fs +++ b/src/FSharpPlus/List.fs @@ -110,7 +110,7 @@ module ListT = | Cons (h, t) -> action h >>= (fun () -> loop t action) loop lst action - let inline iter (action: 'T -> unit) (lst: ListT<'MT>) = iterM (action >> singleton) lst + let inline iter (action: 'T -> unit) (lst: ListT<'MT>) : '``M`` = iterM (action >> result) lst let inline lift (x: '``Monad<'T>``) = wrap (x >>= (result << (fun x -> Cons (x, empty () )))) : ListT<'``Monad<'T>``> From 20bbea630a58b3f8c80fa6e47e8ea8de20ab7df8 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Mon, 26 Aug 2019 22:56:23 +0200 Subject: [PATCH 09/33] + filterM and filter --- src/FSharpPlus/List.fs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/FSharpPlus/List.fs b/src/FSharpPlus/List.fs index 7859dfbf1..5e3fcd515 100644 --- a/src/FSharpPlus/List.fs +++ b/src/FSharpPlus/List.fs @@ -123,6 +123,11 @@ module ListT = | Nil -> return Nil else return Nil } loop count (input: ListT<'MT>) + + let inline filterM (f: 'T -> ListT<'``M``>) (input: ListT<'MT>) : ListT<'MT> = + input |> ListT.bind (fun v -> f v |> ListT.bind (fun b -> if b then singleton v else empty ())) + + let inline filter f (input: ListT<'MT>) : ListT<'MT> = filterM (f >> singleton) input let inline run (lst: ListT<'MT>) : '``Monad>`` = let rec loop acc x = unwrap x >>= function From e6f854950004be15937208086f8f30a2d249c8e4 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Mon, 26 Aug 2019 23:05:22 +0200 Subject: [PATCH 10/33] fix --- src/FSharpPlus/List.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharpPlus/List.fs b/src/FSharpPlus/List.fs index 5e3fcd515..190646806 100644 --- a/src/FSharpPlus/List.fs +++ b/src/FSharpPlus/List.fs @@ -125,7 +125,7 @@ module ListT = loop count (input: ListT<'MT>) let inline filterM (f: 'T -> ListT<'``M``>) (input: ListT<'MT>) : ListT<'MT> = - input |> ListT.bind (fun v -> f v |> ListT.bind (fun b -> if b then singleton v else empty ())) + input |> bind (fun v -> f v |> bind (fun b -> if b then singleton v else empty ())) let inline filter f (input: ListT<'MT>) : ListT<'MT> = filterM (f >> singleton) input From cdb81a3207d28755d73bc6917a4df0eb0647d058 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Mon, 26 Aug 2019 23:25:15 +0200 Subject: [PATCH 11/33] Align filterM filter type with iterM action type --- src/FSharpPlus/List.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/List.fs b/src/FSharpPlus/List.fs index 190646806..b397b3747 100644 --- a/src/FSharpPlus/List.fs +++ b/src/FSharpPlus/List.fs @@ -124,10 +124,10 @@ module ListT = else return Nil } loop count (input: ListT<'MT>) - let inline filterM (f: 'T -> ListT<'``M``>) (input: ListT<'MT>) : ListT<'MT> = - input |> bind (fun v -> f v |> bind (fun b -> if b then singleton v else empty ())) + let inline filterM (f: 'T -> '``M``) (input: ListT<'MT>) : ListT<'MT> = + input |> bind (fun v -> lift (f v) |> bind (fun b -> if b then singleton v else empty ())) - let inline filter f (input: ListT<'MT>) : ListT<'MT> = filterM (f >> singleton) input + let inline filter f (input: ListT<'MT>) : ListT<'MT> = filterM (f >> result) input let inline run (lst: ListT<'MT>) : '``Monad>`` = let rec loop acc x = unwrap x >>= function From d68e3a589861e6ba20d556a61d0b0637898b15dd Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Thu, 7 Jul 2022 08:58:10 +0200 Subject: [PATCH 12/33] + Error, Reader Writer and State --- src/FSharpPlus/Data/Error.fs | 288 +++++++++++++++++++++++++--------- src/FSharpPlus/Data/Reader.fs | 203 ++++++++++++++++-------- src/FSharpPlus/Data/State.fs | 169 ++++++++++++++------ src/FSharpPlus/Data/Writer.fs | 159 +++++++++++++------ src/FSharpPlus/Internals.fs | 7 + 5 files changed, 586 insertions(+), 240 deletions(-) diff --git a/src/FSharpPlus/Data/Error.fs b/src/FSharpPlus/Data/Error.fs index 2b1b8aa4d..6e327e394 100644 --- a/src/FSharpPlus/Data/Error.fs +++ b/src/FSharpPlus/Data/Error.fs @@ -1,5 +1,7 @@ namespace FSharpPlus.Data +#nowarn "0193" + open System open System.ComponentModel open FSharpPlus @@ -34,131 +36,265 @@ module ResultOrException = /// Monad Transformer for Result<'T, 'E> [] -type ResultT<'``monad>``> = ResultT of '``monad>`` +type ResultT<'e, 'monad, 't> = + /// Represented as 'monad<'result<'t, 'e>> + Value of obj + +type []ResultTOperations = + [] + static member inline ResultT< ^``monad>``, ^monad, 'e, 't when (Map or ^``monad>`` or ^monad) : (static member Map: ( ^``monad>`` * (Result<'t, 'e> -> __)) * Map -> ^monad) + and (Map or ^monad or ^``monad>``) : (static member Map: ( ^monad * (__ -> Result<'t, 'e>)) * Map -> ^``monad>``) + > (x: '``monad>``) : ResultT<'e, 'monad, 't> = + if opaqueId false then + let _: 'monad = Unchecked.defaultof<'``monad>``> |> map (fun (_: Result<'t, 'e>) -> Unchecked.defaultof<__>) + let _: '``monad>`` = Unchecked.defaultof<'monad> |> map (fun (_: __) -> Unchecked.defaultof>) + () + Value (box x) + +module []ResultTOperations = + let inline resultT (x: '``monad>``) : ResultT<'e, 'monad, 't> = ResultT x + let inline (|ResultT|) (Value x: ResultT<'E, 'Monad, 'T>) = + if opaqueId false then + let _: '``Monad>`` = map (fun (_: __) -> Unchecked.defaultof>) Unchecked.defaultof<'Monad> + () + x |> unbox : '``Monad>`` + /// Basic operations on ResultT [] module ResultT = - let run (ResultT x) = x : '``Monad>`` - /// Embed a Monad<'T> into a ResultT<'Monad>> - let inline lift (x: '``Monad<'T>``) : ResultT<'``Monad>``> = - if opaqueId false then x |> liftM Ok |> ResultT - else x |> map Ok |> ResultT + let inline run (ResultT (x: '``Monad>``) : ResultT<'E, 'Monad, 'T>) = x - /// Transform a Result<'T,'Error> to a ResultT<'Monad>> - let inline hoist (x: Result<'T,'TError>) = ResultT (result x) : ResultT<'``Monad>``> + /// Embed a Monad<'T> into a ResultT<'Monad>> + let inline lift<'T, 'E, .. > (x: '``Monad<'T>``) : ResultT<'E, 'Monad, 'T> = + (x |> (if opaqueId false then liftM else map) Result<'T, 'E>.Ok : '``Monad>``) |> ResultT - let inline bind (f: 'T->ResultT<'``Monad>``>) (ResultT m: ResultT<'``Monad>``>) = (ResultT (m >>= (fun a -> match a with Error l -> result (Error l) | Ok r -> run (f r)))) + /// Transform a Result<'T, 'E> to a ResultT<'Monad>> + let inline hoist (x: Result<'T, 'E>) : ResultT<'E, 'Monad, 'T> = + let _: '``Monad>`` = + if opaqueId false then + map (fun _ -> Unchecked.defaultof>) Unchecked.defaultof<'Monad> + else Unchecked.defaultof<_> + ResultT (result x : '``Monad>``) + + + let inline bind<'T, 'U, 'E, .. > (f: 'T -> ResultT<'E, 'Monad, 'U>) (ResultT (m: '``Monad>``) : ResultT<'E, 'Monad, 'T>) : ResultT<'E, 'Monad, 'U> = + (ResultT (m >>= (fun (a: Result<'T, 'E>) -> match a with Error l -> result (Error l: Result<'U, 'E>) | Ok r -> (run (f r) : '``Monad>``)))) + + let inline apply (ResultT (f: '``Monad 'U), 'E>>``) : ResultT<'E, 'Monad, 'T -> 'U>) (ResultT (x : '``Monad>``) : ResultT<'E, 'Monad, 'T>) : ResultT<'E, 'Monad, 'U> = + ResultT ((map: (Result<'T -> 'U, 'E> -> _) -> _ -> '``Monad<(Result<'T,'E> -> Result<'U,'E>>)``) Result.apply f <*> x : '``Monad>``) + + let inline map (f: 'T -> 'U) (ResultT (m: '``Monad>``) : ResultT<'E, 'Monad, 'T>) : ResultT<'E, 'Monad, 'U> = + ResultT (map (Result.map f) m : '``Monad>``) + + let inline map2 (f: 'T -> 'U -> 'V) (ResultT (x: '``Monad>``) : ResultT<'E, 'Monad, 'T>) (ResultT (y: '``Monad>``) : ResultT<'E, 'Monad, 'U>) : ResultT<'E, 'Monad, 'V> = + ResultT (lift2 (Result.map2 f: _ -> _ -> Result<'V, 'E>) x y : '``Monad>``) + + let inline map3 (f: 'T -> 'U -> 'V -> 'W) (ResultT (x: '``Monad>``) : ResultT<'E, 'Monad, 'T>) (ResultT (y: '``Monad>``) : ResultT<'E, 'Monad, 'U>) (ResultT (z: '``Monad>``) : ResultT<'E, 'Monad, 'V>) : ResultT<'E, 'Monad, 'W> = + ResultT (lift3 (Result.map3 f: _ -> _ -> _ -> Result<'W, 'E>) x y z : '``Monad>``) - let inline apply (ResultT f:ResultT<'``Monad 'U),'E>>``>) (ResultT x: ResultT<'``Monad>``>) = ResultT (map Result.apply f <*> x) : ResultT<'``Monad>``> - let inline map (f: 'T->'U) (ResultT m: ResultT<'``Monad>``>) = ResultT (map (Result.map f) m) : ResultT<'``Monad 'U),'E>>``> - let inline map2 (f: 'T->'U->'V) (ResultT x: ResultT<'``Monad>``>) (ResultT y: ResultT<'``Monad>``>) : ResultT<'``Monad>``> = ResultT (lift2 (Result.map2 f) x y) - let inline map3 (f: 'T->'U->'V->'W) (ResultT x: ResultT<'``Monad>``>) (ResultT y: ResultT<'``Monad>``>) (ResultT z: ResultT<'``Monad>``>) : ResultT<'``Monad>``> = ResultT (lift3 (Result.map3 f) x y z) -type ResultT<'``monad>``> with - - static member inline Return (x: 'T) = ResultT (result (Ok x)) : ResultT<'``Monad>``> - - [] - static member inline Map (x: ResultT<'``Monad>``>, f: 'T->'U) = ResultT.map f x : ResultT<'``Monad>``> + +type ResultT<'e, 'monad, 't> with + + static member inline Return (x: 'T) : ResultT<'E, 'Monad, 'T> = + let _: '``Monad>`` = + if opaqueId false then + result Unchecked.defaultof> + else Unchecked.defaultof<_> + let _: '``Monad>`` = + if opaqueId false then + map (fun (_: __) -> Unchecked.defaultof>) Unchecked.defaultof<'Monad> + else Unchecked.defaultof<_> + Value (result (Ok x) : '``Monad>``) + [] - static member inline Lift2 (f: 'T->'U->'V, x: ResultT<'``Monad``>, y: ResultT<'``Monad``>) : ResultT<'``Monad``> = ResultT.map2 f x y + static member inline Map (x: ResultT<'E, 'Monad, 'T>, f: 'T->'U) : ResultT<'E, 'Monad, 'U> = ResultT.map f x [] - static member inline Lift3 (f: 'T->'U->'V->'W, x: ResultT<'``Monad``>, y: ResultT<'``Monad``>, z: ResultT<'``Monad``>) : ResultT<'``Monad``> = ResultT.map3 f x y z + static member inline Lift2 (f: 'T -> 'U -> 'V, x: ResultT<'E, 'Monad, 'T>, y: ResultT<'E, 'Monad, 'U>) : ResultT<'E, 'Monad, 'V> = + ResultT.map2 f x y + + [] + static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, x: ResultT<'E, 'Monad, 'T>, y: ResultT<'E, 'Monad, 'U>, z: ResultT<'E, 'Monad, 'V>) : ResultT<'E, 'Monad, 'W> = + ResultT.map3 f x y z - static member inline (<*>) (f: ResultT<'``Monad 'U),'E>>``>, x: ResultT<'``Monad>``>) = ResultT.apply f x : ResultT<'``Monad>``> - static member inline (>>=) (x: ResultT<'``Monad>``>, f: 'T->ResultT<'``Monad>``>) = ResultT.bind f x + static member inline (<*>) (f: ResultT<'E, 'Monad, 'T -> 'U>, x: ResultT<'E, 'Monad, 'T>) = ResultT.apply f x : ResultT<'E, 'Monad, 'U> - static member inline TryWith (source: ResultT<'``Monad>``>, f: exn -> ResultT<'``Monad>``>) = ResultT (TryWith.Invoke (ResultT.run source) (ResultT.run << f)) - static member inline TryFinally (computation: ResultT<'``Monad>``>, f) = ResultT (TryFinally.Invoke (ResultT.run computation) f) - static member inline Using (resource, f: _ -> ResultT<'``Monad>``>) = ResultT (Using.Invoke resource (ResultT.run << f)) - static member inline Delay (body : unit -> ResultT<'``Monad>``>) = ResultT (Delay.Invoke (fun _ -> ResultT.run (body ()))) + static member inline (>>=) (x: ResultT<'E, 'Monad, 'T>, f: 'T -> ResultT<'E, 'Monad, 'U>) = + ResultT.bind<'T, 'U, 'E, 'Monad, '``Monad>``, '``Monad>``> f x : ResultT<'E, 'Monad, 'U> - [] - static member inline Lift (x: '``Monad<'T>``) : ResultT<'``Monad>``> = ResultT.lift x + static member inline TryWith (source: ResultT<'E, 'Monad, 'T>, f: exn -> ResultT<'E, 'Monad, 'T>) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWith.Invoke (ResultT.run source) (ResultT.run << f)) + static member inline TryFinally (computation: ResultT<'E, 'Monad, 'T>, f) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> (TryFinally.Invoke (ResultT.run computation) f) + static member inline Using (resource, f: _ -> ResultT<'E, 'Monad, 'T>) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> (Using.Invoke resource (ResultT.run << f)) + static member inline Delay (body : unit -> ResultT<'E, 'Monad, 'T>) = Value ((Delay.Invoke (fun _ -> ResultT.run (body ()) : '``Monad>``)) |> box<'``Monad>``>) - static member inline Throw (x: 'E) = x |> Error |> result |> ResultT : ResultT<'``Monad>``> - static member inline Catch (ResultT x: ResultT<'``Monad>``>, f: 'E1 -> _) = (ResultT (x >>= fun a -> match a with Error l -> ResultT.run (f l) | Ok r -> result (Ok (r: 'T)))) : ResultT<'``Monad>``> - static member inline LiftAsync (x: Async<'T>) = ResultT.lift (liftAsync x) : ResultT<'``MonadAsync<'T>``> + [] + static member inline Lift (x: '``Monad<'T>``) : ResultT<'E, 'Monad, 'T> = ResultT.lift<_, _, _, ^``Monad>``, 'Monad> x - static member inline CallCC (f: ('T -> ResultT<'``MonadCont<'R,Result<'U,'E>>``>) -> _) : ResultT<'``MonadCont<'R, Result<'T,'E>>``> = ResultT (callCC <| fun c -> ResultT.run (f (ResultT << c << Result<'T, 'E>.Ok))) + static member inline Throw x = ((x |> Error : Result<'T, 'E>) |> result : '``Monad>``) |> ResultTOperations.ResultT : ResultT<'E, 'Monad, 'T> + static member inline Catch (ResultT (x: '``Monad>``) : ResultT<'E1, 'Monad, 'T>, f: 'E1 -> ResultT<'E2, 'Monad, 'T>) : ResultT<'E2, 'Monad, 'T> = + ResultTOperations.ResultT (x >>= fun a -> match a with Error l -> ResultT.run (f l) | Ok r -> (result (Result<'T, 'E2>.Ok r) : '``Monad>``)) - static member inline get_Ask () = ResultT.lift ask : ResultT<'``MonadReader<'R,Result<'R,'E>>``> - static member inline Local (ResultT m : ResultT<'``MonadReader<'R2,Result<'R2,'E>>``>, f: 'R1->'R2) = ResultT (local f m) + static member inline LiftAsync (x: Async<'T>) : ResultT<'E, 'MonadAsync, 'T> = + ResultT.lift<_, _, _, '``Monad>``, _> (liftAsync x: '``MonadAsync<'T>``) - static member inline Tell (w: 'Monoid) = w |> tell |> ResultT.lift : ResultT<'``Writer<'Monoid,Result>``> + // 'Monad : MonadCont<'R, 'Monad> + static member inline CallCC (f: ('T -> ResultT<'E, 'Monad, 'U>) -> ResultT<'E, 'Monad, 'T>) : ResultT<'E, 'Monad, 'T> = + resultT ((callCC <| fun (c: _ -> '``Monad>``) -> ResultT.run (f (ResultTOperations.ResultT << c << Result<'T, 'E>.Ok))) : '``Monad>``) - static member inline Listen m : ResultT<'``MonadWriter<'Monoid,Result<'T*'Monoid,'E>>``> = - let liftError (m, w) = Result.map (fun x -> (x, w)) m - ResultT (listen (ResultT.run m) >>= (result << liftError)) + // 'Monad : MonadReader<'R, 'Monad> + static member inline get_Ask () : ResultT<'E, '``MonadReader<'R>``, 'R> = ResultT.lift<_, _, '``MonadReader<'R, 'R>``, '``MonadReader<'R, Result<'R, 'E>>``, '``MonadReader<'R>``> ask + static member inline Local (ResultT m : ResultT<'E, '``MonadReader<'R2>``, 'T>, f: 'R1 -> 'R2) : ResultT<'E, '``MonadReader<'R1>``, 'T> = + ResultTOperations.ResultT (local f (m: '``MonadReader<'R2, Result<'T, 'E>>``) : '``MonadReader<'R1, Result<'T, 'E>>``) - static member inline Pass m = ResultT (ResultT.run m >>= either (map Ok << pass << result) (result << Error)) : ResultT<'``MonadWriter<'Monoid,Result<'T,'E>>``> + static member inline Tell (w: 'Monoid) : (*MonadWriter<'Monoid, *)ResultT<'E, '``MonadWriter<'Monoid>``, unit> = + (w |> tell : '``MonadWriter<'Monoid, unit>``) |> ResultT.lift<_, _, _, '``MonadWriter<'Monoid, Result>``, '``MonadWriter<'Monoid>``> - static member inline get_Get () = ResultT.lift get : ResultT<'``MonadState<'S, Result<_, 'E>>``> - static member inline Put (x: 'S) = x |> put |> ResultT.lift : ResultT<'``MonadState<'S, Result<_, 'E>>``> + static member inline Listen (m: ResultT<'E, '``MonadWriter<'Monoid>``, 'T>) : ResultT<'E, '``MonadWriter<'Monoid>``, ('T * 'Monoid)> = + let liftError (m, w) = Result.map (fun x -> (x, w)) m + ResultTOperations.ResultT<'``MonadWriter<'Monoid, Result<('T * 'Monoid), 'E>>``, _, _, _> ((listen (ResultT.run m: '``MonadWriter<'Monoid, Result<'T, 'E>>``) : '``MonadWriter<'Monoid, Result<'T, 'E> * 'Monoid>``) >>= ((result: Result<('T * 'Monoid), 'E> -> '``MonadWriter<'Monoid, Result<('T * 'Monoid), 'E>>``) << liftError)) + static member inline Pass (m: ResultT<'E, '``MonadWriter<'Monoid>``, ('T * ('Monoid -> 'Monoid))>) : ResultT<'E, '``MonadWriter<'Monoid>``, 'T> = + ResultTOperations.ResultT<'``MonadWriter<'Monoid, Result<'T, 'E>>``, _, _, _> ((ResultT.run m: '``MonadWriter<'Monoid, Result<('T * ('Monoid -> 'Monoid)), 'E>>``) >>= either (map Result<'T, 'E>.Ok << (pass: '``MonadWriter<'Monoid, ('T * ('Monoid -> 'Monoid))>`` -> '``MonadWriter<'Monoid, 'T>``) << (result: ('T * ('Monoid -> 'Monoid)) -> _)) (result << Result<'T, 'E>.Error)) + + static member inline get_Get () : ResultT<'E, '``StateMonad<'S>``, 'S> = ResultT.lift<_, _, '``StateMonad<'S, 'S>``, '``StateMonad<'S, Result<'S, 'E>>``, '``StateMonad<'S>``> get + static member inline Put (x: 'S) : ResultT<'E, '``StateMonad<'S>``, unit> = x |> put |> ResultT.lift<_, _, '``StateMonad<'S, unit>``, '``StateMonad<'S, Result>``, '``StateMonad<'S>``> -[] -type ChoiceT<'``monad>``> = ChoiceT of '``monad>`` + +/// Monad Transformer for Choice<'T, 'E> +[] +type ChoiceT<'e, 'monad, 't> = + /// Represented as 'monad<'choice<'t, 'e>> + Value of obj + +type []ChoiceTOperations = + [] + static member inline ChoiceT< ^``monad>``, ^monad, 'e, 't when (Map or ^``monad>`` or ^monad) : (static member Map: ( ^``monad>`` * (Choice<'t, 'e> -> __)) * Map -> ^monad) + and (Map or ^monad or ^``monad>``) : (static member Map: ( ^monad * (__ -> Choice<'t, 'e>)) * Map -> ^``monad>``) + > (x: '``monad>``) : ChoiceT<'e, 'monad, 't> = + if opaqueId false then + let _: 'monad = Unchecked.defaultof<'``monad>``> |> map (fun (_: Choice<'t, 'e>) -> Unchecked.defaultof<__>) + let _: '``monad>`` = Unchecked.defaultof<'monad> |> map (fun (_: __) -> Unchecked.defaultof>) + () + Value (box x) + +module []ChoiceTOperations = + let inline resultT (x: '``monad>``) : ChoiceT<'e, 'monad, 't> = ChoiceT x + let inline (|ChoiceT|) (Value x: ChoiceT<'E, 'Monad, 'T>) = + if opaqueId false then + let _: '``Monad>`` = map (fun (_: __) -> Unchecked.defaultof>) Unchecked.defaultof<'Monad> + () + x |> unbox : '``Monad>`` + + +/// Basic operations on ChoiceT [] module ChoiceT = - let run (ChoiceT x) = x : '``Monad>`` + + let inline run (ChoiceT (x: '``Monad>``) : ChoiceT<'E, 'Monad, 'T>) = x /// Embed a Monad<'T> into a ChoiceT<'Monad>> - let inline lift (x: '``Monad<'T>``) : ChoiceT<'``Monad>``> = - if opaqueId false then x |> liftM Choice1Of2 |> ChoiceT - else x |> map Choice1Of2 |> ChoiceT + let inline lift<'T, 'E, .. > (x: '``Monad<'T>``) : ChoiceT<'E, 'Monad, 'T> = + (x |> (if opaqueId false then liftM else map) Choice<'T, 'E>.Choice1Of2 : '``Monad>``) |> ChoiceT - /// Transform a Choice<'T,'TError> to a ChoiceT<'Monad>> - let inline hoist (x: Choice<'T,'TError>) = ChoiceT (result x) : ChoiceT<'``Monad>``> + /// Transform a Choice<'T, 'E> to a ChoiceT<'Monad>> + let inline hoist (x: Choice<'T, 'E>) : ChoiceT<'E, 'Monad, 'T> = + let _: '``Monad>`` = + if opaqueId false then + map (fun _ -> Unchecked.defaultof>) Unchecked.defaultof<'Monad> + else Unchecked.defaultof<_> + ChoiceT (result x : '``Monad>``) - let inline bind (f: 'T->ChoiceT<'``Monad>``>) (ChoiceT m: ChoiceT<'``Monad>``>) = (ChoiceT (m >>= (fun a -> match a with Choice2Of2 l -> result (Choice2Of2 l) | Choice1Of2 r -> run (f r)))) - let inline apply (ChoiceT f: ChoiceT<'``Monad 'U),'E>>``>) (ChoiceT x: ChoiceT<'``Monad>``>) = ChoiceT (map Choice.apply f <*> x) : ChoiceT<'``Monad>``> - let inline map (f: 'T->'U) (ChoiceT m: ChoiceT<'``Monad>``>) = ChoiceT (map (Choice.map f) m) : ChoiceT<'``Monad 'U),'E>>``> - let inline map2 (f: 'T->'U->'V) (ChoiceT x: ChoiceT<'``Monad>``>) (ChoiceT y: ChoiceT<'``Monad>``>) : ChoiceT<'``Monad>``> = ChoiceT (lift2 (Choice.map2 f) x y) + let inline bind<'T, 'U, 'E, .. > (f: 'T -> ChoiceT<'E, 'Monad, 'U>) (ChoiceT (m: '``Monad>``) : ChoiceT<'E, 'Monad, 'T>) : ChoiceT<'E, 'Monad, 'U> = + (ChoiceT (m >>= (fun (a: Choice<'T, 'E>) -> match a with Choice2Of2 l -> result (Choice2Of2 l: Choice<'U, 'E>) | Choice1Of2 r -> (run (f r) : '``Monad>``)))) + + let inline apply (ChoiceT (f: '``Monad 'U), 'E>>``) : ChoiceT<'E, 'Monad, 'T -> 'U>) (ChoiceT (x : '``Monad>``) : ChoiceT<'E, 'Monad, 'T>) : ChoiceT<'E, 'Monad, 'U> = + ChoiceT ((map: (Choice<'T -> 'U, 'E> -> _) -> _ -> '``Monad<(Choice<'T,'E> -> Choice<'U,'E>>)``) Choice.apply f <*> x : '``Monad>``) + + let inline map (f: 'T -> 'U) (ChoiceT (m: '``Monad>``) : ChoiceT<'E, 'Monad, 'T>) : ChoiceT<'E, 'Monad, 'U> = + ChoiceT (map (Choice.map f) m : '``Monad>``) + + let inline map2 (f: 'T -> 'U -> 'V) (ChoiceT (x: '``Monad>``) : ChoiceT<'E, 'Monad, 'T>) (ChoiceT (y: '``Monad>``) : ChoiceT<'E, 'Monad, 'U>) : ChoiceT<'E, 'Monad, 'V> = + ChoiceT (lift2 (Choice.map2 f: _ -> _ -> Choice<'V, 'E>) x y : '``Monad>``) + + let inline map3 (f: 'T -> 'U -> 'V -> 'W) (ChoiceT (x: '``Monad>``) : ChoiceT<'E, 'Monad, 'T>) (ChoiceT (y: '``Monad>``) : ChoiceT<'E, 'Monad, 'U>) (ChoiceT (z: '``Monad>``) : ChoiceT<'E, 'Monad, 'V>) : ChoiceT<'E, 'Monad, 'W> = + ChoiceT (lift3 (Choice.map3 f: _ -> _ -> _ -> Choice<'W, 'E>) x y z : '``Monad>``) + + + +type ChoiceT<'e, 'monad, 't> with + + static member inline Return (x: 'T) : ChoiceT<'E, 'Monad, 'T> = + let _: '``Monad>`` = + if opaqueId false then + result Unchecked.defaultof> + else Unchecked.defaultof<_> + let _: '``Monad>`` = + if opaqueId false then + map (fun (_: __) -> Unchecked.defaultof>) Unchecked.defaultof<'Monad> + else Unchecked.defaultof<_> + Value (result (Choice1Of2 x) : '``Monad>``) -type ChoiceT<'``monad>``> with - - static member inline Return (x: 'T) = ChoiceT (result (Choice1Of2 x)) : ChoiceT<'``Monad>``> [] - static member inline Map (x: ChoiceT<'``Monad>``>, f: 'T->'U) = ChoiceT.map f x : ChoiceT<'``Monad>``> + static member inline Map (x: ChoiceT<'E, 'Monad, 'T>, f: 'T->'U) : ChoiceT<'E, 'Monad, 'U> = ChoiceT.map f x [] - static member inline Lift2 (f: 'T->'U->'V, x: ChoiceT<'``Monad``>, y: ChoiceT<'``Monad``>) : ChoiceT<'``Monad``> = ChoiceT.map2 f x y + static member inline Lift2 (f: 'T -> 'U -> 'V, x: ChoiceT<'E, 'Monad, 'T>, y: ChoiceT<'E, 'Monad, 'U>) : ChoiceT<'E, 'Monad, 'V> = + ChoiceT.map2 f x y + + [] + static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, x: ChoiceT<'E, 'Monad, 'T>, y: ChoiceT<'E, 'Monad, 'U>, z: ChoiceT<'E, 'Monad, 'V>) : ChoiceT<'E, 'Monad, 'W> = + ChoiceT.map3 f x y z - static member inline (<*>) (f: ChoiceT<'``Monad 'U),'E>>``>, x: ChoiceT<'``Monad>``>) = ChoiceT.apply f x : ChoiceT<'``Monad>``> - static member inline (>>=) (x: ChoiceT<'``Monad>``>, f: 'T->ChoiceT<'``Monad>``>) = ChoiceT.bind f x + static member inline (<*>) (f: ChoiceT<'E, 'Monad, 'T -> 'U>, x: ChoiceT<'E, 'Monad, 'T>) = ChoiceT.apply f x : ChoiceT<'E, 'Monad, 'U> - [] - static member inline Lift (x: '``Monad<'T>``) : ChoiceT<'``Monad>``> = ChoiceT.lift x + static member inline (>>=) (x: ChoiceT<'E, 'Monad, 'T>, f: 'T -> ChoiceT<'E, 'Monad, 'U>) = + ChoiceT.bind<'T, 'U, 'E, 'Monad, '``Monad>``, '``Monad>``> f x : ChoiceT<'E, 'Monad, 'U> + + static member inline TryWith (source: ChoiceT<'E, 'Monad, 'T>, f: exn -> ChoiceT<'E, 'Monad, 'T>) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWith.Invoke (ChoiceT.run source) (ChoiceT.run << f)) + static member inline TryFinally (computation: ChoiceT<'E, 'Monad, 'T>, f) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> (TryFinally.Invoke (ChoiceT.run computation) f) + static member inline Using (resource, f: _ -> ChoiceT<'E, 'Monad, 'T>) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> (Using.Invoke resource (ChoiceT.run << f)) + static member inline Delay (body : unit -> ChoiceT<'E, 'Monad, 'T>) = Value ((Delay.Invoke (fun _ -> ChoiceT.run (body ()) : '``Monad>``)) |> box<'``Monad>``>) - static member inline Throw (x: 'E) = x |> Choice2Of2 |> result |> ChoiceT : ChoiceT<'``Monad>``> - static member inline Catch (ChoiceT x: ChoiceT<'``MonadError<'E1,'T>``>, f: 'E1 -> _) = (ChoiceT (x >>= (fun a -> match a with Choice2Of2 l -> ChoiceT.run (f l) | Choice1Of2 r -> result (Choice1Of2 r)))) : ChoiceT<'``Monad>``> - static member inline LiftAsync (x: Async<'T>) = ChoiceT.lift (liftAsync x) : ChoiceT<'``MonadAsync<'T>``> + [] + static member inline Lift (x: '``Monad<'T>``) : ChoiceT<'E, 'Monad, 'T> = ChoiceT.lift<_, _, _, ^``Monad>``, 'Monad> x - static member inline CallCC (f: ('T -> ChoiceT<'``MonadCont<'R,Choice<'U,'E>>``>) -> _) : ChoiceT<'``MonadCont<'R, Choice<'T,'E>>``> = ChoiceT (callCC <| fun c -> ChoiceT.run (f (ChoiceT << c << Choice1Of2))) + static member inline Throw x = ((x |> Choice2Of2 : Choice<'T, 'E>) |> result : '``Monad>``) |> ChoiceTOperations.ChoiceT : ChoiceT<'E, 'Monad, 'T> + static member inline Catch (ChoiceT (x: '``Monad>``) : ChoiceT<'E1, 'Monad, 'T>, f: 'E1 -> ChoiceT<'E2, 'Monad, 'T>) : ChoiceT<'E2, 'Monad, 'T> = + ChoiceTOperations.ChoiceT (x >>= fun a -> match a with Choice2Of2 l -> ChoiceT.run (f l) | Choice1Of2 r -> (result (Choice<'T, 'E2>.Choice1Of2 r) : '``Monad>``)) - static member inline get_Ask () = ChoiceT.lift ask : ChoiceT<'``MonadReader<'R,Choice<'R,'E>>``> - static member inline Local (ChoiceT m: ChoiceT<'``MonadReader<'R2,Choice<'R2,'E>>``>, f: 'R1->'R2) = ChoiceT (local f m) + static member inline LiftAsync (x: Async<'T>) : ChoiceT<'E, 'MonadAsync, 'T> = + ChoiceT.lift<_, _, _, '``Monad>``, _> (liftAsync x: '``MonadAsync<'T>``) - static member inline Tell (w: 'Monoid) = w |> tell |> ChoiceT.lift : ChoiceT<'``Writer<'Monoid,Choice>``> + // 'Monad : MonadCont<'R, 'Monad> + static member inline CallCC (f: ('T -> ChoiceT<'E, 'Monad, 'U>) -> ChoiceT<'E, 'Monad, 'T>) : ChoiceT<'E, 'Monad, 'T> = + resultT ((callCC <| fun (c: _ -> '``Monad>``) -> ChoiceT.run (f (ChoiceTOperations.ChoiceT << c << Choice<'T, 'E>.Choice1Of2))) : '``Monad>``) - static member inline Listen m : ChoiceT<'``MonadWriter<'Monoid,Choice<'T*'Monoid,'E>>``> = - let liftError (m, w) = Choice.map (fun x -> (x, w)) m - ChoiceT (listen (ChoiceT.run m) >>= (result << liftError)) + // 'Monad : MonadReader<'R, 'Monad> + static member inline get_Ask () : ChoiceT<'E, '``MonadReader<'R>``, 'R> = ChoiceT.lift<_, _, '``MonadReader<'R, 'R>``, '``MonadReader<'R, Choice<'R, 'E>>``, '``MonadReader<'R>``> ask + static member inline Local (ChoiceT m : ChoiceT<'E, '``MonadReader<'R2>``, 'T>, f: 'R1 -> 'R2) : ChoiceT<'E, '``MonadReader<'R1>``, 'T> = + ChoiceTOperations.ChoiceT (local f (m: '``MonadReader<'R2, Choice<'T, 'E>>``) : '``MonadReader<'R1, Choice<'T, 'E>>``) - static member inline Pass m = ChoiceT (ChoiceT.run m >>= either (map Choice1Of2 << pass << result) (result << Error)) : ChoiceT<'``MonadWriter<'Monoid,Choice<'T,'E>>``> + static member inline Tell (w: 'Monoid) : (*MonadWriter<'Monoid, *)ChoiceT<'E, '``MonadWriter<'Monoid>``, unit> = + (w |> tell : '``MonadWriter<'Monoid, unit>``) |> ChoiceT.lift<_, _, _, '``MonadWriter<'Monoid, Choice>``, '``MonadWriter<'Monoid>``> - static member inline get_Get () = ChoiceT.lift get : ChoiceT<'``MonadState<'S, Choice<_, 'E>>``> - static member inline Put (x: 'S) = x |> put |> ChoiceT.lift : ChoiceT<'``MonadState<'S, Choice<_, 'E>>``> + static member inline Listen (m: ChoiceT<'E, '``MonadWriter<'Monoid>``, 'T>) : ChoiceT<'E, '``MonadWriter<'Monoid>``, ('T * 'Monoid)> = + let liftError (m, w) = Choice.map (fun x -> (x, w)) m + ChoiceTOperations.ChoiceT<'``MonadWriter<'Monoid, Choice<('T * 'Monoid), 'E>>``, _, _, _> ((listen (ChoiceT.run m: '``MonadWriter<'Monoid, Choice<'T, 'E>>``) : '``MonadWriter<'Monoid, Choice<'T, 'E> * 'Monoid>``) >>= ((result: Choice<('T * 'Monoid), 'E> -> '``MonadWriter<'Monoid, Choice<('T * 'Monoid), 'E>>``) << liftError)) + + static member inline Pass (m: ChoiceT<'E, '``MonadWriter<'Monoid>``, ('T * ('Monoid -> 'Monoid))>) : ChoiceT<'E, '``MonadWriter<'Monoid>``, 'T> = + ChoiceTOperations.ChoiceT<'``MonadWriter<'Monoid, Choice<'T, 'E>>``, _, _, _> ((ChoiceT.run m: '``MonadWriter<'Monoid, Choice<('T * ('Monoid -> 'Monoid)), 'E>>``) >>= either (map Choice<'T, 'E>.Choice1Of2 << (pass: '``MonadWriter<'Monoid, ('T * ('Monoid -> 'Monoid))>`` -> '``MonadWriter<'Monoid, 'T>``) << (result: ('T * ('Monoid -> 'Monoid)) -> _)) (result << Choice<'T, 'E>.Choice2Of2)) + + static member inline get_Get () : ChoiceT<'E, '``StateMonad<'S>``, 'S> = ChoiceT.lift<_, _, '``StateMonad<'S, 'S>``, '``StateMonad<'S, Choice<'S, 'E>>``, '``StateMonad<'S>``> get + static member inline Put (x: 'S) : ChoiceT<'E, '``StateMonad<'S>``, unit> = x |> put |> ChoiceT.lift<_, _, '``StateMonad<'S, unit>``, '``StateMonad<'S, Choice>``, '``StateMonad<'S>``> #endif diff --git a/src/FSharpPlus/Data/Reader.fs b/src/FSharpPlus/Data/Reader.fs index a95a2c4be..499fe210a 100644 --- a/src/FSharpPlus/Data/Reader.fs +++ b/src/FSharpPlus/Data/Reader.fs @@ -1,9 +1,11 @@ namespace FSharpPlus.Data +#nowarn "0193" #nowarn "1125" open System.ComponentModel open FSharpPlus +open FSharpPlus.Internals.Prelude open FSharpPlus.Control @@ -95,99 +97,168 @@ type Reader<'r,'t> with /// Monad Transformer for Reader<'R, 'T> [] -type ReaderT<'r,'``monad<'t>``> = ReaderT of ('r -> '``monad<'t>``) +type ReaderT<'r, 'monad, 't> = + /// Represented as 'r -> 'monad<'t> + Value of ('r -> obj) + +type []ReaderTOperations = + [] + static member inline ReaderT< ^``monad<'t>``, ^monad, 'r, 't when (Map or ^``monad<'t>`` or ^monad) : (static member Map: ( ^``monad<'t>`` * ('t -> __)) * Map -> ^monad) + and (Map or ^monad or ^``monad<'t>``) : (static member Map: ( ^monad * (__ -> 't)) * Map -> ^``monad<'t>``) + > (f: 'r -> '``monad<'t>``) : ReaderT<'r, 'monad, 't> = + if opaqueId false then + let _: 'monad = Unchecked.defaultof<'``monad<'t>``> |> map (fun (_: 't) -> Unchecked.defaultof<__>) + let _: '``monad<'t>`` = Unchecked.defaultof<'monad> |> map (fun (_: __) -> Unchecked.defaultof<'t>) + () + Value (f >> box) + +module []ReaderTOperations = + let inline readerT (x: 'r -> '``monad<'t>``) : ReaderT<'r, 'monad, 't> = ReaderT x + let inline (|ReaderT|) (Value x: ReaderT<'R, 'Monad, 'T>) = + if opaqueId false then + let _: '``Monad<'T>`` = map (fun (_: __) -> Unchecked.defaultof<'T>) Unchecked.defaultof<'Monad> + () + x >> unbox : 'R -> '``Monad<'T>`` + + /// Basic operations on Reader [] module ReaderT = - let run (ReaderT x) = x : 'R -> '``Monad<'T>`` - - let inline hoist (x: Reader<'R, 'T>) = (ReaderT << (fun a -> result << a) << Reader.run) x : ReaderT<'R, '``Monad<'T>``> - - let inline map (f: 'T->'U) (ReaderT m: ReaderT<'R, '``Monad<'T>``>) = ReaderT (map f << m) : ReaderT<'R, '``Monad<'U>``> + let inline run (ReaderT (x : 'R -> '``Monad<'T>``) : ReaderT<'R, 'Monad, 'T>) = x + + /// Transform a Reader<'R, 'T> to a ReaderT<'R, 'Monad, 'T> + let inline hoist (x: Reader<'R, 'T>) = + let _: '``Monad<'T>`` = + if opaqueId false then + map (fun _ -> Unchecked.defaultof<'T>) Unchecked.defaultof<'Monad> + else Unchecked.defaultof<_> + (ReaderT << (fun a -> (result: _ -> '``Monad<'T>``) << a) << Reader.run) x : ReaderT<'R, 'Monad, 'T> + + let inline map<'T, 'U, 'R, .. > (f: 'T -> 'U) (ReaderT (m: _ -> '``Monad<'T>``) : ReaderT<'R, 'Monad, 'T>) = + ReaderT (map f << m : _ -> '``Monad<'U>``) : ReaderT<'R, 'Monad, 'U> /// Combines two ReaderTs into one by applying a mapping function. - let inline map2 (f: 'T->'U->'V) (ReaderT x: ReaderT<'R,'``Monad<'T>``>) (ReaderT y: ReaderT<'R,'``Monad<'U>``>) = ReaderT (fun a -> lift2 f (x a) (y a)) : ReaderT<'R,'``Monad<'V>``> - + let inline map2<'T, 'U, 'V, 'R, .. > (f: 'T -> 'U -> 'V) (ReaderT (x: 'R -> '``Monad<'T>``) : ReaderT<'R, 'Monad, 'T>) (ReaderT (y: 'R -> '``Monad<'U>``) : ReaderT<'R, 'Monad, 'U>) : ReaderT<'R, 'Monad, 'V> = + ReaderT ((fun a -> lift2 f (x a) (y a)) : 'R -> '``Monad<'V>``) + /// Combines three ReaderTs into one by applying a mapping function. - let inline map3 (f: 'T->'U->'V->'W) (ReaderT x: ReaderT<'R,'``Monad<'T>``>) (ReaderT y: ReaderT<'R,'``Monad<'U>``>) (ReaderT z: ReaderT<'R,'``Monad<'V>``>) = ReaderT (fun a -> lift3 f (x a) (y a) (z a)) : ReaderT<'R,'``Monad<'W>``> - - let inline apply (ReaderT (f: _ -> '``Monad<'T -> 'U>``)) (ReaderT (x: _->'``Monad<'T>``)) = ReaderT (fun r -> f r <*> x r) : ReaderT<'R, '``Monad<'U>``> - + let inline map3<'T, 'U, 'V, 'W, 'R, .. > (f: 'T -> 'U -> 'V -> 'W) (ReaderT (x: 'R -> '``Monad<'T>``) : ReaderT<'R, 'Monad, 'T>) (ReaderT (y: 'R -> '``Monad<'U>``) : ReaderT<'R, 'Monad, 'U>) (ReaderT (z: 'R -> '``Monad<'V>``) : ReaderT<'R, 'Monad, 'V>) : ReaderT<'R, 'Monad, 'W> = + ReaderT ((fun a -> lift3 f (x a) (y a) (z a)) : 'R -> '``Monad<'W>``) + + let inline apply<'T, 'U, 'R, .. > (ReaderT (f: 'R -> '``Monad<'T -> 'U>``) : ReaderT<'R, 'Monad, ('T -> 'U)>) (ReaderT x : ReaderT<'R, 'Monad, 'T>) : ReaderT<'R, 'Monad, 'U> = + ReaderT (fun r -> (f r <*> (x r : '``Monad<'T>``) : '``Monad<'U>``)) + /// Zips two ReaderTs into one. - let inline zip (x: ReaderT<'S,'``Monad<'T>``>) (y: ReaderT<'S,'``Monad<'U>``>) = apply (map tuple2 x) y : ReaderT<'S,'``Monad<'T * 'U>``> - - let inline bind (f: 'T->_) (ReaderT (m: _->'``Monad<'T>``)) = ReaderT (fun r -> m r >>= (fun a -> run (f a) r)) : ReaderT<'R, '``Monad<'U>``> - - /// Embed a Monad<'T> into an ReaderT<'R, 'Monad<'T>> - let lift m = ReaderT (fun _ -> m) : ReaderT<'R, '``Monad<'T>``> - -type ReaderT<'r,'``monad<'t>``> with - - static member inline Return (x: 'T) = ReaderT (fun _ -> result x) : ReaderT<'R, '``Monad<'T>``> - + let inline zip (x: ReaderT<'R, 'Monad, 'T>) (y: ReaderT<'R, 'Monad, 'U>) : ReaderT<'R, 'Monad, ('T * 'U)> = apply (map tuple2 x) y + + let inline bind<'T, 'U, 'R, .. > (f: 'T -> ReaderT<'R, 'Monad, 'U>) (ReaderT m: ReaderT<'R, 'Monad, 'T>) : ReaderT<'R, 'Monad, 'U> = + ReaderT (fun r -> (m r: '``Monad<'T>``) >>= (fun a -> run (f a) r) : '``Monad<'U>``) + + /// Embed a Monad<'T> into an ReaderT<'R, 'Monad, 'T> + let inline lift<'T, 'R, .. > (m: '``Monad<'T>``) = ReaderT (fun _ -> m) : ReaderT<'R, 'Monad, 'T> + +type ReaderT<'r, 'monad, 't> with + + static member inline Return (x: 'T) = + let _: '``Monad<'T>`` = + if opaqueId false then + result Unchecked.defaultof<'T> + else Unchecked.defaultof<_> + let _: '``Monad<'T>`` = + if opaqueId false then + map (fun (_: __) -> Unchecked.defaultof<'T>) Unchecked.defaultof<'Monad> + else Unchecked.defaultof<_> + Value (fun _ -> box (result x : '``Monad<'T>``)) : ReaderT<'R, 'Monad, 'T> + [] - static member inline Map (x: ReaderT<'R, '``Monad<'T>``>, f: 'T->'U) : ReaderT<'R, '``Monad<'U>``> = ReaderT.map f x - + static member inline Map (x: ReaderT<'R, 'Monad, 'T>, f: 'T -> 'U) : ReaderT<'R, 'Monad, 'U> = ReaderT.map f x + /// Lifts a function into a ReaderT. Same as map. /// To be used in Applicative Style expressions, combined with <*> /// /// Functor - static member inline () (f: 'T->'U, x: ReaderT<'R, '``Monad<'T>``>) : ReaderT<'R, '``Monad<'U>``> = ReaderT.map f x - + static member inline () (f: 'T -> 'U, x: ReaderT<'R, 'Monad, 'T>) : ReaderT<'R, 'Monad, 'U> = ReaderT.map<_, _, _, 'Monad, '``Monad<'T>``, '``Monad<'U>``> f x + [] - static member inline Lift2 (f: 'T->'U->'V, x: ReaderT<'R,'``Monad<'T>``>, y: ReaderT<'R,'``Monad<'U>``>) : ReaderT<'R,'``Monad<'V>``> = ReaderT.map2 f x y - + static member inline Lift2 (f: 'T -> 'U -> 'V, x: ReaderT<'R, 'Monad, 'T>, y: ReaderT<'R, 'Monad, 'U>) : ReaderT<'R, 'Monad, 'V> = + ReaderT.map2<'T, 'U, 'V, 'R, 'Monad, '``Monad<'T>``, '``Monad<'U>``, '``Monad<'V>``> f x y + [] - static member inline Lift3 (f: 'T->'U->'V->'W, x: ReaderT<'R,'``Monad<'T>``>, y: ReaderT<'R,'``Monad<'U>``>, z: ReaderT<'R,'``Monad<'V>``>) : ReaderT<'R,'``Monad<'W>``> = ReaderT.map3 f x y z - - static member inline (<*>) (f: ReaderT<_,'``Monad<'T -> 'U>``>, x: ReaderT<_,'``Monad<'T>``>) = ReaderT.apply f x : ReaderT<'R, '``Monad<'U>``> - + static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, x: ReaderT<'R, 'Monad, 'T>, y: ReaderT<'R, 'Monad, 'U>, z: ReaderT<'R, 'Monad, 'V>) : ReaderT<'R, 'Monad, 'W> = + ReaderT.map3<'T, 'U, 'V, 'W, 'R, 'Monad, '``Monad<'T>``, '``Monad<'U>``, '``Monad<'V>``, '``Monad<'W>``> f x y z + + static member inline (<*>) (f: ReaderT<_, 'Monad, ('T -> 'U)>, x: ReaderT<_, 'Monad, 'T>) : ReaderT<'R, 'Monad, 'U> = + ReaderT.apply<_, _, _, 'Monad, '``Monad<'(T -> 'U)>``, '``Monad<'T>``, '``Monad<'U>``> f x + /// /// Sequences two Readers left-to-right, discarding the value of the first argument. /// /// Applicative - static member inline ( *>) (x: ReaderT<'R, '``Monad<'T>``>, y: ReaderT<'R, '``Monad<'U>``>) : ReaderT<'R, '``Monad<'U>``> = ((fun (_: 'T) (k: 'U) -> k) x : ReaderT<'R, '``Monad<'U->'U>``>) y - + static member inline ( *>) (x: ReaderT<'R, 'Monad, 'T>, y: ReaderT<'R, 'Monad, 'U>) : ReaderT<'R, 'Monad, 'U> = + let () = ReaderT.map<_, _, _, 'Monad, '``Monad<'T>``, '``Monad<('U -> 'U)>``> + let (<*>) = ReaderT.apply<_, _, _, 'Monad, '``Monad<'(U -> 'U)>``, '``Monad<'U>``, '``Monad<'U>``> + ((fun (_: 'T) (k: 'U) -> k) x: ReaderT<'R, 'Monad, ('U -> 'U)>) <*> y + /// /// Sequences two Readers left-to-right, discarding the value of the second argument. /// /// Applicative - static member inline (<* ) (x: ReaderT<'R, '``Monad<'U>``>, y: ReaderT<'R, '``Monad<'T>``>) : ReaderT<'R, '``Monad<'U>``> = ((fun (k: 'U) (_: 'T) -> k ) x : ReaderT<'R, '``Monad<'T->'U>``>) y - - static member inline (>>=) (x: ReaderT<_,'``Monad<'T>``>, f: 'T->ReaderT<'R,'``Monad<'U>``>) = ReaderT.bind f x : ReaderT<'R, '``Monad<'U>``> - - static member inline get_Empty () = ReaderT (fun _ -> getEmpty ()) : ReaderT<'R, '``MonadPlus<'T>``> - static member inline (<|>) (ReaderT m, ReaderT n) = ReaderT (fun r -> m r <|> n r) : ReaderT<'R, '``MonadPlus<'T>``> - + static member inline (<* ) (x: ReaderT<'R, 'Monad, 'U>, y: ReaderT<'R, 'Monad, 'T>) : ReaderT<'R, 'Monad, 'U> = + let () = ReaderT.map<_, _, _, 'Monad, '``Monad<'U>``, '``Monad<('T -> 'U)>``> + let (<*>) = ReaderT.apply<_, _, _, 'Monad, '``Monad<'(T -> 'U)>``, '``Monad<'T>``, '``Monad<'U>``> + ((fun (k: 'U) (_: 'T) -> k) x: ReaderT<'R, 'Monad, ('T -> 'U)>) <*> y + + static member inline (>>=) (x: ReaderT<_, 'Monad, 'T>, f: 'T -> ReaderT<'R, 'Monad, 'U>) : ReaderT<'R, 'Monad, 'U> = + ReaderT.bind<_, _, _, 'Monad, '``Monad<'T>``, '``Monad<'U>``> f x + + static member inline get_Empty () = ReaderTOperations.ReaderT (fun _ -> getEmpty () : '``MonadPlus<'T>``) : ReaderT<'R, 'MonadPlus, 'T> + static member inline (<|>) (ReaderT (m: 'R -> '``MonadPlus<'T>``) : ReaderT<'R, 'MonadPlus, 'T>, ReaderT (n: 'R -> '``MonadPlus<'T>``) : ReaderT<'R, 'MonadPlus, 'T>) : ReaderT<'R, 'MonadPlus, 'T> = + ReaderTOperations.ReaderT (fun r -> m r <|> n r) + [] - static member inline Zip (x: ReaderT<'S,'``Monad<'T>``>, y: ReaderT<'S,'``Monad<'U>``>) = ReaderT.zip x y + static member inline Zip (x: ReaderT<'S, 'Monad, 'T>, y: ReaderT<'S, 'Monad, 'U>) = ReaderT.zip x y + + static member inline TryWith (source: ReaderT<'R, 'Monad, 'T>, f: exn -> ReaderT<'R, 'Monad, 'T>) = + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWith.InvokeForStrict (fun () -> (ReaderT.run source s : '``Monad<'T>``)) (fun x -> ReaderT.run (f x) s)) - static member inline TryWith (source: ReaderT<'R,'``Monad<'T>``>, f: exn -> ReaderT<'R,'``Monad<'T>``>) = ReaderT (fun s -> TryWith.InvokeForStrict (fun () -> ReaderT.run source s) (fun x -> ReaderT.run (f x) s)) - static member inline TryFinally (computation: ReaderT<'R,'``Monad<'T>``>, f) = ReaderT (fun s -> TryFinally.InvokeForStrict (fun () -> ReaderT.run computation s) f) - static member inline Using (resource, f: _ -> ReaderT<'R,'``Monad<'T>``>) = ReaderT (fun s -> Using.Invoke resource (fun x -> ReaderT.run (f x) s)) - static member inline Delay (body : unit -> ReaderT<'R,'``Monad<'T>``>) = ReaderT (fun s -> Delay.Invoke (fun _ -> ReaderT.run (body ()) s)) - - [] - static member Lift m = ReaderT (fun _ -> m) : ReaderT<'R,'``Monad<'T>``> + static member inline TryFinally (computation: ReaderT<'R, 'Monad, 'T>, f) = + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinally.InvokeForStrict (fun () -> ReaderT.run computation s) f) - static member inline LiftAsync (x: Async<'T>) = (ReaderT.lift (liftAsync x) : ReaderT<'R,'``MonadAsync<'T>``>) + static member inline Using (resource, f: _ -> ReaderT<'R, 'Monad, 'T>) = + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> Using.Invoke resource (fun x -> ReaderT.run (f x) s)) - static member inline CallCC (f: ('T -> ReaderT<'R, '``MonadCont<'C,'U>``>) -> _) : ReaderT<'R,'``MonadCont<'C,'T>``> = - ReaderT (fun r -> callCC <| fun c -> ReaderT.run (f (fun a -> ReaderT <| fun _ -> c a)) r) - - static member inline get_Ask () = ReaderT result : ReaderT<'R,'``Monad<'T>``> - static member Local (ReaderT m, f: _->'R2) = ReaderT (fun r -> m (f r)) : ReaderT<'R1,'``Monad<'T>``> + static member inline Delay (body : unit -> ReaderT<'R, 'Monad, 'T>) : ReaderT<'R, 'Monad, 'T> = + Value ((fun s -> Delay.Invoke (fun _ -> (ReaderT.run (body ()) s : '``Monad<'T>``) )) >> box<'``Monad<'T>``>) - static member inline Throw (x: 'E) = x |> throw |> ReaderT.lift : ReaderT<'R,'``MonadError<'E,'T>``> - static member inline Catch (m: ReaderT<'R,'``MonadError<'E1,'T>``>, h: 'E1 -> _) = - ReaderT (fun s -> catch (ReaderT.run m s) (fun e -> ReaderT.run (h e) s)) : ReaderT<'R,'``MonadError<'E2,'T>``> - - static member inline Tell (w: 'Monoid) = w |> tell |> ReaderT.lift : ReaderT<'R, '``MonadWriter<'Monoid,unit>``> - static member inline Listen (ReaderT m) = ReaderT (fun w -> listen (m w)) : ReaderT<'R, '``MonadWriter<'Monoid,'T*'Monoid>``> - static member inline Pass (ReaderT m) = ReaderT (fun w -> pass (m w)) : ReaderT<'R, '``MonadWriter<'Monoid,'T>``> - - static member inline get_Get () = ReaderT.lift get : ReaderT<'R, '``MonadState<'S, 'S>``> - static member inline Put (x: 'S) = x |> put |> ReaderT.lift : ReaderT<'R, '``MonadState<'S, unit>``> + [] + static member inline Lift (m: '``Monad<'T>``) : ReaderT<'R, 'Monad, 'T> = ReaderT.lift m + + static member inline LiftAsync (x: Async<'T>) : ReaderT<'R, 'MonadAsync, 'T> = ReaderT.lift (liftAsync x : '``MonadAsync<'T>``) + + static member inline CallCC (f: ('T -> ReaderT<'R, '``MonadCont<'C>``, 'U>) -> ReaderT<'R, '``MonadCont<'C>``, 'T>) : ReaderT<'R, '``MonadCont<'C>``, 'T> = + ReaderTOperations.ReaderT (fun r -> callCC <| fun (c: _ -> '``MonadCont<'C, 'U>``) -> ReaderT.run (f (fun a -> ReaderTOperations.ReaderT (fun _ -> c a))) r: '``MonadCont<'C, 'T>``) + + static member inline get_Ask () : ReaderT<'R, 'Monad, 'T> = ReaderTOperations.ReaderT (result: 'R -> '``Monad<'R>``) + static member inline Local (ReaderT (m: 'R2 -> '``Monad<'T>``) : ReaderT<'R2, 'Monad, 'T>, f: 'R1 -> 'R2) : ReaderT<'R1, 'Monad, 'T> = ReaderTOperations.ReaderT (fun r -> m (f r)) + + static member inline Throw (x: 'E) : ReaderT<'R, '``MonadError<'E>``, 'T> = + x |> (throw: 'E -> '``MonadError<'E, 'T>``) |> ReaderT.lift + + static member inline Catch (m: ReaderT<'R, '``MonadError<'E1>``, 'T>, h: 'E1 -> ReaderT<'R, '``MonadError<'E2>``, 'T>) : ReaderT<'R, '``MonadError<'E2>``, 'T> = + ReaderTOperations.ReaderT (fun s -> catch (ReaderT.run m s : '``MonadError<'E1, 'T>``) (fun e -> ReaderT.run (h e) s : '``MonadError<'E2, 'T>``)) + + + static member inline Tell (w: 'Monoid) : ReaderT<'R, '``MonadWriter<'Monoid>``, unit> = + ReaderT.lift (tell w: '``MonadWriter<'Monoid, unit>``) + + static member inline Listen (ReaderT m: ReaderT<'R, '``MonadWriter<'Monoid>``, 'T>) : ReaderT<'R, '``MonadWriter<'Monoid>``, ('T * 'Monoid)> = + ReaderTOperations.ReaderT<'``MonadWriter<'Monoid, ('T * 'Monoid)>``, _, _, _> (fun w -> listen (m w: '``MonadWriter<'Monoid, 'T>``)) + + static member inline Pass (ReaderT m: ReaderT<'R, '``MonadWriter<'Monoid>``, ('T * ('Monoid -> 'Monoid))>) : ReaderT<'R, '``MonadWriter<'Monoid>``, 'T> = + ReaderTOperations.ReaderT (fun w -> pass (m w: '``MonadWriter<'Monoid, ('T * ('Monoid -> 'Monoid))>``) : '``MonadWriter<'Monoid, 'T>``) + + static member inline get_Get () : ReaderT<'R, '``MonadState<'S>``, 'S> = ReaderT.lift (get: '``MonadState<'S, 'S>``) + static member inline Put (x: 'S) : ReaderT<'R, '``MonadState<'S>``, unit> = ReaderT.lift (put x: '``MonadState<'S, unit>``) #endif diff --git a/src/FSharpPlus/Data/State.fs b/src/FSharpPlus/Data/State.fs index 3cf5d7ad6..9872cf790 100644 --- a/src/FSharpPlus/Data/State.fs +++ b/src/FSharpPlus/Data/State.fs @@ -1,5 +1,6 @@ namespace FSharpPlus.Data +#nowarn "0193" #nowarn "1125" open System.ComponentModel @@ -105,97 +106,165 @@ open FSharpPlus.Internals.Prelude /// Monad Transformer for State<'S, 'T> [] -type StateT<'s,'``monad<'t * 's>``> = StateT of ('s -> '``monad<'t * 's>``) +type StateT<'s, 'monad, 't> = + /// Represented as 'monad<'t * 's> + Value of ('s -> obj) + +type []StateTOperations = + [] + static member inline StateT< ^``monad<'t * 's>``, ^monad, 's, 't when (Map or ^``monad<'t * 's>`` or ^monad) : (static member Map: ( ^``monad<'t * 's>`` * ('t * 's -> __)) * Map -> ^monad) + and (Map or ^monad or ^``monad<'t * 's>``) : (static member Map: ( ^monad * (__ -> 't * 's)) * Map -> ^``monad<'t * 's>``) + > (f: 's -> '``monad<'t * 's>``) : StateT<'s,'monad,'t> = + if opaqueId false then + let _: 'monad = Unchecked.defaultof<'``monad<'t * 's>``> |> map (fun (_: 't * 's) -> Unchecked.defaultof<__>) + let _: '``monad<'t * 's>`` = Unchecked.defaultof<'monad> |> map (fun (_: __) -> Unchecked.defaultof<'t * 's>) + () + Value (f >> box) + +module []StateTOperations = + let inline stateT (x: 's -> '``monad<'t * 's>``) : StateT<'s, 'monad, 't> = StateT x + let inline (|StateT|) (Value x: StateT<'S,'Monad,'T>) = + if opaqueId false then + let _: '``Monad<'T * 'S>`` = map (fun (_: __) -> Unchecked.defaultof<'T * 'S>) Unchecked.defaultof<'Monad> + () + x >> unbox : 'S -> '``Monad<'T * 'S>`` /// Basic operations on StateT [] module StateT = - /// Runs the state with an inital state to get back the result and the new state wrapped in an inner monad. - let run (StateT x) = x : 'S -> '``Monad<'T * 'S>`` - /// Embed a Monad<'T> into a StateT<'S,'``Monad<'T * 'S>``> - let inline lift (m: '``Monad<'T>``) : StateT<'S,'``Monad<'T * 'S>``> = - if opaqueId false then StateT <| fun s -> (m |> liftM (fun a -> (a, s))) - else StateT <| fun s -> (m |> map (fun a -> (a, s))) + open FSharpPlus.Control - /// Transform a State<'S, 'T> to a StateT<'S, '``Monad<'T * 'S>``> - let inline hoist (x: State<'S, 'T>) = (StateT << (fun a -> result << a) << State.run) x : StateT<'S, '``Monad<'T * 'S>``> + /// Runs the state with an inital state to get back the result and the new state wrapped in an inner monad. + let inline run (StateT (x : 'S -> '``Monad<'T * 'S>``) : StateT<'S, 'Monad, 'T>) = x - let inline map (f: 'T->'U) (StateT (m :_->'``Monad<'T * 'S>``)) = StateT (m >> Map.Invoke (fun (a, s') -> (f a, s'))) : StateT<'S,'``Monad<'U * 'S>``> + /// Embed a Monad<'T> into a StateT<'S, 'Monad, 'T> + let inline lift<'T, 'S, .. > (m: '``Monad<'T>``) : StateT<'S, 'Monad, 'T> = + StateT <| fun s -> ((m |> (if opaqueId false then liftM else map) (fun (a: 'T) -> (a, s))) : '``Monad<'T * 'S>``) + /// Transform a State<'S, 'T> to a StateT<'S, '``Monad<'T * 'S>``> + let inline hoist (x: State<'S, 'T>) = + let _: '``Monad<'T * 'S>`` = + if opaqueId false then + map (fun _ -> Unchecked.defaultof<'T * 'S>) Unchecked.defaultof<'Monad> + else Unchecked.defaultof<_> + (StateT << (fun a -> (result: ('T * 'S) -> '``Monad<'T * 'S>``) << a) << State.run) x : StateT<'S, 'Monad, 'T> + + let inline map<'T, 'U, 'S, .. > (f: 'T -> 'U) (StateT (m: _ -> '``Monad<'T * 'S>``) : StateT<'S, 'Monad, 'T>) = + StateT (m >> (Map.Invoke (fun (a, s': 'S) -> (f a, s')) : _ -> '``Monad<'U * 'S>``)) : StateT<'S, 'Monad, 'U> + /// Combines two StateTs into one by applying a mapping function. - let inline map2 (f: 'T->'U->'V) (StateT x: StateT<'S,'``Monad<'T * 'S>``>) (StateT y: StateT<'S,'``Monad<'U * 'S>``>) : StateT<'S,'``Monad<'V * 'S>``> = StateT (fun s -> x s >>= fun (g, s1) -> y s1 >>= fun (h, s2: 'S) -> result (f g h, s2)) : StateT<'S,'``Monad<'V * 'S>``> + let inline map2<'T, 'U, 'V, 'S, .. > (f: 'T -> 'U -> 'V) (StateT (x: 'S -> '``Monad<'T * 'S>``) : StateT<'S, 'Monad, 'T>) (StateT (y: 'S -> '``Monad<'U * 'S>``) : StateT<'S, 'Monad, 'U>) : StateT<'S, 'Monad, 'V> = + StateT (fun s -> (x s: '``Monad<'T * 'S>``) >>= fun (g, s1) -> (y s1: '``Monad<'U * 'S>``) >>= fun (h, s2: 'S) -> (result (f g h, s2) : '``Monad<'V * 'S>``)) /// Combines three StateTs into one by applying a mapping function. - let inline map3 (f: 'T->'U->'V->'W) (StateT x: StateT<'S,'``Monad<'T * 'S>``>) (StateT y: StateT<'S,'``Monad<'U * 'S>``>) (StateT z: StateT<'S,'``Monad<'V * 'S>``>) : StateT<'S,'``Monad<'W * 'S>``> = - StateT (fun s -> x s >>= fun (g, s1) -> y s1 >>= fun (h, s2) -> z s2 >>= fun (i, s3) -> result (f g h i, s3)) - - let inline apply (StateT f: StateT<'S,'``Monad<('T -> 'U) * 'S>``>) (StateT a: StateT<'S,'``Monad<'T * 'S>``>) = StateT (fun s -> f s >>= fun (g, t) -> Map.Invoke (fun (z: 'T, u: 'S) -> ((g z: 'U), u)) (a t)) : StateT<'S,'``Monad<'U * 'S>``> + let inline map3<'T, 'U, 'V, 'W, 'S, .. > (f: 'T -> 'U -> 'V -> 'W) (StateT (x: 'S -> '``Monad<'T * 'S>``) : StateT<'S, 'Monad, 'T>) (StateT (y: 'S -> '``Monad<'U * 'S>``) : StateT<'S, 'Monad, 'U>) (StateT (z: 'S -> '``Monad<'V * 'S>``): StateT<'S, 'Monad, 'V>) : StateT<'S, 'Monad, 'W> = + StateT (fun s -> (x s: '``Monad<'T * 'S>``) >>= fun (g, s1) -> (y s1: '``Monad<'U * 'S>``) >>= fun (h, s2) -> (z s2: '``Monad<'V * 'S>``) >>= fun (i, s3: 'S) -> (result (f g h i, s3) : '``Monad<'W * 'S>``)) + + let inline apply<'T, 'U, 'S, .. > (StateT (f: 'S -> '``Monad<('T -> 'U) * 'S>``) : StateT<'S,'Monad,('T -> 'U)>) (StateT a: StateT<'S,'Monad,'T>) : StateT<'S, 'Monad, 'U> = + StateT (fun s -> f s >>= fun (g, t) -> (Map.Invoke (fun (z: 'T, u: 'S) -> ((g z: 'U), u)) (a t: '``Monad<'T * 'S>``) : '``Monad<'U * 'S>``)) - /// Zips two StateTs into one. - let inline zip (x: StateT<'S,'``Monad<'T * 'S>``>) (y: StateT<'S,'``Monad<'U * 'S>``>) = apply (map tuple2 x) y : StateT<'S,'``Monad<('T * 'U) * 'S>``> + // /// Zips two StateTs into one. + let inline zip (x: StateT<'S, 'Monad, 'T>) (y: StateT<'S, 'Monad, 'U>) = apply (map tuple2 x) y : StateT<'S, 'Monad, ('T * 'U)> - let inline bind (f: 'T->StateT<'S,'``Monad<'U * 'S>``>) (StateT m: StateT<'S,'``Monad<'T * 'S>``>) = StateT <| fun s -> m s >>= (fun (a, s') -> run (f a) s') + let inline bind<'T, 'U, 'S, .. > (f: 'T -> StateT<'S, 'Monad, 'U>) (StateT m: StateT<'S, 'Monad, 'T>) : StateT<'S ,'Monad, 'U> = + StateT (fun s -> (m s: '``Monad<'T * 'S>``) >>= (fun (a, s') -> run (f a) s') : '``Monad<'U * 'S>``) -type StateT<'s,'``monad<'t * 's>``> with +type StateT<'s, 'monad, 't> with - static member inline Return (x: 'T) = StateT (fun s -> result (x, s)) : StateT<'S,'``Monad<'T * 'S>``> + static member inline Return (x: 'T) = + let _: '``Monad<'T * 'S>`` = + if opaqueId false then + result Unchecked.defaultof<'T * 'S> + else Unchecked.defaultof<_> + let _: '``Monad<'T * 'S>`` = + if opaqueId false then + map (fun (_: __) -> Unchecked.defaultof<'T * 'S>) Unchecked.defaultof<'Monad> + else Unchecked.defaultof<_> + Value (fun s -> box (result (x, s) : '``Monad<'T * 'S>``)) : StateT<'S, 'Monad, 'T> [] - static member inline Map (x: StateT<'S,'``Monad<'T * 'S>``>, f : 'T->'U) = StateT.map f x : StateT<'S,'``Monad<'U * 'S>``> + static member inline Map (x: StateT<'S, 'Monad, 'T>, f : 'T -> 'U) : StateT<'S, 'Monad, 'U> = StateT.map<_, _, _, 'Monad, '``Monad<'T * 'S>``, '``Monad<'U * 'S>``> f x /// Lifts a function into a StateT. Same as map. /// To be used in Applicative Style expressions, combined with <*> /// /// Functor - static member inline () (f: 'T -> 'U, x: StateT<'S, '``Monad<'T * 'S>``>) : StateT<'S, '``Monad<'U * 'S>``> = StateT.map f x - + static member inline () (f: 'T -> 'U, x: StateT<'S, 'Monad, 'T>) : StateT<'S, 'Monad, 'U> = StateT.map<_, _, _, 'Monad, '``Monad<'T * 'S>``, '``Monad<'U * 'S>``> f x + [] - static member inline Lift2 (f: 'T->'U->'V, x: StateT<'S,'``Monad<'T * 'S>``>, y: StateT<'S,'``Monad<'U * 'S>``>) : StateT<'S,'``Monad<'V * 'S>``> = StateT.map2 f x y - + static member inline Lift2 (f: 'T -> 'U -> 'V, x: StateT<'S, 'Monad, 'T>, y: StateT<'S, 'Monad, 'U>) : StateT<'S, 'Monad, 'V> = + StateT.map2<'T, 'U, 'V, 'S, 'Monad, '``Monad<'T * 'S>``, '``Monad<'U * 'S>``, '``Monad<'V * 'S>``> f x y + [] - static member inline Lift3 (f: 'T->'U->'V->'W, x: StateT<'S,'``Monad<'T * 'S>``>, y: StateT<'S,'``Monad<'U * 'S>``>, z : StateT<'S,'``Monad<'V * 'S>``>) : StateT<'S,'``Monad<'W * 'S>``> = StateT.map3 f x y z - - static member inline (<*>) (f: StateT<'S,'``Monad<('T -> 'U) * 'S>``>, x: StateT<'S,'``Monad<'T * 'S>``>) = StateT.apply f x : StateT<'S,'``Monad<'U * 'S>``> + static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, x: StateT<'S, 'Monad, 'T>, y: StateT<'S, 'Monad, 'U>, z : StateT<'S, 'Monad, 'V>) : StateT<'S, 'Monad, 'W> = + StateT.map3<'T, 'U, 'V, 'W, 'S, 'Monad, '``Monad<'T * 'S>``, '``Monad<'U * 'S>``, '``Monad<'V * 'S>``, '``Monad<'W * 'S>``> f x y z + + static member inline (<*>) (f: StateT<'S, 'Monad, ('T -> 'U)>, x: StateT<'S, 'Monad, 'T>) = + StateT.apply<_, _, _, 'Monad, '``Monad<'(T -> 'U) * 'S>``, '``Monad<'U * 'S>``, '``Monad<'T * 'S>``> f x : StateT<'S, 'Monad, 'U> /// /// Sequences two States left-to-right, discarding the value of the first argument. /// /// Applicative - static member inline ( *>) (x: StateT<'S, '``Monad<'T * 'S>``>, y: StateT<'S, '``Monad<'U * 'S>``>) : StateT<'S, '``Monad<'U * 'S>``> = ((fun (_: 'T) (k: 'U) -> k) x : StateT<'S, '``Monad<('U->'U) * 'S>``>) y - + static member inline ( *>) (x: StateT<'S, 'Monad, 'T>, y: StateT<'S, 'Monad, 'U>) : StateT<'S, 'Monad, 'U> = + let () = StateT.map<_, _, _, 'Monad, '``Monad<'T * 'S>``, '``Monad<('U -> 'U) * 'S>``> + let (<*>) = StateT.apply<_, _, _, 'Monad, '``Monad<'(U -> 'U) * 'S>``, '``Monad<'U * 'S>``, '``Monad<'U * 'S>``> + ((fun (_: 'T) (k: 'U) -> k) x: StateT<'S, 'Monad, ('U -> 'U)>) <*> y + /// /// Sequences two States left-to-right, discarding the value of the second argument. /// /// Applicative - static member inline (<* ) (x: StateT<'S, '``Monad<'U * 'S>``>, y: StateT<'S, '``Monad<'T * 'S>``>) : StateT<'S, '``Monad<'U * 'S>``> = ((fun (k: 'U) (_: 'T) -> k ) x : StateT<'S, '``Monad<('T->'U) * 'S>``>) y - - static member inline (>>=) (x: StateT<'S,'``Monad<'T * 'S>``>, f: 'T->StateT<'S,'``Monad<'U * 'S>``>) = StateT.bind f x + static member inline (<* ) (x: StateT<'S, 'Monad, 'U>, y: StateT<'S, 'Monad, 'T>) : StateT<'S, 'Monad, 'U> = + let () = StateT.map<_, _, _, 'Monad, '``Monad<'U * 'S>``, '``Monad<('T -> 'U) * 'S>``> + let (<*>) = StateT.apply<_, _, _, 'Monad, '``Monad<'(T -> 'U) * 'S>``, '``Monad<'U * 'S>``, '``Monad<'T * 'S>``> + ((fun (k: 'U) (_: 'T) -> k) x: StateT<'S, 'Monad, ('T -> 'U)>) <*> y + + static member inline (>>=) (x: StateT<'S, 'Monad, 'T>, f: 'T -> StateT<'S, 'Monad, 'U>) : StateT<'S, 'Monad, 'U> = + StateT.bind<_, _, _, 'Monad, '``Monad<'T>``, '``Monad<'U>``> f x - static member inline get_Empty () = StateT (fun _ -> getEmpty ()) : StateT<'S,'``MonadPlus<'T * 'S>``> - static member inline (<|>) (StateT m, StateT n) = StateT (fun s -> m s <|> n s) : StateT<'S,'``MonadPlus<'T * 'S>``> + static member inline get_Empty () = + StateTOperations.StateT (fun _ -> getEmpty () : '``MonadPlus<'T * 'S>``) : StateT<'S, 'MonadPlus, 'T> + static member inline (<|>) (StateT (m: 'S -> '``MonadPlus<'T * 'S>``) : StateT<'S, 'MonadPlus, 'T>, StateT (n: 'S -> '``MonadPlus<'T * 'S>``) : StateT<'S, 'MonadPlus, 'T>) : StateT<'S, 'MonadPlus, 'T> = + StateTOperations.StateT (fun s -> m s <|> n s) + [] - static member inline Zip (x: StateT<'S,'``Monad<'T * 'S>``>, y: StateT<'S,'``Monad<'U * 'S>``>) = StateT.zip x y + static member inline Zip (x: StateT<'S, 'Monad, 'T>, y: StateT<'S, 'Monad, 'U>) = StateT.zip x y + + static member inline TryWith (source: StateT<'S, 'Monad, 'T>, f: exn -> StateT<'S, 'Monad, 'T>) = + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWith.InvokeForStrict (fun () -> (StateT.run source s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) - static member inline TryWith (source: StateT<'S,'``Monad<'T * 'S>``>, f: exn -> StateT<'S,'``Monad<'T * 'S>``>) = StateT (fun s -> TryWith.InvokeForStrict (fun () -> StateT.run source s) (fun x -> StateT.run (f x) s)) - static member inline TryFinally (computation: StateT<'S,'``Monad<'T * 'S>``>, f) = StateT (fun s -> TryFinally.InvokeForStrict (fun () -> StateT.run computation s) f) - static member inline Using (resource, f: _ -> StateT<'S,'``Monad<'T * 'S>``>) = StateT (fun s -> Using.Invoke resource (fun x -> StateT.run (f x) s)) - static member inline Delay (body : unit -> StateT<'S,'``Monad<'T * 'S>``>) = StateT (fun s -> Delay.Invoke (fun _ -> StateT.run (body ()) s)) : StateT<'S,'``Monad<'T * 'S>``> + static member inline TryFinally (computation: StateT<'S,'Monad,'T>, f) = + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinally.InvokeForStrict (fun () -> StateT.run computation s) f) - [] - static member inline Lift (m: '``Monad<'T>``) : StateT<'S,'``Monad<'T * 'S>``> = StateT.lift m + static member inline Using (resource: 'S, f: _ -> StateT<'S,'Monad,'T>) = + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> Using.Invoke resource (fun x -> StateT.run (f x) s)) + + static member inline Delay (body: unit -> StateT<'S, 'Monad, 'T>) = + Value ((fun s -> Delay.Invoke (fun _ -> (StateT.run (body ()) s: '``Monad<'T * 'S>``) )) >> box<'``Monad<'T * 'S>``>) : StateT<'S, 'Monad, 'T> - static member inline LiftAsync (x :Async<'T>) = StateT.lift (liftAsync x) : StateT<'S,'``MonadAsync<'T>``> - static member inline get_Get () = StateT (fun s -> result (s , s)) : StateT<'S, '``Monad<'S * 'S>``> - static member inline Put (x: 'S) = StateT (fun _ -> result ((), x)) : StateT<'S, '``Monad``> + [] + static member inline Lift (m: '``Monad<'T>``) : StateT<'S, 'Monad, 'T> = StateT.lift<_, _, _, '``Monad<'T * 'S>``, _> m + + static member inline LiftAsync (x: Async<'T>) = + StateT.lift<_, _, _, '``MonadAsync<'T * 'S>``, _> (liftAsync x: '``MonadAsync<'T>``) : StateT<'S, 'MonadAsync, 'T> + + static member inline get_Get () = + StateTOperations.StateT (fun s -> result (s , s) : '``Monad<'S * 'S>``) : StateT<'S, 'Monad, 'S> + + static member inline Put (x: 'S) = + StateTOperations.StateT (fun _ -> (result ((), x) : '``Monad``)) : StateT<'S, 'Monad, unit> + + static member inline Throw (x: 'E) : StateT<'S, '``MonadError<'E>``, 'T> = + x |> (throw: 'E -> '``MonadError<'E, 'T>``) |> StateT.lift - static member inline Throw (x: 'E) = x |> throw |> StateT.lift - static member inline Catch (m: StateT<'S,'``MonadError<'E1,'T * 'S>``>, h: 'E1 -> _) = - StateT (fun s -> catch (StateT.run m s) (fun e -> StateT.run (h e) s)) : StateT<'S,'``MonadError<'E2, 'T * 'S>``> + static member inline Catch (m: StateT<'S, '``MonadError<'E1>`` ,'T>, h: 'E1 -> StateT<'S, '``MonadError<'E2>``, 'T>) = + StateTOperations.StateT (fun s -> catch (StateT.run m s: '``MonadError<'E1, ('T * 'S)>``) (fun e -> StateT.run (h e) s: '``MonadError<'E2, ('T * 'S)>``)) : StateT<'S, '``MonadError<'E2>``, 'T> - static member inline get_Ask () = StateT.lift ask : StateT<'S, '``MonadReader<'R, 'R>``> - static member inline Local (StateT m, f: 'R1 -> 'R2) = StateT (local f << m) : StateT<'S, '``MonadReader<'R1, 'T>``> + static member inline get_Ask () : StateT<'S, '``MonadReader<'R>``, 'R> = StateT.lift<'R, 'S, '``MonadReader<'R, 'R>``, '``MonadReader<'R, ('R * 'S)>``, '``MonadReader<'R>``> ask + static member inline Local (StateT (m: 'S -> '``MonadReader<'R2, ('T * 'S)>``) : StateT<'S, '``MonadReader<'`R2>``, 'T>, f: 'R1 -> 'R2) : StateT<'S, '``MonadReader<'R1>``, 'T> = StateTOperations.StateT (local f << m: 'S -> '``MonadReader<'R1, ('T * 'S)>``) #endif diff --git a/src/FSharpPlus/Data/Writer.fs b/src/FSharpPlus/Data/Writer.fs index b78d752df..c52ecd4ae 100644 --- a/src/FSharpPlus/Data/Writer.fs +++ b/src/FSharpPlus/Data/Writer.fs @@ -1,5 +1,8 @@ namespace FSharpPlus.Data +#nowarn "0193" +#nowarn "0193" + open System.ComponentModel open FSharpPlus open FSharpPlus.Internals.Prelude @@ -104,99 +107,159 @@ type Writer<'monoid,'t> with /// Monad Transformer for Writer<'Monoid, 'T> [] -type WriterT<'``monad<'t * 'monoid>``> = WriterT of '``monad<'t * 'monoid>`` +type WriterT<'monoid, 'monad, 't> = + /// Rerepsenmted as 'monad<'t * 'monoid> + Value of obj + +type []WriterTOperations = + [] + static member inline WriterT< ^``monad<'t * 'monoid>``, ^monad, 'monoid, 't when (Map or ^``monad<'t * 'monoid>`` or ^monad) : (static member Map: ( ^``monad<'t * 'monoid>`` * ('t * 'monoid -> __)) * Map -> ^monad) + and (Map or ^monad or ^``monad<'t * 'monoid>``) : (static member Map: ( ^monad * (__ -> 't * 'monoid)) * Map -> ^``monad<'t * 'monoid>``) + > (f: '``monad<'t * 'monoid>``) : WriterT<'monoid,'monad,'t> = + if opaqueId false then + let _: 'monad = Unchecked.defaultof<'``monad<'t * 'monoid>``> |> map (fun (_: 't * 'monoid) -> Unchecked.defaultof<__>) + let _: '``monad<'t * 'monoid>`` = Unchecked.defaultof<'monad> |> map (fun (_: __) -> Unchecked.defaultof<'t * 'monoid>) + () + Value (f |> box) + +module []WriterTOperations = + let inline writerT (x: '``monad<'t * 'monoid>``) : WriterT<'monoid, 'monad, 't> = WriterT x + let inline (|WriterT|) (Value x: WriterT<'Monoid, 'Monad, 'T>) = + if opaqueId false then + let _: '``Monad<'T * 'Monoid>`` = map (fun (_: __) -> Unchecked.defaultof<'T * 'Monoid>) Unchecked.defaultof<'Monad> + () + x |> unbox : '``Monad<'T * 'Monoid>`` /// Basic operations on WriterT [] module WriterT = - let run (WriterT x) = x : '``Monad<'T * 'Monoid>`` + let inline run (WriterT (x : '``Monad<'T * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'T>) = x /// Embed a Monad<'T> into a WriterT<'Monad<'T * 'Monoid>> - let inline lift (m: '``Monad<'T>``) : WriterT<'``Monad<'T * 'Monoid>``> = - if opaqueId false then m |> liftM (fun a -> (a, getZero ())) |> WriterT - else m |> map (fun a -> (a, getZero ())) |> WriterT + let inline lift<'T, .. > (m: '``Monad<'T>``) : WriterT<'Monoid, 'Monad, 'T> = + WriterT <| (m |> (if opaqueId false then liftM else map) (fun a -> (a, getZero () : 'T * 'Monoid)) : '``Monad<'T * 'Monoid>``) - let inline map (f: 'T->'U) (WriterT m:WriterT<'``Monad<'T * 'Monoid>``>) = + let inline map<'T, 'U, .. > (f: 'T -> 'U) (WriterT (m: '``Monad<'T * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'U> = let mapWriter f (a, m) = (f a, m) - WriterT (map (mapWriter f) m) : WriterT<'``Monad<'U * 'Monoid>``> + WriterT (map (mapWriter f: _ -> 'U * 'Monoid) m: '``Monad<'U * 'Monoid>``) /// Combines two WriterTs into one by applying a mapping function. - let inline map2 (f: 'T->'U->'V) (WriterT x: WriterT<'``Monad<'T * 'Monoid>``>) (WriterT y: WriterT<'``Monad<'U * 'Monoid>``>) : WriterT<'``Monad<'V * 'Monoid>``> = WriterT (lift2 (fun (x, a) (y, b) -> f x y, Plus.Invoke a b) x y) + let inline map2<'T, 'U, 'V, .. > (f: 'T -> 'U -> 'V) (WriterT (x: '``Monad<'T * 'Monoid>``): WriterT<'Monoid, 'Monad, 'T>) (WriterT (y: '``Monad<'U * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'U>) : WriterT<'Monoid, 'Monad, 'V> = + WriterT (lift2 (fun (x, a: 'Monoid) (y, b: 'Monoid) -> f x y, Plus.Invoke a b) x y : '``Monad<'V * 'Monoid>``) /// Combines three WriterTs into one by applying a mapping function. - let inline map3 (f: 'T->'U->'V->'W) (WriterT x: WriterT<'``Monad<'T * 'Monoid>``>) (WriterT y: WriterT<'``Monad<'U * 'Monoid>``>) (WriterT z: WriterT<'``Monad<'V * 'Monoid>``>) : WriterT<'``Monad<'W * 'Monoid>``> = WriterT (lift3 (fun (x, a) (y, b) (z, c) -> f x y z, a ++ b ++ c) x y z) + let inline map3<'T, 'U, 'V, 'W, .. > (f: 'T -> 'U -> 'V -> 'W) (WriterT (x: '``Monad<'T * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'T>) (WriterT (y: '``Monad<'U * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'U>) (WriterT (z: '``Monad<'V * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'V>) : WriterT<'Monoid, 'Monad, 'W> = + WriterT (lift3 (fun (x, a: 'Monoid) (y, b: 'Monoid) (z, c: 'Monoid) -> f x y z, a ++ b ++ c) x y z : '``Monad<'W * 'Monoid>``) - let inline apply (WriterT f : WriterT<'``Monad<('T -> 'U) * 'Monoid>``>) (WriterT x : WriterT<'``Monad<'T * 'Monoid>``>) = - let applyWriter (a, w) (b, w') = (a b, plus w w') - WriterT (result applyWriter <*> f <*> x) : WriterT<'``Monad<'U * 'Monoid>``> + let inline apply<'T, 'U, .. > (WriterT (f: '``Monad<('T -> 'U) * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'T -> 'U>) (WriterT x: WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'U> = + WriterT ((f >>= fun ((a: 'T -> 'U), w) -> (Map.Invoke (fun (b: 'T, w': 'Monoid) -> ((a b), plus w w')) (x: '``Monad<'T * 'Monoid>``))) : '``Monad<'U * 'Monoid>``) - let inline bind (f: 'T->WriterT<'``Monad<'U * 'Monoid>``>) (WriterT (m: '``Monad<'T * 'Monoid>``)) = - WriterT (m >>= (fun (a, w) -> run (f a) >>= (fun (b, w') -> result (b, plus w w')))) : WriterT<'``Monad<'U * 'Monoid>``> + let inline bind<'T, 'U, .. > (f: 'T -> WriterT<'Monoid, 'Monad, 'U>) (WriterT (m: '``Monad<'T * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'U> = + WriterT (m >>= (fun (a, w) -> (run (f a) : '``Monad<'U * 'Monoid>``) >>= (fun (b, w') -> (result ((b: 'U), (plus w w': 'Monoid)) : '``Monad<'U * 'Monoid>``) ))) -type WriterT<'``monad<'t * 'monoid>``> with +type WriterT<'monoid, 'monad, 't> with - static member inline Return (x: 'T) = WriterT (result (x, getZero ())) : WriterT<'``Monad<'T * 'Monoid>``> + static member inline Return (x: 'T) = + let _:'``Monad<'T * 'Monoid>`` = + if opaqueId false then + result Unchecked.defaultof<'T * 'Monoid> + else Unchecked.defaultof<_> + let _: '``Monad<'T * 'Monoid>`` = + if opaqueId false then + map (fun (_: __) -> Unchecked.defaultof<'T * 'Monoid>) Unchecked.defaultof<'Monad> + else Unchecked.defaultof<_> + Value (result (x, getZero ()) : '``Monad<'T * 'Monoid>``) : WriterT<'Monoid,'Monad,'T> - [] - static member inline Map (x: WriterT<'``Monad<'T * 'Monoid>``>, f: 'T -> 'U) = WriterT.map f x : WriterT<'``Monad<'U * 'Monoid>``> + // [] + static member inline Map (x: WriterT<'Monoid, 'Monad, 'T>, f: 'T -> 'U) = WriterT.map f x : WriterT<'Monoid, 'Monad, 'U> /// Lifts a function into a WriterT. Same as map. /// To be used in Applicative Style expressions, combined with <*> /// /// Functor - static member inline () (f: 'T -> 'U, x: WriterT<'``Monad<'T * 'Monoid>``>) : WriterT<'``Monad<'U * 'Monoid>``> = WriterT.map f x + static member inline () (f: 'T -> 'U, x: WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'U> = WriterT.map<_, _, _, 'Monad, '``Monad<'T * 'Monoid>``, '``Monad<'U * 'Monoid>``> f x - [] - static member inline Lift2 (f: 'T->'U->'V, x: WriterT<'``Monad<'T * 'Monoid>``>, y: WriterT<'``Monad<'U * 'Monoid>``>) : WriterT<'``Monad<'V * 'Monoid>``> = WriterT.map2 f x y + // [] + static member inline Lift2 (f: 'T -> 'U -> 'V, x: WriterT<'Monoid, 'Monad, 'T>, y: WriterT<'Monoid, 'Monad, 'U>) : WriterT<'Monoid, 'Monad, 'V> = + WriterT.map2<'T, 'U, 'V, 'Monoid, 'Monad, '``Monad<'T * 'Monoid>``, '``Monad<'U * 'Monoid>``, '``Monad<'V * 'Monoid>``> f x y - [] - static member inline Lift3 (f: 'T->'U->'V->'W, x: WriterT<'``Monad<'T * 'Monoid>``>, y: WriterT<'``Monad<'U * 'Monoid>``>, z: WriterT<'``Monad<'V * 'Monoid>``>) : WriterT<'``Monad<'W * 'Monoid>``> = WriterT.map3 f x y z + // [] + static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, x: WriterT<'Monoid, 'Monad, 'T>, y: WriterT<'Monoid, 'Monad, 'U>, z: WriterT<'Monoid, 'Monad, 'V>) : WriterT<'Monoid, 'Monad, 'W> = + WriterT.map3<'T, 'U, 'V, 'W, 'Monoid, 'Monad, '``Monad<'T * 'Monoid>``, '``Monad<'U * 'Monoid>``, '``Monad<'V * 'Monoid>``, '``Monad<'W * 'Monoid>``> f x y z - static member inline (<*>) (f: WriterT<'``Monad<('T -> 'U) * 'Monoid>``>, x: WriterT<'``Monad<'T * 'Monoid>``>) = WriterT.apply f x : WriterT<'``Monad<'U * 'Monoid>``> + static member inline (<*>) (f: WriterT<'Monoid, 'Monad, 'T -> 'U>, x: WriterT<'Monoid, 'Monad, 'T>) = + WriterT.apply<_, _, _, 'Monad, '``Monad<'(T -> 'U) * 'Monoid>``, '``Monad<'U * 'Monoid>``, '``Monad<'T * 'Monoid>``> f x : WriterT<'Monoid, 'Monad, 'U> /// /// Sequences two Writers left-to-right, discarding the value of the first argument. /// /// Applicative - static member inline ( *>) (x: WriterT<'``Monad<'T * 'Monoid>``>, y: WriterT<'``Monad<'U * 'Monoid>``>) : WriterT<'``Monad<'U * 'Monoid>``> = ((fun (_: 'T) (k: 'U) -> k) x : WriterT<'``Monad<('U -> 'U) * 'Monoid>``>) y - + static member inline ( *>) (x: WriterT<'Monoid, 'Monad, 'T>, y: WriterT<'Monoid, 'Monad, 'U>) : WriterT<'Monoid, 'Monad, 'U> = + let () = WriterT.map<_, _, _, 'Monad, '``Monad<'T * 'Monoid>``, '``Monad<('U -> 'U) * 'Monoid>``> + let (<*>) = WriterT.apply<_, _, _, 'Monad, '``Monad<'(U -> 'U) * 'Monoid>``, '``Monad<'U * 'Monoid>``, '``Monad<'U * 'Monoid>``> + ((fun (_: 'T) (k: 'U) -> k) x: WriterT<'Monoid, 'Monad, ('U -> 'U)>) <*> y + /// /// Sequences two Writers left-to-right, discarding the value of the second argument. /// /// Applicative - static member inline (<* ) (x: WriterT<'``Monad<'U * 'Monoid>``>, y: WriterT<'``Monad<'T * 'Monoid>``>) : WriterT<'``Monad<'U * 'Monoid>``> = ((fun (k: 'U) (_: 'T) -> k ) x : WriterT<'``Monad<('T -> 'U) * 'Monoid>``>) y + static member inline (<* ) (x: WriterT<'Monoid, 'Monad, 'U>, y: WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'U> = + let () = WriterT.map<_, _, _, 'Monad, '``Monad<'U * 'Monoid>``, '``Monad<('T -> 'U) * 'Monoid>``> + let (<*>) = WriterT.apply<_, _, _, 'Monad, '``Monad<'(T -> 'U) * 'Monoid>``, '``Monad<'U * 'Monoid>``, '``Monad<'T * 'Monoid>``> + ((fun (k: 'U) (_: 'T) -> k) x: WriterT<'Monoid, 'Monad, ('T -> 'U)>) <*> y - static member inline (>>=) (x: WriterT<'``Monad<'T * 'Monoid>``>, f: 'T -> _) = WriterT.bind f x : WriterT<'``Monad<'U * 'Monoid>``> + static member inline (>>=) (x: WriterT<'Monoid, 'Monad, 'T>, f: 'T -> _) : WriterT<'Monoid, 'Monad, 'U> = + WriterT.bind<'T, 'U, 'Monoid, ' Monad, '``Monad<'T * 'Monoid>``, '``Monad<'U * 'Monoid>``> f x + + static member inline get_Empty () : WriterT<'Monoid, 'MonadPlus, 'T> = + WriterTOperations.WriterT (getEmpty () : '``MonadPlus<'T * 'Monoid>``) - static member inline get_Empty () = WriterT (getEmpty ()) : WriterT<'``MonadPlus<'T * 'Monoid>``> - static member inline (<|>) (WriterT m, WriterT n) = WriterT (m <|> n) : WriterT<'``MonadPlus<'T * 'Monoid>``> + static member inline (<|>) (WriterT (m: '``MonadPlus<'T * 'S>``), WriterT (n: '``MonadPlus<'T * 'S>``)) : WriterT<'Monoid, 'MonadPlus, 'T> = + WriterTOperations.WriterT (m <|> n) - static member inline TryWith (source: WriterT<'``Monad<'T * 'Monoid>``>, f: exn -> WriterT<'``Monad<'T * 'Monoid>``>) = WriterT (TryWith.Invoke (WriterT.run source) (WriterT.run << f)) - static member inline TryFinally (computation: WriterT<'``Monad<'T * 'Monoid>``>, f) = WriterT (TryFinally.Invoke (WriterT.run computation) f) - static member inline Using (resource, f: _ -> WriterT<'``Monad<'T * 'Monoid>``>) = WriterT (Using.Invoke resource (WriterT.run << f)) - static member inline Delay (body : unit -> WriterT<'``Monad<'T * 'Monoid>``>) = WriterT (Delay.Invoke (fun _ -> WriterT.run (body ()))) : WriterT<'``Monad<'T * 'Monoid>``> + static member inline TryWith (source: WriterT<'Monoid, 'Monad, 'T>, f: exn -> WriterT<'Monoid, 'Monad, 'T>) = + WriterTOperations.WriterT< '``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryWith.Invoke (WriterT.run source) (WriterT.run << f)) - static member inline Tell (w: 'Monoid) = WriterT (result ((), w)) : WriterT<'``Monad``> - static member inline Listen (WriterT m: WriterT<'``Monad<'T * 'Monoid>``>) = WriterT (m >>= (fun (a, w) -> result ((a, w), w))) : WriterT<'``Monad<('T * 'Monoid) * 'Monoid>``> - static member inline Pass (WriterT m: WriterT<'``Monad<('T * ('Monoid -> 'Monoid)) * 'Monoid>``>) = WriterT (m >>= (fun ((a, f), w) -> result (a, f w))) : WriterT<'``Monad<'T * 'Monoid>``> + static member inline TryFinally (computation: WriterT<'Monoid, 'Monad, 'T>, f) = WriterTOperations.WriterT<'``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryFinally.Invoke (WriterT.run computation) f) + static member inline Using (resource, f: _ -> WriterT<'Monoid, 'Monad, 'T>) = WriterTOperations.WriterT<'``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (Using.Invoke resource (WriterT.run << f)) + static member inline Delay (body : unit -> WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'T> = + Value ((Delay.Invoke (fun _ -> WriterT.run (body ()) : '``Monad<'T * 'S>``)) |> box<'``Monad<'T * 'S>``>) + + + static member inline Tell (w: 'Monoid) : WriterT<'Monoid, 'Monad, unit> = + WriterTOperations.WriterT (result ((), w) : '``Monad``) + + static member inline Listen (WriterT (m: '``Monad<'T * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'T> ) : WriterT<'Monoid, 'Monad, 'T * 'Monoid> = + WriterTOperations.WriterT ((m >>= (fun ((a: 'T), w: 'Monoid) -> result ((a, w), w))) : '``Monad<('T * 'Monoid) * 'Monoid>``) + + static member inline Pass (WriterT (m: '``Monad<('T * ('Monoid' -> 'Monoid)) * 'Monoid>``) : WriterT<'Monoid, 'Monad, 'T * ('Monoid' -> 'Monoid)>) : WriterT<'Monoid, 'Monad, 'T> = + WriterTOperations.WriterT ((m >>= (fun ((a, f), w: 'Monoid) -> result ((a: 'T) , (f w: 'Monoid)))) : '``Monad<'T * 'Monoid>``) [] - static member inline Lift (m: '``Monad<'T>``) : WriterT<'``Monad<'T * 'Monoid>``> = WriterT.lift m + static member inline Lift (m: '``Monad<'T>``) : WriterT<'Monoid, 'Monad, 'T> = WriterT.lift<_, _, '``Monad<'T * 'Monoid>``, _, _> m - static member inline LiftAsync (x: Async<'T>) = WriterT.lift (liftAsync x) : WriterT<'``MonadAsync<'T>``> + static member inline LiftAsync (x: Async<'T>) : WriterT<'Monoid, 'MonadAsync, 'T> = WriterT.lift<_, _, '``MonadAsync<'T * 'Monoid>``, _, _> (liftAsync x: '``MonadAsync<'T>``) - static member inline Throw (x: 'E) = x |> throw |> WriterT.lift - static member inline Catch (m: WriterT<'``MonadError<'E1, 'T * 'Monoid>``>, h: 'E1 -> _) : WriterT<'``MonadError<'E2, 'T * 'Monoid>``> = - WriterT (catch (WriterT.run m) (WriterT.run << h)) + static member inline Throw (x: 'E) : WriterT<'Monoid, '``MonadError<'E>``, 'T> = + WriterT.lift<'T, '``MonadError<'E, 'T>``, '``MonadError<'E, 'T * ^Monoid>``, '``MonadError<'E>``, 'Monoid> (throw x : '``MonadError<'E, 'T>``) - static member inline CallCC (f: ('a->WriterT>)->_) : WriterT<'``MonadCont<'r,'a*'b>``> = - WriterT (callCC <| fun c -> WriterT.run (f (fun a -> WriterT <| c (a, getZero ())))) + static member inline Catch (m: WriterT<'Monoid, '``MonadError<'E1>``, 'T>, h: 'E1 -> WriterT<'Monoid, '``MonadError<'E2>``, 'T>) : WriterT<'Monoid, '``MonadError<'E2>``, 'T> = + WriterTOperations.WriterT (catch (WriterT.run m : '``MonadError<'E1, ('T * 'Monoid)>``) (WriterT.run << h) : '``MonadError<'E2, ('T * 'Monoid)>``) + + // 'Monad : MonadCont<'R, 'Monad> + static member inline CallCC (f: ('T -> WriterT<'Monoid, 'Monad, 'U>) -> WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'T> = + WriterTOperations.WriterT (callCC <| fun (c: ('T * 'Monoid) -> '``Monad<'U * 'Monoid>``) -> (WriterT.run (f (fun a -> WriterTOperations.WriterT <| c (a, (getZero () : 'Monoid)))) : '``Monad<'T * 'Monoid>``)) - static member inline get_Ask () = WriterT.lift ask : WriterT<'``MonadReader<'R,'R*'Monoid>``> - static member inline Local (WriterT m, f: 'R1->'R2) = WriterT (local f m) : WriterT<'``MonadReader<'R1,'T*'Monoid>``> + // 'Monad : MonadReader<'R, 'Monad> + static member inline get_Ask () : WriterT<'Monoid, '``MonadReader<'R>``, 'R> = WriterT.lift<_, '``MonadReader<'R, 'R>``, '``MonadReader<'R, ('R * 'Monoid)>``, '``MonadReader<'R>``, _> ask + static member inline Local (WriterT m : WriterT<'Monoid, '``MonadReader<'R2>``, 'T>, f: 'R1 -> 'R2) : WriterT<'Monoid, '``MonadReader<'R1>``, 'T> = + WriterTOperations.WriterT (local f (m: '``MonadReader<'R2, 'T * 'Monoid>``) : '``MonadReader<'R1, 'T * 'Monoid>``) + + static member inline get_Get () : WriterT<'Monoid, '``StateMonad<'S>``, 'S> = + WriterT.lift<_, '``StateMonad<'S, 'S>``, '``StateMonad<'S, 'S * 'Monoid>``, '``StateMonad<'S>``, _> get - static member inline get_Get () = WriterT.lift get : WriterT<'``MonadState<'S,'S*'Monoid>``> - static member inline Put (x: 'S) = x |> put |> WriterT.lift : WriterT<'``MonadState<'S,unit*'Monoid>``> + static member inline Put (x: 'S) : WriterT<'Monoid, '``StateMonad<'S>``, unit> = + x |> put |> WriterT.lift<_, '``StateMonad<'S, unit>``, '``StateMonad<'S, (unit * 'Monoid)>``, '``StateMonad<'S>``, _> #endif \ No newline at end of file diff --git a/src/FSharpPlus/Internals.fs b/src/FSharpPlus/Internals.fs index 971c38216..51f530b14 100644 --- a/src/FSharpPlus/Internals.fs +++ b/src/FSharpPlus/Internals.fs @@ -1,3 +1,10 @@ +namespace FSharpPlus + +/// Represents a type parameter that goes here but right now is not applied. +[] +type __ = class end + + namespace FSharpPlus.Internals /// From 2011924468b06fc1a6d524aa3bf0fbe3a9b53d3f Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Thu, 7 Jul 2022 09:07:17 +0200 Subject: [PATCH 13/33] Fix tests --- .../ComputationExpressions.fs | 38 +++++++++---------- tests/FSharpPlus.Tests/General.fs | 16 ++++---- .../FSharpTests/General.fs | 16 ++++---- 3 files changed, 35 insertions(+), 35 deletions(-) diff --git a/tests/FSharpPlus.Tests/ComputationExpressions.fs b/tests/FSharpPlus.Tests/ComputationExpressions.fs index 6d70eb99c..299e4e2a6 100644 --- a/tests/FSharpPlus.Tests/ComputationExpressions.fs +++ b/tests/FSharpPlus.Tests/ComputationExpressions.fs @@ -139,7 +139,7 @@ module ComputationExpressions = SideEffects.reset () - let threeElements: ReaderT> = monad.plus { + let threeElements: ReaderT, _> = monad.plus { let! s = ask for i in 1 .. 3 do SideEffects.add (sprintf "processing %i" i) @@ -440,7 +440,7 @@ module ComputationExpressions = // Monad transformers are delayed if at least one of the layers is lazy. SideEffects.reset () - let readerToptionM : ReaderT = monad { + let readerToptionM : ReaderT = monad { use enum = toDebugEnum (SideEffects.add "using"; testSeq.GetEnumerator ()) while (SideEffects.add "moving"; enum.MoveNext ()) do SideEffects.add (sprintf "--> %i" enum.Current) } @@ -451,7 +451,7 @@ module ComputationExpressions = SideEffects.reset () - let readerTfuncM: ReaderTunit> = monad { + let readerTfuncM: ReaderT __), unit> = monad { use enum = toDebugEnum (SideEffects.add "using"; testSeq.GetEnumerator ()) while (SideEffects.add "moving"; enum.MoveNext ()) do SideEffects.add (sprintf "--> %i" enum.Current) } @@ -464,7 +464,7 @@ module ComputationExpressions = SideEffects.reset () - let readerTtaskM: ReaderT> = monad { + let readerTtaskM: ReaderT, unit> = monad { use enum = toDebugEnum (SideEffects.add "using"; testSeq.GetEnumerator ()) while (SideEffects.add "moving"; enum.MoveNext ()) do SideEffects.add (sprintf "--> %i" enum.Current) } @@ -546,7 +546,7 @@ module ComputationExpressions = let _ = strictMonadTest () let monadTransformer3layersTest1 () = - let x: StateT>> = monad { + let x: StateT, __>, unit> = monad { try failwith "Exception in try-with not handled" () @@ -555,7 +555,7 @@ module ComputationExpressions = let _ = ((monadTransformer3layersTest1 () |> StateT.run) "" |> ReaderT.run) 0 |> Seq.toList let monadTransformer3layersTest2 () = - let x: StateT>> = monad { + let x: StateT, __>, unit> = monad { try failwith "Exception in try-with not handled" () @@ -564,7 +564,7 @@ module ComputationExpressions = let _ = ((monadTransformer3layersTest2 () |> StateT.run) "" |> ReaderT.run) 0 let monadTransformer3layersTest2' () = - let x: StateT>> = monad { + let x: StateT, __>, unit> = monad { try failwith "Exception in try-with not handled" () @@ -573,33 +573,33 @@ module ComputationExpressions = let _ = ((monadTransformer3layersTest2' () |> StateT.run) "" |> ReaderT.run) 0 let monadTransformer3layersTest3 () = - let x: WriterT>> = monad { + let x: WriterT, __>, unit> = monad { try failwith "Exception in try-with not handled" () with _ -> () } x - let _ = monadTransformer3layersTest3 () |> WriterT.run |> OptionT.run |> Seq.toList + let _ = monadTransformer3layersTest3 () |> WriterT.run |> ResultT.run |> Seq.toList // Same test but with list instead of seq, which makes the whole monad strict // If .strict is not used it fails compilation with a nice error asking us to add it let monadTransformer3layersTest4 () = - let x: WriterT>> = monad.strict { + let x: WriterT, __>, unit> = monad.strict { try failwith "Exception in try-with not handled" () with _ -> () } x - let _ = monadTransformer3layersTest4 () |> WriterT.run |> OptionT.run + let _ = monadTransformer3layersTest4 () |> WriterT.run |> ResultT.run let monadTransformer3layersTest5 () = - let x: WriterT>> = monad.strict { + let x: WriterT, __>, unit> = monad.strict { try failwith "Exception in try-with not handled" () with _ -> () } x - let _ = monadTransformer3layersTest5 () |> WriterT.run |> OptionT.run + let _ = monadTransformer3layersTest5 () |> WriterT.run |> ResultT.run // ContT doesn't deal with the inner monad, so we don't need to do anything. @@ -646,7 +646,7 @@ module ComputationExpressions = let monadTransformer3layersTest1 () = SideEffects.reset () - let x: StateT>> = monad { + let x: StateT, __>, unit> = monad { use disp = { new IDisposable with override __.Dispose() = SideEffects.add "Disposing" } try failwith "Exception in try-finally" @@ -659,7 +659,7 @@ module ComputationExpressions = let monadTransformer3layersTest2 () = SideEffects.reset () - let x: StateT>> = monad { + let x: StateT, __>, unit> = monad { use disp = { new IDisposable with override __.Dispose() = SideEffects.add "Disposing" } try failwith "Exception in try-finally" @@ -672,7 +672,7 @@ module ComputationExpressions = let monadTransformer3layersTest3 () = SideEffects.reset () - let x: WriterT>> = monad { + let x: WriterT, __>, unit> = monad { use disp = { new IDisposable with override __.Dispose() = SideEffects.add "Disposing" } try failwith "Exception in try-finally" @@ -680,14 +680,14 @@ module ComputationExpressions = finally SideEffects.add "Finally goes here" } x - let _ = try (monadTransformer3layersTest3 () |> WriterT.run |> OptionT.run |> Seq.toList) with _ -> Unchecked.defaultof<_> + let _ = try (monadTransformer3layersTest3 () |> WriterT.run |> ResultT.run |> Seq.toList) with _ -> Unchecked.defaultof<_> SideEffects.are ["Finally goes here"; "Disposing"] // Same test but with list instead of seq, which makes the whole monad strict // If .strict is not used it fails compilation with a nice error asking us to add it let monadTransformer3layersTest4 () = SideEffects.reset () - let x: WriterT>> = monad.strict { + let x: WriterT, __>, unit> = monad.strict { use disp = { new IDisposable with override __.Dispose() = SideEffects.add "Disposing" } try failwith "Exception in try-finally" @@ -695,7 +695,7 @@ module ComputationExpressions = finally SideEffects.add "Finally goes here" } x - let _ = try (monadTransformer3layersTest4 () |> WriterT.run |> OptionT.run) with _ -> Unchecked.defaultof<_> + let _ = try (monadTransformer3layersTest4 () |> WriterT.run |> ResultT.run) with _ -> Unchecked.defaultof<_> SideEffects.are ["Finally goes here"; "Disposing"] // ContT doesn't deal with the inner monad, so we don't need to do anything. diff --git a/tests/FSharpPlus.Tests/General.fs b/tests/FSharpPlus.Tests/General.fs index 0d33480c0..81e4a8f01 100644 --- a/tests/FSharpPlus.Tests/General.fs +++ b/tests/FSharpPlus.Tests/General.fs @@ -1781,7 +1781,7 @@ module MonadTransformers = if x < 10 then return Result.Ok 10 else return Result.Error "failure" } - let okFoo10Comp: ResultT<_> = + let okFoo10Comp: ResultT<_, _, _> = monad { let! resFoo = ResultT.hoist <| someResultFunction "foo" let! res10 = doSomeOperation 0 @@ -1804,7 +1804,7 @@ module MonadTransformers = if x < 10 then return Choice1Of2 10 else return Choice2Of2 "failure" } - let okFoo10Comp: ChoiceT<_> = + let okFoo10Comp: ChoiceT<_, _, _> = monad { let! resFoo = ChoiceT.hoist <| someErrorFunction "foo" let! res10 = doSomeOperation 0 @@ -1816,14 +1816,14 @@ module MonadTransformers = // test generic put (no unknown(1,1): error FS0073: internal error: Undefined or unsolved type variable: ^_?51242) let initialState = -1 let _ = put initialState : ListT> - let _ = put initialState : ChoiceT>> + let _ = put initialState : ChoiceT, _> () [] let testStateT () = - let lst1: StateT = StateT.lift [1;2] - let lst2: StateT = StateT.lift [4;5] + let lst1: StateT = StateT.lift [1;2] + let lst2: StateT = StateT.lift [4;5] let m = monad { let! x = lst1 @@ -1841,9 +1841,9 @@ module MonadTransformers = [] let testCompilationMT1 () = - let fn : ResultT>> = + let fn : ResultT, _> = monad { - let! x1 = lift ask + let! x1 = ask let! x2 = if x1 > 0 then result 1 else ResultT (result (Error NegativeValue)) @@ -1875,7 +1875,7 @@ module BifunctorDefaults = module Invariant = - type StringCodec<'t> = StringCodec of ReaderT> * ('t -> Const) with + type StringCodec<'t> = StringCodec of ReaderT, 't> * ('t -> Const) with static member Invmap (StringCodec (d, e), f: 'T -> 'U, g: 'U -> 'T) = StringCodec (map f d, contramap g e) module StringCodec = let decode (StringCodec (d,_)) x = ReaderT.run d x diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General.fs index cfe212478..6490ad4f2 100644 --- a/tests/FSharpPlusFable.Tests/FSharpTests/General.fs +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General.fs @@ -83,7 +83,7 @@ let monadTransformers = testList "MonadTransformers" [ if x < 10 then return Result.Ok 10 else return Result.Error "failure" } - let okFoo10Comp: ResultT<_> = + let okFoo10Comp: ResultT<_, _, _> = monad { let! resFoo = ResultT.hoist <| someResultFunction "foo" let! res10 = doSomeOperation 0 @@ -107,7 +107,7 @@ let monadTransformers = testList "MonadTransformers" [ if x < 10 then return Choice1Of2 10 else return Choice2Of2 "failure" } - let okFoo10Comp: ChoiceT<_> = + let okFoo10Comp: ChoiceT<_, _, _> = monad { let! resFoo = ChoiceT.hoist <| someErrorFunction "foo" let! res10 = doSomeOperation 0 @@ -119,13 +119,13 @@ let monadTransformers = testList "MonadTransformers" [ // test generic put (no unknown(1,1): error FS0073: internal error: Undefined or unsolved type variable: ^_?51242) let initialState = -1 let _ = put initialState : ListT> - let _ = put initialState : ChoiceT>> + let _ = put initialState : ChoiceT, unit> ()) #if !NETSTANDARD3_0 testCase "testStateT" (fun () -> - let lst1: StateT = StateT.lift [1;2] - let lst2: StateT = StateT.lift [4;5] + let lst1: StateT = StateT.lift [1;2] + let lst2: StateT = StateT.lift [4;5] let m = monad { let! x = lst1 @@ -141,9 +141,9 @@ let monadTransformers = testList "MonadTransformers" [ testCase "testCompilationMT1" (fun () -> - let fn : ResultT>> = + let fn : ResultT, _> = monad { - let! x1 = lift ask + let! x1 = ask let! x2 = if x1 > 0 then result 1 else ResultT (result (Error NegativeValue)) @@ -181,7 +181,7 @@ module BifunctorDefaults = #endif #if !FABLE_COMPILER || FABLE_COMPILER_3 -type StringCodec<'t> = StringCodec of ReaderT> * ('t -> Const) with +type StringCodec<'t> = StringCodec of ReaderT, 't> * ('t -> Const) with static member Invmap (StringCodec (d, e), f: 'T -> 'U, g: 'U -> 'T) = StringCodec (map f d, contramap g e) module StringCodec = let decode (StringCodec (d,_)) x = ReaderT.run d x From 11905eb57af2c89dc9aac712ff033c6e9b5c4052 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Fri, 8 Jul 2022 10:50:53 +0200 Subject: [PATCH 14/33] Fix try-finally --- src/FSharpPlus/Control/Monad.fs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index ef6ed6705..326805fab 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -262,11 +262,8 @@ type TryFinally with [] static member TryFinally ((_: unit -> '``Monad<'T>`` when '``Monad<'T>`` : not struct, _: unit -> unit), _: Default3, _: Default1, _defaults: False) = raise Internals.Errors.exnUnreachable - static member TryFinally ((computation: unit -> '``Monad<'T>`` when '``Monad<'T>`` : struct, compensation: unit -> unit), _: Default3, _: Default2, _defaults: True) = try computation () finally compensation () - static member TryFinally ((computation: unit -> '``Monad<'T>`` when '``Monad<'T>`` : not struct, compensation: unit -> unit), _: Default3, _: Default1, _defaults: True) = try computation () finally compensation () - - static member inline TryFinally ((computation: unit -> '``Monad<'T>`` , compensation: unit -> unit), _: Default1, _: TryFinally, _) = TryFinally.InvokeOnInstance (computation ()) compensation: '``Monad<'T>`` - static member inline TryFinally (( _ : unit -> ^t when ^t:null and ^t:struct , _ : unit -> unit), _: Default1, _ , _) = () + static member TryFinally ((computation: unit -> '``Monad<'T>``, compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: True ) = try computation () finally compensation () + static member inline TryFinally ((computation: unit -> '``Monad<'T>``, compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: False) = TryFinally.InvokeOnInstance (computation ()) compensation: '``Monad<'T>`` type Using = From b1d191c79d6bfc38967405ec6956d0a8fcbfee1e Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Fri, 8 Jul 2022 11:07:52 +0200 Subject: [PATCH 15/33] Re-introduce dummy overload --- src/FSharpPlus/Control/Monad.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index 326805fab..b2af121b9 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -264,7 +264,7 @@ type TryFinally with static member TryFinally ((computation: unit -> '``Monad<'T>``, compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: True ) = try computation () finally compensation () static member inline TryFinally ((computation: unit -> '``Monad<'T>``, compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: False) = TryFinally.InvokeOnInstance (computation ()) compensation: '``Monad<'T>`` - + static member inline TryFinally (( _ : unit -> ^t when ^t: null and ^t: struct, _: unit -> unit), _: Default1, _ , _ ) = () type Using = inherit Default1 From c3fb4fc9f3981f6c20ced155bfcca429e036d39e Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Fri, 8 Jul 2022 17:44:24 +0200 Subject: [PATCH 16/33] Split TryFinally --- src/FSharpPlus/Builders.fs | 2 +- src/FSharpPlus/Control/Monad.fs | 39 +++++++++++++++++++++++---------- src/FSharpPlus/Data/Reader.fs | 2 +- src/FSharpPlus/Data/State.fs | 2 +- 4 files changed, 31 insertions(+), 14 deletions(-) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 612135b83..066c86266 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -70,7 +70,7 @@ module GenericBuilders = member __.Delay expr = expr : unit -> '``Monad<'T>`` member __.Run f = f () : '``monad<'t>`` member inline __.TryWith (expr, handler) = TryWith.InvokeForStrict expr handler : '``Monad<'T>`` - member inline __.TryFinally (expr, compensation) = TryFinally.InvokeForStrict expr compensation : '``Monad<'T>`` + member inline __.TryFinally (expr, compensation) = TryFinallyS.Invoke expr compensation : '``Monad<'T>`` member inline __.Using (disposable: #IDisposable, body) = Using.Invoke disposable body diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index b2af121b9..c7d6fd2ca 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -239,22 +239,36 @@ type TryFinally = static member TryFinally ((computation: unit -> Id<_> , compensation: unit -> unit), _: TryFinally, _, _) = try computation () finally compensation () static member TryFinally ((computation: unit -> Async<_>, compensation: unit -> unit), _: TryFinally, _, _) = async.TryFinally (computation (), compensation) : Async<_> - #if !FABLE_COMPILER - static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinally, _, True) = Task.tryFinally computation compensation : Task<_> - #endif static member TryFinally ((computation: unit -> Lazy<_> , compensation: unit -> unit), _: TryFinally, _, _) = lazy (try (computation ()).Force () finally compensation ()) : Lazy<_> static member inline Invoke (source: '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = let inline call (mthd: 'M, input: unit ->'I, _output: 'I, h: unit -> unit) = ((^M or ^I) : (static member TryFinally : (_*_)*_*_*_ -> _) (input, h), mthd, Unchecked.defaultof, False) call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) - static member inline InvokeForStrict (source: unit ->'``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit ->'I, _output: 'I, h: unit -> unit) = ((^M or ^I) : (static member TryFinally : (_*_)*_*_*_ -> _) (input, h), mthd, Unchecked.defaultof, True) - call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) - - static member inline InvokeOnInstance (source: '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = (^``Monad<'T>`` : (static member TryFinally : _*_->_) source, f) : '``Monad<'T>`` + static member inline InvokeOnInstance (source: '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = printfn "Try Finally default 8 for %A" typeof< ^``Monad<'T>``>; (^``Monad<'T>`` : (static member TryFinally : _*_->_) source, f) : '``Monad<'T>`` type TryFinally with + static member inline TryFinally ((computation: unit -> '``Monad<'T>`` , compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: False) = TryFinally.InvokeOnInstance (computation ()) compensation: '``Monad<'T>`` + static member inline TryFinally (( _ : unit -> ^t when ^t:null and ^t:struct , _ : unit -> unit), _: Default1, _: TryFinally , _) = () + +type TryFinallyS = + inherit Default1 + + [] + static member TryFinally ((_: unit -> 'R -> _ , _: unit -> unit), _: Default2 , _, _defaults: False) = raise Internals.Errors.exnUnreachable + + static member TryFinally ((computation: unit -> Id<_> , compensation: unit -> unit), _: TryFinallyS, _, _) = try computation () finally compensation () + #if !FABLE_COMPILER + static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinallyS, _, True) = Task.tryFinally computation compensation : Task<_> + #endif + + static member inline Invoke (source: unit ->'``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = + let inline call (mthd: 'M, input: unit ->'I, _output: 'I, h: unit -> unit) = ((^M or ^I) : (static member TryFinally : (_*_)*_*_*_ -> _) (input, h), mthd, Unchecked.defaultof, True) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) + + static member inline InvokeOnInstance (source: unit -> '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = (^``Monad<'T>`` : (static member TryFinally : _*_->_) source, f) : '``Monad<'T>`` + +type TryFinallyS with [] static member TryFinally ((_: unit -> '``Monad<'T>`` when '``Monad<'T>`` : struct, _: unit -> unit), _: Default3, _: Default2, _defaults: False) = raise Internals.Errors.exnUnreachable @@ -262,9 +276,12 @@ type TryFinally with [] static member TryFinally ((_: unit -> '``Monad<'T>`` when '``Monad<'T>`` : not struct, _: unit -> unit), _: Default3, _: Default1, _defaults: False) = raise Internals.Errors.exnUnreachable - static member TryFinally ((computation: unit -> '``Monad<'T>``, compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: True ) = try computation () finally compensation () - static member inline TryFinally ((computation: unit -> '``Monad<'T>``, compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: False) = TryFinally.InvokeOnInstance (computation ()) compensation: '``Monad<'T>`` - static member inline TryFinally (( _ : unit -> ^t when ^t: null and ^t: struct, _: unit -> unit), _: Default1, _ , _ ) = () + static member TryFinally ((computation: unit -> '``Monad<'T>`` when '``Monad<'T>`` : struct, compensation: unit -> unit), _: Default3, _: Default2, _defaults: True) = try computation () finally compensation () + static member TryFinally ((computation: unit -> '``Monad<'T>`` when '``Monad<'T>`` : not struct, compensation: unit -> unit), _: Default3, _: Default1, _defaults: True) = try computation () finally compensation () + + static member inline TryFinally ((computation: unit -> '``Monad<'T>`` , compensation: unit -> unit), _: Default1, _: TryFinallyS, _defaults: _) = TryFinallyS.InvokeOnInstance computation compensation: '``Monad<'T>`` + static member inline TryFinally (( _: unit -> ^t when ^t : null and ^t : struct , _ : unit -> unit), _: Default1, _ , _ ) = () + type Using = inherit Default1 diff --git a/src/FSharpPlus/Data/Reader.fs b/src/FSharpPlus/Data/Reader.fs index 499fe210a..349d87bbb 100644 --- a/src/FSharpPlus/Data/Reader.fs +++ b/src/FSharpPlus/Data/Reader.fs @@ -223,7 +223,7 @@ type ReaderT<'r, 'monad, 't> with ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWith.InvokeForStrict (fun () -> (ReaderT.run source s : '``Monad<'T>``)) (fun x -> ReaderT.run (f x) s)) static member inline TryFinally (computation: ReaderT<'R, 'Monad, 'T>, f) = - ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinally.InvokeForStrict (fun () -> ReaderT.run computation s) f) + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinallyS.Invoke (fun () -> ReaderT.run computation s) f) static member inline Using (resource, f: _ -> ReaderT<'R, 'Monad, 'T>) = ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> Using.Invoke resource (fun x -> ReaderT.run (f x) s)) diff --git a/src/FSharpPlus/Data/State.fs b/src/FSharpPlus/Data/State.fs index 9872cf790..c23d4c30d 100644 --- a/src/FSharpPlus/Data/State.fs +++ b/src/FSharpPlus/Data/State.fs @@ -237,7 +237,7 @@ type StateT<'s, 'monad, 't> with StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWith.InvokeForStrict (fun () -> (StateT.run source s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) static member inline TryFinally (computation: StateT<'S,'Monad,'T>, f) = - StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinally.InvokeForStrict (fun () -> StateT.run computation s) f) + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinallyS.Invoke (fun () -> StateT.run computation s) f) static member inline Using (resource: 'S, f: _ -> StateT<'S,'Monad,'T>) = StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> Using.Invoke resource (fun x -> StateT.run (f x) s)) From 95cfbe4dd5d946cb0e421b821acdd0d267602547 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Fri, 8 Jul 2022 20:39:09 +0200 Subject: [PATCH 17/33] Split TryWith --- src/FSharpPlus/Builders.fs | 2 +- src/FSharpPlus/Control/Monad.fs | 35 +++++++++++++++++++++++++++++---- src/FSharpPlus/Data/Reader.fs | 2 +- src/FSharpPlus/Data/State.fs | 2 +- 4 files changed, 34 insertions(+), 7 deletions(-) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 066c86266..ccd1f9c92 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -69,7 +69,7 @@ module GenericBuilders = inherit Builder<'``monad<'t>``> () member __.Delay expr = expr : unit -> '``Monad<'T>`` member __.Run f = f () : '``monad<'t>`` - member inline __.TryWith (expr, handler) = TryWith.InvokeForStrict expr handler : '``Monad<'T>`` + member inline __.TryWith (expr, handler) = TryWithS.Invoke expr handler : '``Monad<'T>`` member inline __.TryFinally (expr, compensation) = TryFinallyS.Invoke expr compensation : '``Monad<'T>`` member inline __.Using (disposable: #IDisposable, body) = Using.Invoke disposable body diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index c7d6fd2ca..6ba6a8f4c 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -206,7 +206,7 @@ type TryWith = static member inline TryWith (_: unit -> ^t when ^t: null and ^t: struct, _ : exn -> 't , _: Default1, _) = () static member TryWith (computation: unit -> seq<_> , catchHandler: exn -> seq<_> , _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) - static member TryWith (computation: unit -> NonEmptySeq<_>, catchHandler: exn -> NonEmptySeq<_>, _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) |> NonEmptySeq.unsafeOfSeq + static member TryWith (computation: unit -> FSharpPlus.Data.NonEmptySeq<_>, catchHandler: exn -> FSharpPlus.Data.NonEmptySeq<_>, _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) |> FSharpPlus.Data.NonEmptySeq.unsafeOfSeq static member TryWith (computation: unit -> 'R -> _ , catchHandler: exn -> 'R -> _ , _: Default2, _) = (fun s -> try (computation ()) s with e -> catchHandler e s) : 'R ->_ static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWith , _) = async.TryWith ((computation ()), catchHandler) #if !FABLE_COMPILER @@ -218,13 +218,40 @@ type TryWith = let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, False) call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) - static member inline InvokeForStrict (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = + static member inline InvokeForWhile (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = + let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, While) + call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) + + +type TryWithS = + inherit Default1 + + [] + static member TryWith (_: unit -> '``Monad<'T>``, _: exn -> '``Monad<'T>``, _: Default3, _defaults: While) = raise Internals.Errors.exnUnreachable + + [] + static member TryWith (_: unit -> '``Monad<'T>``, _: exn -> '``Monad<'T>``, _: Default3, _defaults: False) = raise Internals.Errors.exnUnreachable + static member TryWith (computation: unit -> '``Monad<'T>``, catchHandler: exn -> '``Monad<'T>``, _: Default3, _defaults: True ) = try computation () with e -> catchHandler e + + static member inline TryWith (computation: unit -> '``Monad<'T>``, catchHandler: exn -> '``Monad<'T>``, _: Default1, _) = (^``Monad<'T>`` : (static member TryWith : _*_->_) computation, catchHandler) : '``Monad<'T>`` + static member inline TryWith (_: unit -> ^t when ^t: null and ^t: struct, _ : exn -> 't , _: Default1, _) = () + + static member TryWith (computation: unit -> seq<_> , catchHandler: exn -> seq<_> , _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) + static member TryWith (computation: unit -> FSharpPlus.Data.NonEmptySeq<_>, catchHandler: exn -> FSharpPlus.Data.NonEmptySeq<_>, _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) |> FSharpPlus.Data.NonEmptySeq.unsafeOfSeq + static member TryWith (computation: unit -> 'R -> _ , catchHandler: exn -> 'R -> _ , _: Default2, _) = (fun s -> try (computation ()) s with e -> catchHandler e s) : 'R ->_ + static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWithS, _) = async.TryWith ((computation ()), catchHandler) + #if !FABLE_COMPILER + static member TryWith (computation: unit -> Task<_> , catchHandler: exn -> Task<_> , _: TryWithS, True) = Task.tryWith computation catchHandler + #endif + static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWithS, _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_> + + static member inline Invoke (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, True) - call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) static member inline InvokeForWhile (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, While) - call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) + call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) type TryFinally = diff --git a/src/FSharpPlus/Data/Reader.fs b/src/FSharpPlus/Data/Reader.fs index 349d87bbb..5225ad717 100644 --- a/src/FSharpPlus/Data/Reader.fs +++ b/src/FSharpPlus/Data/Reader.fs @@ -220,7 +220,7 @@ type ReaderT<'r, 'monad, 't> with static member inline Zip (x: ReaderT<'S, 'Monad, 'T>, y: ReaderT<'S, 'Monad, 'U>) = ReaderT.zip x y static member inline TryWith (source: ReaderT<'R, 'Monad, 'T>, f: exn -> ReaderT<'R, 'Monad, 'T>) = - ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWith.InvokeForStrict (fun () -> (ReaderT.run source s : '``Monad<'T>``)) (fun x -> ReaderT.run (f x) s)) + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWithS.Invoke (fun () -> (ReaderT.run source s : '``Monad<'T>``)) (fun x -> ReaderT.run (f x) s)) static member inline TryFinally (computation: ReaderT<'R, 'Monad, 'T>, f) = ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinallyS.Invoke (fun () -> ReaderT.run computation s) f) diff --git a/src/FSharpPlus/Data/State.fs b/src/FSharpPlus/Data/State.fs index c23d4c30d..27c2654ff 100644 --- a/src/FSharpPlus/Data/State.fs +++ b/src/FSharpPlus/Data/State.fs @@ -234,7 +234,7 @@ type StateT<'s, 'monad, 't> with static member inline Zip (x: StateT<'S, 'Monad, 'T>, y: StateT<'S, 'Monad, 'U>) = StateT.zip x y static member inline TryWith (source: StateT<'S, 'Monad, 'T>, f: exn -> StateT<'S, 'Monad, 'T>) = - StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWith.InvokeForStrict (fun () -> (StateT.run source s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWithS.Invoke (fun () -> (StateT.run source s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) static member inline TryFinally (computation: StateT<'S,'Monad,'T>, f) = StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinallyS.Invoke (fun () -> StateT.run computation s) f) From 27331568b0996ff236154bfdd3d2c3334b0ef893 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 9 Jul 2022 08:43:16 +0200 Subject: [PATCH 18/33] split more --- src/FSharpPlus/Control/Monad.fs | 8 ++++++-- src/FSharpPlus/Data/Reader.fs | 2 +- src/FSharpPlus/Data/State.fs | 2 +- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index 6ba6a8f4c..7c18ec954 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -206,7 +206,7 @@ type TryWith = static member inline TryWith (_: unit -> ^t when ^t: null and ^t: struct, _ : exn -> 't , _: Default1, _) = () static member TryWith (computation: unit -> seq<_> , catchHandler: exn -> seq<_> , _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) - static member TryWith (computation: unit -> FSharpPlus.Data.NonEmptySeq<_>, catchHandler: exn -> FSharpPlus.Data.NonEmptySeq<_>, _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) |> FSharpPlus.Data.NonEmptySeq.unsafeOfSeq + static member TryWith (computation: unit -> NonEmptySeq<_>, catchHandler: exn -> NonEmptySeq<_>, _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) |> NonEmptySeq.unsafeOfSeq static member TryWith (computation: unit -> 'R -> _ , catchHandler: exn -> 'R -> _ , _: Default2, _) = (fun s -> try (computation ()) s with e -> catchHandler e s) : 'R ->_ static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWith , _) = async.TryWith ((computation ()), catchHandler) #if !FABLE_COMPILER @@ -218,6 +218,10 @@ type TryWith = let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, False) call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) + static member inline InvokeFromOtherMonad (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = + let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, True) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) + static member inline InvokeForWhile (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, While) call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) @@ -237,7 +241,7 @@ type TryWithS = static member inline TryWith (_: unit -> ^t when ^t: null and ^t: struct, _ : exn -> 't , _: Default1, _) = () static member TryWith (computation: unit -> seq<_> , catchHandler: exn -> seq<_> , _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) - static member TryWith (computation: unit -> FSharpPlus.Data.NonEmptySeq<_>, catchHandler: exn -> FSharpPlus.Data.NonEmptySeq<_>, _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) |> FSharpPlus.Data.NonEmptySeq.unsafeOfSeq + static member TryWith (computation: unit -> NonEmptySeq<_>, catchHandler: exn -> NonEmptySeq<_>, _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) |> NonEmptySeq.unsafeOfSeq static member TryWith (computation: unit -> 'R -> _ , catchHandler: exn -> 'R -> _ , _: Default2, _) = (fun s -> try (computation ()) s with e -> catchHandler e s) : 'R ->_ static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWithS, _) = async.TryWith ((computation ()), catchHandler) #if !FABLE_COMPILER diff --git a/src/FSharpPlus/Data/Reader.fs b/src/FSharpPlus/Data/Reader.fs index 5225ad717..b11d16cd4 100644 --- a/src/FSharpPlus/Data/Reader.fs +++ b/src/FSharpPlus/Data/Reader.fs @@ -220,7 +220,7 @@ type ReaderT<'r, 'monad, 't> with static member inline Zip (x: ReaderT<'S, 'Monad, 'T>, y: ReaderT<'S, 'Monad, 'U>) = ReaderT.zip x y static member inline TryWith (source: ReaderT<'R, 'Monad, 'T>, f: exn -> ReaderT<'R, 'Monad, 'T>) = - ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWithS.Invoke (fun () -> (ReaderT.run source s : '``Monad<'T>``)) (fun x -> ReaderT.run (f x) s)) + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWith.InvokeFromOtherMonad (fun () -> (ReaderT.run source s : '``Monad<'T>``)) (fun x -> ReaderT.run (f x) s)) static member inline TryFinally (computation: ReaderT<'R, 'Monad, 'T>, f) = ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinallyS.Invoke (fun () -> ReaderT.run computation s) f) diff --git a/src/FSharpPlus/Data/State.fs b/src/FSharpPlus/Data/State.fs index 27c2654ff..c7af6f0e9 100644 --- a/src/FSharpPlus/Data/State.fs +++ b/src/FSharpPlus/Data/State.fs @@ -234,7 +234,7 @@ type StateT<'s, 'monad, 't> with static member inline Zip (x: StateT<'S, 'Monad, 'T>, y: StateT<'S, 'Monad, 'U>) = StateT.zip x y static member inline TryWith (source: StateT<'S, 'Monad, 'T>, f: exn -> StateT<'S, 'Monad, 'T>) = - StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWithS.Invoke (fun () -> (StateT.run source s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWith.InvokeFromOtherMonad (fun () -> (StateT.run source s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) static member inline TryFinally (computation: StateT<'S,'Monad,'T>, f) = StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinallyS.Invoke (fun () -> StateT.run computation s) f) From 7207b2b1853c3413306505ad7330c73a8c98dc91 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 9 Jul 2022 19:08:53 +0200 Subject: [PATCH 19/33] fix/add type annotations to docs --- docsrc/content/abstraction-monad.fsx | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/docsrc/content/abstraction-monad.fsx b/docsrc/content/abstraction-monad.fsx index 1e29cf1f3..b787998be 100644 --- a/docsrc/content/abstraction-monad.fsx +++ b/docsrc/content/abstraction-monad.fsx @@ -144,7 +144,7 @@ let some14 = (** ```f# -let fn : ResultT>> = +let fn : ResultT, _> = monad { let! x1 = lift ask let! x2 = @@ -182,7 +182,7 @@ let decodeError = function // Now the following functions compose the Error monad with the Async one. -let getValidPassword : ResultT<_> = +let getValidPassword : ResultT<_, _, _> = monad { let! s = liftAsync getLine if isValid s then return s @@ -254,11 +254,11 @@ module CombineReaderWithWriterWithResult = let! w = eitherConv divide5By 6.0 let! x = eitherConv divide5By 3.0 let! y = eitherConv divide5By 0.0 - let! z = eitherConv otherDivide5By 0.0 (throw << (fun _ -> "Unknown error")) + let! z = eitherConv otherDivide5By 0.0 (throw << (fun (_: unit) -> "Unknown error")) return (w, x, y, z) } - let run expr = ReaderT.run expr >> ResultT.run >> Writer.run + let run expr = ReaderT.run expr >> ResultT.run >> Writer.run let (_, log) = run divide DateTime.UtcNow From 038859e6261e73b3a9a103e4f4cb5834746442b6 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 10 Jul 2022 23:39:46 +0200 Subject: [PATCH 20/33] HKTize Free and Coproduct --- src/FSharpPlus/Data/Coproduct.fs | 83 +++++++++++++++++++++++++------- src/FSharpPlus/Data/Free.fs | 60 +++++++++++------------ tests/FSharpPlus.Tests/Free.fs | 8 +-- 3 files changed, 100 insertions(+), 51 deletions(-) diff --git a/src/FSharpPlus/Data/Coproduct.fs b/src/FSharpPlus/Data/Coproduct.fs index 62fb43fee..1d7ab6808 100644 --- a/src/FSharpPlus/Data/Coproduct.fs +++ b/src/FSharpPlus/Data/Coproduct.fs @@ -4,39 +4,88 @@ open FSharpPlus open FSharpPlus.Control +open FSharpPlus.Internals.Prelude [] -type CoproductBase<'``functorL<'t>``,'``functorR<'t>``> (left: '``functorL<'t>``, right: '``functorR<'t>``, isLeft: bool) = +type CoproductBase<'functorL, 'functorR, 't> (left: obj, right: obj, isLeft: bool) = let (left, right, isLeft) = left, right, isLeft with member __.getContents () = left, right, isLeft override x.GetHashCode () = Unchecked.hash (x.getContents ()) override x.Equals o = match o with - | :? CoproductBase<'``functorL<'t>``,'``functorR<'t>``> as y -> Unchecked.equals (x.getContents ()) (y.getContents ()) + | :? CoproductBase<'functorL, 'functorR, 't> as y -> Unchecked.equals (x.getContents ()) (y.getContents ()) | _ -> false -type Coproduct<[]'``functorL<'t>``,'``functorR<'t>``> (left: '``functorL<'t>``, right: '``functorR<'t>``, isLeft: bool) = - inherit CoproductBase<'``functorL<'t>``,'``functorR<'t>``> (left, right, isLeft) +type CoproductL<[]'functorL, 'functorR, 't> (left: obj, right: obj, isLeft: bool) = + inherit CoproductBase<'functorL, 'functorR, 't> (left, right, isLeft) + +type CoproductR<[]'functorL, 'functorR, 't> (left: obj, right: obj, isLeft: bool) = + inherit CoproductL<'functorL, 'functorR, 't> (left, right, isLeft) + +type Coproduct<[]'functorL, 'functorR, 't> (left: obj, right: obj, isLeft: bool) = + inherit CoproductR<'functorL, 'functorR, 't> (left, right, isLeft) [] module CoproductPrimitives = - let InL x = Coproduct<'``functorL<'t>``,'``functorR<'t>``> (x, Unchecked.defaultof<'``functorR<'t>``>, true) - let InR x = Coproduct<'``functorL<'t>``,'``functorR<'t>``> (Unchecked.defaultof<'``functorL<'t>``>, x, false) - let (|InL|InR|) (x: Coproduct<'``functorL<'t>``,'``functorR<'t>``>) = let (l, r, isL) = x.getContents () in if isL then InL l else InR r + [] + let inline InL (x: '``FunctorL<'T>``) : Coproduct<'FunctorL, 'FunctorR, 'T> = + if opaqueId false then + let (_: 'FunctorL) = Map.Invoke (fun (_: 'T) -> Unchecked.defaultof<__>) Unchecked.defaultof<'``FunctorL<'T>``> + () + Coproduct<'FunctorL, 'FunctorR, 'T> (box x, null, true) + + [] + let inline InR (x: '``FunctorR<'T>``) : Coproduct<'FunctorL, 'FunctorR, 'T> = + if opaqueId false then + let (_: 'FunctorR) = Map.Invoke (fun (_: 'T) -> Unchecked.defaultof<__>) Unchecked.defaultof<'``FunctorR<'T>``> + () + Coproduct<'FunctorL, 'FunctorR, 'T> (null, box x, false) + + + let inline (|InL|InR|) (x: Coproduct<'FunctorL, 'FunctorR, 'T>) : Choice<'``FunctorL<'T>``, '``FunctorR<'T>``> = + if opaqueId false then + let (_: '``FunctorL<'T>``) = Map.Invoke (fun (_: __) -> Unchecked.defaultof<'T>) Unchecked.defaultof<'FunctorL> + let (_: '``FunctorR<'T>``) = Map.Invoke (fun (_: __) -> Unchecked.defaultof<'T>) Unchecked.defaultof<'FunctorR> + () + let (l, r, isL) = x.getContents () + if isL then InL (unbox<'``FunctorL<'T>``> l) + else InR (unbox<'``FunctorR<'T>``> r) -type CoproductBase<'``functorL<'t>``,'``functorR<'t>``> with - static member inline Map (x: CoproductBase<'``FunctorL<'T>``,'``FunctorR<'T>``>, f: 'T -> 'U) : Coproduct<'``FunctorL<'U>``,'``FunctorR<'U>``> = +type CoproductBase<'functorL, 'functorR, 't> with + static member inline Map (x: CoproductBase<'FunctorL, 'FunctorR, 'T>, f: 'T -> 'U) : Coproduct<'FunctorL, 'FunctorR, 'U> = let (l, r, isL) = x.getContents () - if isL then InL (Map.Invoke f l) - else InR (Map.Invoke f r) - -type Coproduct<'``functorL<'t>``,'``functorR<'t>``> with - static member inline Map (a: Coproduct<'``FunctorL<'T>``,'``FunctorR<'T>``>, f: 'T -> 'U) : Coproduct<'``FunctorL<'U>``,'``FunctorR<'U>``> = - let (l, r, isL) = a.getContents () - if isL then InL (Map.InvokeOnInstance f l) - else InR (Map.InvokeOnInstance f r) + if isL then InL (Map.Invoke f (unbox l: '``FunctorL<'T>``) : '``FunctorL<'U>``) + else InR (Map.Invoke f (unbox r: '``FunctorR<'T>``) : '``FunctorR<'U>``) + +type CoproductL<'functorL, 'functorR, 't> with + static member inline Map (x: CoproductL<'FunctorL, 'FunctorR, 'T>, f: 'T -> 'U) : Coproduct<'FunctorL, 'FunctorR, 'U> = + let inline _CXs (_: '``FunctorL<'T>``* '``FunctorR<'T>``) = + let (_: '``FunctorR<'T>``) = Map.InvokeOnInstance (fun (_: __) -> Unchecked.defaultof<'T>) Unchecked.defaultof<'FunctorR> + () + let (l, r, isL) = x.getContents () + if isL then InL (Map.Invoke f (unbox l: '``FunctorL<'T>``) : '``FunctorL<'U>``) + else Coproduct<_, _, _> (null, box (Map.InvokeOnInstance f (unbox r: '``FunctorR<'T>``) : ^``FunctorR<'U>`` ), false) + +type CoproductL<'functorL, 'functorR, 't> with + static member inline Map (x: CoproductL<'FunctorL, 'FunctorR, 'T>, f: 'T -> 'U) : Coproduct<'FunctorL, 'FunctorR, 'U> = + let inline _CXs (_: '``FunctorL<'T>``* '``FunctorR<'T>``) = + let (_: '``FunctorL<'T>``) = Map.InvokeOnInstance (fun (_: __) -> Unchecked.defaultof<'T>) Unchecked.defaultof<'FunctorL> + () + let (l, r, isL) = x.getContents () + if isL then Coproduct<_, _, _> (box (Map.InvokeOnInstance f (unbox l: '``FunctorL<'T>``) : ^``FunctorL<'U>`` ), null, true ) + else InR (Map.Invoke f (unbox r: '``FunctorR<'T>``) : '``FunctorR<'U>``) + +type Coproduct<'functorL, 'functorR, 't> with + static member inline Map (x: Coproduct<'FunctorL, 'FunctorR, 'T>, f: 'T -> 'U) : Coproduct<'FunctorL, 'FunctorR, 'U> = + let inline _CXs (_: '``FunctorL<'T>``* '``FunctorR<'T>``) = + let (_: '``FunctorL<'T>``) = Map.InvokeOnInstance (fun (_: __) -> Unchecked.defaultof<'T>) Unchecked.defaultof<'FunctorL> + let (_: '``FunctorR<'T>``) = Map.InvokeOnInstance (fun (_: __) -> Unchecked.defaultof<'T>) Unchecked.defaultof<'FunctorR> + () + let (l, r, isL) = x.getContents () + if isL then Coproduct<_, _, _> (box (Map.InvokeOnInstance f (unbox l: '``FunctorL<'T>``) : ^``FunctorL<'U>`` ), null, true ) + else Coproduct<_, _, _> (null, box (Map.InvokeOnInstance f (unbox r: '``FunctorR<'T>``) : ^``FunctorR<'U>`` ), false) #endif \ No newline at end of file diff --git a/src/FSharpPlus/Data/Free.fs b/src/FSharpPlus/Data/Free.fs index 4a9f13b63..04a4d45e2 100644 --- a/src/FSharpPlus/Data/Free.fs +++ b/src/FSharpPlus/Data/Free.fs @@ -10,66 +10,66 @@ open FSharpPlus.Internals.Prelude [] -type Free<'``functor<'t>``,'t> = Pure of 't | Roll of obj +type Free<'functor, 't> = Pure of 't | Roll of obj [] module FreePrimitives = - let inline Roll (f: '``Functor,'T>>``) : Free<'``Functor<'T>``,'T> = + let inline Roll (f: '``Functor>``) : Free<'Functor, 'T> = if opaqueId false then - let (_: '``Functor<'T>``) = Map.Invoke (fun (_: Free<'``Functor<'T>``,'T>) -> Unchecked.defaultof<'T>) f + let (_: 'Functor) = Map.Invoke (fun (_: Free<'Functor, 'T>) -> Unchecked.defaultof<__>) f () - Free<'``Functor<'T>``,'T>.Roll f + Free<'Functor, 'T>.Roll f let (|Pure|Roll|) x = match x with Choice1Of2 x -> Pure x | Choice2Of2 x -> Roll x /// Basic operations on Free Monads [] module Free = - let inline run (f: Free<'``Functor<'T>``,'T>) : Choice<_,'``Functor,'T>>``> = + let inline run (f: Free<'Functor, 'T>) : Choice<_, '``Functor>``> = if opaqueId false then - let (_: ^``Functor,'T>>``) = Map.Invoke (fun (_: 'T) -> Unchecked.defaultof``,'T>>) Unchecked.defaultof<'``Functor<'T>``> + let (_: ^``Functor>``) = Map.Invoke (fun (_: __) -> Unchecked.defaultof>) Unchecked.defaultof<'Functor> () match f with | Free.Pure x -> Choice1Of2 x | Free.Roll x -> let x = unbox x in Choice2Of2 x let inline map f x = - let rec loop (f: 'T->'U) (x: Free<'``Functor<'T>``,'T>) : Free<'``Functor<'U>``,'U> = + let rec loop (f: 'T->'U) (x: Free<'Functor, 'T>) : Free<'Functor, 'U> = match run x with | Pure x -> Pure (f x) - | Roll (x: ^``Functor,'T>>``) -> Roll (Map.Invoke (loop f : Free<'``Functor<'T>``,'T> -> _) x: ^``Functor,'U>>``) + | Roll (x: ^``Functor>``) -> Roll (Map.Invoke (loop f : Free<'Functor, 'T> -> _) x: ^``Functor>``) loop f x - let inline bind (f: 'T -> Free<'``Functor<'U>``,'U>) (x: Free<'``Functor<'T>``,'T>) : Free<'``Functor<'U>``,'U> = + let inline bind (f: 'T -> Free<'Functor, 'U>) (x: Free<'Functor, 'T>) : Free<'Functor, 'U> = let rec loop f (x: Free<_,_>) = match run x with | Pure r -> f r - | Roll (x: ^``Functor,'T>>``) -> Roll (Map.Invoke (loop f : Free<'``Functor<'T>``,'T> -> _) x: ^``Functor,'U>>``) : Free<'``Functor<'U>``,'U> + | Roll (x: ^``Functor>``) -> Roll (Map.Invoke (loop f : Free<'Functor, 'T> -> _) x: ^``Functor>``) : Free<'Functor, 'U> loop f x - let inline apply (f: Free<'``Functor<'T->'U>``,'T->'U>) (x: Free<'``Functor<'T>``,'T>) : Free<'``Functor<'U>``,'U> = + let inline apply (f: Free<'Functor, 'T->'U>) (x: Free<'Functor, 'T>) : Free<'Functor, 'U> = let rec loop (x: Free<_,_>) (f: Free<_,_>) = match run f with - | Pure f -> map<'T,'U,'``Functor<'T>``,'``Functor,'T>>``,'``Functor,'U>>``,'``Functor<'U>``> f x : Free<'``Functor<'U>``,'U> - | Roll (f: ^``Functor'U>,'T->'U>>``) -> Roll (Map.Invoke (loop x: Free<'``Functor<'T->'U>``,'T->'U> -> _) f: '``Functor,'U>>``) + | Pure f -> map<'T, 'U, 'Functor, '``Functor>``, '``Functor>``> f x : Free<'Functor, 'U> + | Roll (f: ^``Functor 'U)>>``) -> Roll (Map.Invoke (loop x: Free<'Functor, ('T -> 'U)> -> _) f: '``Functor>``) loop x f - let inline map2 (f: 'T->'U->'V) (x: Free<'``Functor<'T>``,'T>) (y: Free<'``Functor<'U>``,'U>) : Free<'``Functor<'V>``,'V> = + let inline map2 (f: 'T->'U->'V) (x: Free<'Functor, 'T>) (y: Free<'Functor, 'U>) : Free<'Functor, 'V> = let rec loop (y: Free<_,_>) (x: Free<_,_>) = match run x with - | Pure x -> map<'U,'V,'``Functor<'U>``,'``Functor,'U>>``,'``Functor,'V>>``,'``Functor<'V>``> (f x) y : Free<'``Functor<'V>``,'V> - | Roll (x: ^``Functor,'T>>``) -> Roll (Map.Invoke (loop y: Free<'``Functor<'T>``,'T> -> _) x: '``Functor,'V>>``) + | Pure x -> map<'U, 'V, 'Functor, '``Functor>``, '``Functor>``> (f x) y : Free<'Functor, 'V> + | Roll (x: ^``Functor>``) -> Roll (Map.Invoke (loop y: Free<'Functor, 'T> -> _) x: '``Functor>``) loop y x - let inline map3 (f: 'T->'U->'V->'W) (x: Free<'``Functor<'T>``,'T>) (y: Free<'``Functor<'U>``,'U>) (z: Free<'``Functor<'V>``,'V>) : Free<'``Functor<'W>``,'W> = + let inline map3 (f: 'T->'U->'V->'W) (x: Free<'Functor, 'T>) (y: Free<'Functor, 'U>) (z: Free<'Functor, 'V>) : Free<'Functor, 'W> = let rec loop (y: Free<_,_>) (x: Free<_,_>) (z: Free<_,_>) = match run x with - | Pure x -> map2<'U,'V,'W,'``Functor<'U>``,'``Functor,'U>>``,'``Functor,'V>>``,'``Functor,'W>>``,'``Functor<'V>``,'``Functor<'W>``> (f x) y z : Free<'``Functor<'W>``,'W> - | Roll (x: ^``Functor,'T>>``) -> Roll (Map.Invoke (loop y: Free<'``Functor<'T>``,'T> -> _) x: '``Functor,'W>>``) + | Pure x -> map2<'U, 'V, 'W, 'Functor, '``Functor>``, '``Functor>``, '``Functor>``> (f x) y z : Free<'Functor, 'W> + | Roll (x: ^``Functor>``) -> Roll (Map.Invoke (loop y: Free<'Functor, 'T> -> _) x: '``Functor>``) loop y x z /// Folds the Free structure into a Monad - let inline fold (f: '``Functor<'T>`` -> '``Monad<'T>``) (x: Free<'``Functor<'U>``,'U>) : '``Monad<'U>`` = + let inline fold (f: '``Functor<'T>`` -> '``Monad<'T>``) (x: Free<'Functor, 'U>) : '``Monad<'U>`` = let rec loop f x = match run x with | Pure a -> Return.Invoke a @@ -77,32 +77,32 @@ module Free = loop f x /// Tear down a Free monad using iteration. - let inline iterM (f: '``Functor<'Monad<'T>>`` -> '``Monad<'T>``) (x: Free<'``Functor<'T>``,'T>) : '``Monad<'T>`` = + let inline iterM (f: '``Functor<'Monad<'T>>`` -> '``Monad<'T>``) (x: Free<'Functor, 'T>) : '``Monad<'T>`` = let rec loop f x = match run x with | Pure x -> Return.Invoke x - | Roll (x: ^``Functor,'T>>``) -> f (loop f x) + | Roll (x: ^``Functor>``) -> f (loop f x) loop f x /// Lift any Functor into a Free structure - let inline liftF (x: '``Functor<'T>``) : Free<'``Functor<'T>``,'T> = Roll (Map.Invoke (Pure: 'T -> Free<'``Functor<'T>``,'T>) x : '``Functor,'T>>``) + let inline liftF (x: '``Functor<'T>``) : Free<'Functor, 'T> = Roll (Map.Invoke (Pure: 'T -> Free<'Functor, 'T>) x : '``Functor>``) -type Free<'``functor<'t>``,'t> with +type Free<'functor, 't> with [] - static member inline Map (x: Free<'``Functor<'T>``,'T>, f: 'T -> 'U) = Free.map f x : Free<'``Functor<'U>``,'U> + static member inline Map (x: Free<'Functor, 'T>, f: 'T -> 'U) = Free.map f x : Free<'Functor, 'U> static member Return x = Pure x - static member inline (>>=) (x: Free<'``Functor<'T>``,'T>, f: 'T -> Free<'``Functor<'U>``,'U>) = Free.bind f x : Free<'``Functor<'U>``,'U> - static member inline (<*>) (f: Free<'``Functor<'T->'U>``,'T->'U>, x: Free<'``Functor<'T>``,'T>) = Free.apply f x : Free<'``Functor<'U>``,'U> + static member inline (>>=) (x: Free<'Functor, 'T>, f: 'T -> Free<'Functor, 'U>) = Free.bind f x : Free<'Functor, 'U> + static member inline (<*>) (f: Free<'Functor, ('T -> 'U)>, x: Free<'Functor, 'T>) = Free.apply f x : Free<'Functor, 'U> [] - static member inline Lift2 (f, x: Free<'``Functor<'T>``,'T>, y: Free<'``Functor<'U>``,'U>) = Free.map2 f x y: Free<'``Functor<'V>``,'V> + static member inline Lift2 (f, x: Free<'Functor, 'T>, y: Free<'Functor, 'U>) = Free.map2 f x y: Free<'Functor, 'V> [] - static member inline Lift3 (f, x: Free<'``Functor<'T>``,'T>, y: Free<'``Functor<'U>``,'U>, z: Free<'``Functor<'V>``,'V>) = Free.map3 f x y z: Free<'``Functor<'W>``,'W> + static member inline Lift3 (f, x: Free<'Functor, 'T>, y: Free<'Functor, 'U>, z: Free<'Functor, 'V>) = Free.map3 f x y z: Free<'Functor, 'W> - static member Delay (x: unit -> Free<'``Functor<'T>``,'T>) = x () + static member Delay (x: unit -> Free<'Functor, 'T>) = x () #endif \ No newline at end of file diff --git a/tests/FSharpPlus.Tests/Free.fs b/tests/FSharpPlus.Tests/Free.fs index f3e82cba1..5a5b08907 100644 --- a/tests/FSharpPlus.Tests/Free.fs +++ b/tests/FSharpPlus.Tests/Free.fs @@ -38,7 +38,7 @@ module Sample1 = | Get (k, c) -> Get (k, c >> f) | Set (k, v, c) -> Set (k, v, f c ) - type FreeDSL<'a> = Free,'a> + type FreeDSL<'a> = Free,'a> let ex1 = Set ("alma", "bela", (Get ("alma", id))) let exF1 = Roll (Set ("alma", "bela", (Roll (Get ("alma", (fun s -> Pure s)))))) @@ -173,7 +173,7 @@ module Sample3 = | GetSlots (x, next) -> GetSlots (x, next >> f) | PostReservation (x, next) -> PostReservation (x, next |> f) - type Program<'t> = Free, ReservationsApiInstruction<'t>>,'t> + type Program<'t> = Free, ReservationsApiInstruction<__>, __>, 't> let readLine = (Free.liftF << InL) (ReadLine id) : Program<_> @@ -264,7 +264,7 @@ module TestCoproduct = let a36 = map string a31 let a37 = map string a32 - let a41 = InL [3] : Coproduct<_,_ list> + let a41 = InL [3] : Coproduct<_,__ list, _> let a42 = map ((+)10 >> string) a41 open Sample3 @@ -291,7 +291,7 @@ module Fold = match instruction with | Read (id, next) -> Read(id, next >> f) - type Program<'a> = Free, 'a> + type Program<'a> = Free, 'a> let read fooId = Read(fooId, id) |> Free.liftF From 322b66386b253d94322a3bd12ae83d0748a9b5f5 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Fri, 15 Jul 2022 20:05:02 +0200 Subject: [PATCH 21/33] HKTize ListT --- src/FSharpPlus/Data/List.fs | 315 ++++++++++++------ tests/FSharpPlus.Tests/General.fs | 2 +- tests/FSharpPlus.Tests/ListT.fs | 6 +- .../FSharpTests/General.fs | 2 +- 4 files changed, 218 insertions(+), 107 deletions(-) diff --git a/src/FSharpPlus/Data/List.fs b/src/FSharpPlus/Data/List.fs index 926e79066..4755eabaa 100644 --- a/src/FSharpPlus/Data/List.fs +++ b/src/FSharpPlus/Data/List.fs @@ -36,157 +36,268 @@ open FSharpPlus.Control /// Monad Transformer for list<'T> [] -type ListT<'``monad<'t>``> = ListT of obj -type ListTNode<'``monad<'t>``,'t> = Nil | Cons of 't * ListT<'``monad<'t>``> +type ListT<'monad, 't> = ListT of obj +type ListTNode<'monad, 't> = Nil | Cons of 't * ListT<'monad, 't> /// Basic operations on ListT [] module ListT = - let inline internal wrap (mit: 'mit) = - let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) -> (result ListTNode<'mt,'t>.Nil ) : 'mit - ListT mit : ListT<'mt> + let inline internal wrap (mit: '``Monad>``) = + if opaqueId false then + let _: 'Monad = Unchecked.defaultof<'``Monad>``> |> map (fun (_: ListTNode<'Monad, 'T>) -> Unchecked.defaultof<__>) + let _: '``Monad>`` = Unchecked.defaultof<'Monad> |> map (fun (_: __) -> Unchecked.defaultof>) + () + ListT mit : ListT<'Monad, 'T> - let inline internal unwrap (ListT mit : ListT<'mt>) = - let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) -> (result ListTNode<'mt,'t>.Nil ) : 'mit - unbox mit : 'mit + let inline internal unwrap (ListT mit: ListT<'Monad, 'T>) : '``Monad>`` = + if opaqueId false then + let _: 'Monad = Unchecked.defaultof<'``Monad>``> |> map (fun (_: ListTNode<'Monad, 'T>) -> Unchecked.defaultof<__>) + let _: '``Monad>`` = Unchecked.defaultof<'Monad> |> map (fun (_: __) -> Unchecked.defaultof>) + () + unbox mit - let inline empty () = wrap ((result ListTNode<'mt,'t>.Nil) : 'mit) : ListT<'mt> + let inline empty<'T, .. > () = wrap ((result ListTNode<'Monad, 'T>.Nil) : '``Monad>``) : ListT<'Monad, 'T> /// Concatenates the elements of two lists - let inline concat l1 l2 = - let rec loop (l1: ListT<'mt>) (lst2: ListT<'mt>) = - let (l1, l2) = unwrap l1, unwrap lst2 - ListT (l1 >>= function Nil -> l2 | Cons (x: 't, xs) -> ((result (Cons (x, loop xs lst2))) : 'mit)) - loop l1 l2 : ListT<'mt> - - let inline bind f (source: ListT<'mt>) : ListT<'mu> = - let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_: 't) -> (result Unchecked.defaultof<'u>) : 'mu + let inline concat<'T, .. > l1 l2 = + let rec loop (l1: ListT<'Monad, 'T>) (lst2: ListT<'Monad, 'T>) = + let (l1, l2) = (unwrap l1: '``Monad>``), unwrap lst2 + ListT (l1 >>= function Nil -> l2 | Cons (x: 'T, xs) -> ((result (Cons (x, loop xs lst2))) : '``Monad>``)) + loop l1 l2 : ListT<'Monad, 'T> + + let inline bind<'T, 'U, .. > f (source: ListT<'Monad, 'T>) : ListT<'Monad, ' U> = let rec loop f input = ListT ( - (unwrap input : 'mit) >>= function - | Nil -> result <| (Nil : ListTNode<'mu,'u>) : 'miu - | Cons (h:'t, t: ListT<'mt>) -> - let res = concat (f h: ListT<'mu>) (loop f t) - unwrap res : 'miu) - loop f source : ListT<'mu> - - let inline unfold (f:'State -> '``M<('T * 'State) option>``) (s:'State) : ListT<'MT> = - let rec loop f s = f s |> map (function + (unwrap input: '``Monad>``) >>= function + | Nil -> result Nil + | Cons (h: 'T, t: ListT<'Monad, 'T>) -> + let res = concat<'U, _, '``Monad>``> (f h: ListT<'Monad, 'U>) (loop f t) + unwrap res : '``Monad>``) + loop f source + + let inline unfold<'State, 'T, .. > (f: 'State -> '``Monad<('T * 'State) option>``) (s: 'State) : ListT<'Monad, 'T> = + let rec loop f s = + (f s |> map (function | Some (a, s) -> Cons(a, loop f s) - | None -> Nil) |> wrap + | None -> Nil) : '``Monad>``) |> wrap loop f s - let inline map f (input : ListT<'mt>) : ListT<'mu> = - let rec collect f (input : ListT<'mt>) : ListT<'mu> = + let inline lift<'T, .. > (x: '``Monad<'T>``) : ListT<'Monad, 'T> = + wrap ((x |> (if opaqueId false then liftM else map) (fun x -> Cons (x, empty<'T, 'Monad, '``Monad>``> () ))) : '``Monad>`` ) + + let inline map<'T, 'U, .. > f (input: ListT<'Monad, 'T>) : ListT<'Monad, 'U> = + let rec collect f (input : ListT<'Monad, 'T>) : ListT<'Monad, 'U> = wrap ( - (unwrap input : 'mit) >>= function - | Nil -> result <| (Nil : ListTNode<'mu,'u>) : 'miu - | Cons (h: 't, t: ListT<'mt>) -> - let ( res) = Cons (f h, collect f t) - result res : 'miu) - collect f (input: ListT<'mt>) : ListT<'mu> - - let inline singleton (v: 't) = + (unwrap input: '``Monad>``) >>= function + | Nil -> result Nil + | Cons (h: 'T, t: ListT<'Monad, 'T>) -> + let res = Cons (f h, collect f t) + result res : '``Monad>``) + collect f (input: ListT<'Monad, 'T>) : ListT<'Monad, 'U> + + let inline singleton<'T, .. > (v: 'T) = let mresult x = result x - let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= konst (mresult ListTNode<'mt,'t>.Nil ) : 'mit - wrap ((mresult <| ListTNode<'mt,'t>.Cons (v, (wrap (mresult ListTNode<'mt,'t>.Nil): ListT<'mt> ))) : 'mit) : ListT<'mt> - - let inline apply f x = bind (fun (x1: _) -> bind (fun x2 -> singleton (x1 x2)) x) f - - let inline append (head: 't) tail = wrap ((result <| ListTNode<'mt,'t>.Cons (head, (tail: ListT<'mt> ))) : 'mit) : ListT<'mt> - - let inline head (x : ListT<'mt>) = - unwrap x >>= function + wrap ((mresult <| ListTNode<'Monad, 'T>.Cons (v, (wrap (mresult ListTNode<'Monad, 'T>.Nil): ListT<'Monad, 'T> ))) : '``Monad>``) : ListT<'Monad, 'T> + + let inline apply<'T, 'U, .. > (f: ListT<'Monad, ('T -> 'U)>) (x: ListT<'Monad, 'T>) : ListT<'Monad, 'U> = + bind<_, _, _, '``Monad>``, '``Monad 'U)>>``> (fun (x1: _) -> + bind<_, _, _, '``Monad>``, '``Monad>``> (fun x2 -> + singleton<_, _, '``Monad>``> (x1 x2)) x) f + + /// Safely builds a new list whose elements are the results of applying the given function + /// to each of the elements of the two lists pairwise. + /// If one list is shorter, excess elements are discarded from the right end of the longer list. + let inline map2 (f: 'T -> 'U -> 'V) (x: ListT<'Monad, 'T>) (y : ListT<'Monad, 'U>) : ListT<'Monad, 'V> = + let rec collect f x y = + wrap ( + (lift2 tuple2, ListTNode<'Monad, 'U>> + (unwrap x: '``Monad>``) + (unwrap y: '``Monad>``) + : '``Monad * ListTNode<'Monad, 'U>>``) + >>= function + | Cons (t: 'T, ts: ListT<'Monad, 'T>), Cons (u: 'U, us: ListT<'Monad, 'U>) -> + let res = Cons (f t u, collect f ts us) + result res: '``Monad>`` + | _, _ -> result Nil) + collect f x y + + /// Same as map2 but with 3 lists. + let inline map3 (f: 'T -> 'U -> 'V -> 'W) (x: ListT<'Monad, 'T>) (y : ListT<'Monad, 'U>) (z: ListT<'Monad, 'V>) : ListT<'Monad, 'W> = + let rec collect f x y z = + wrap ( + (lift3 + tuple3, ListTNode<'Monad, 'U>, ListTNode<'Monad, 'V>> + (unwrap x: '``Monad>``) + (unwrap y: '``Monad>``) + (unwrap z: '``Monad>``) + : '``Monad * ListTNode<'Monad, 'U>> * ListTNode<'Monad, 'V>>``) + >>= function + | Cons (t: 'T, ts: ListT<'Monad, 'T>), Cons (u: 'U, us: ListT<'Monad, 'U>), Cons (v: 'V, vs: ListT<'Monad, 'V>) -> + let res = Cons (f t u v, collect f ts us vs) + result res: '``Monad>`` + | _, _, _ -> result Nil) + collect f x y z + + /// Combines values from two list and calls a mapping function on this combination. + /// Mapping function taking three element combination as input. + /// First list. + /// Second list. + /// + /// List with values returned from mapping function. + let inline lift2<'T, 'U, 'V, .. > (f: 'T -> 'U -> 'V) (x: ListT<'Monad, 'T>) (y : ListT<'Monad, 'U>) : ListT<'Monad, 'V> = + f 'V, 'Monad, '``Monad 'V>>``, '``Monad>``> /> x + 'V>>``, '``Monad>``, '``Monad>``> /> y + + /// Combines values from three list and calls a mapping function on this combination. + /// Mapping function taking three element combination as input. + /// First list. + /// Second list. + /// Third list. + /// + /// List with values returned from mapping function. + let inline lift3<'T, 'U, 'V, 'W, .. > (f: 'T -> 'U -> 'V -> 'W) (x: ListT<'Monad, 'T>) (y : ListT<'Monad, 'U>) (z: ListT<'Monad, 'V>) : ListT<'Monad, 'W> = + f 'V -> 'W, 'Monad, '``Monad 'V -> 'W>>``, '``Monad>``> /> x + 'W , 'Monad, '``Monad 'V -> 'W>>``, '``Monad 'W>>``, '``Monad>``> /> y + 'W>>`` , '``Monad>`` , '``Monad>``> /> z + + let inline append (head: 'T) tail = wrap ((result <| ListTNode<'Monad, 'T>.Cons (head, (tail: ListT<'Monad, 'T> ))) : '``Monad>``) : ListT<'Monad, 'T> + + let inline head (x: ListT<'Monad, 'T>) = + (unwrap x: '``Monad>``) >>= function | Nil -> failwith "empty list" - | Cons (head, _) -> result head : 'mt + | Cons (head, _: ListT<'Monad, 'T>) -> result head : '``Monad<'T>`` - let inline tail (x: ListT<'mt>) : ListT<'mt> = - (unwrap x >>= function + let inline tail (x: ListT<'Monad, 'T>) : ListT<'Monad, 'T> = + ((unwrap x: '``Monad>``) >>= function | Nil -> failwith "empty list" - | Cons (_: 't, tail) -> unwrap tail) |> wrap + | Cons (_: 'T, tail: ListT<'Monad, 'T>) -> (unwrap tail: '``Monad>``)) |> wrap - let inline iterM (action: 'T -> '``M``) (lst: ListT<'MT>) : '``M`` = + let inline iterM<'T, .. > (action: 'T -> '``Monad``) (lst: ListT<'Monad, 'T>) : '``Monad`` = let rec loop lst action = - unwrap lst >>= function + (unwrap lst: '``Monad>``) >>= function | Nil -> result () | Cons (h, t) -> action h >>= (fun () -> loop t action) loop lst action - let inline iter (action: 'T -> unit) (lst: ListT<'MT>) : '``M`` = iterM (action >> result) lst + let inline iter<'T, .. > (action: 'T -> unit) (lst: ListT<'Monad, 'T>) : '``Monad`` = + iterM<'T, '``Monad``, '``Monad>``, 'Monad> (action >> result) lst - let inline lift (x: '``Monad<'T>``) = wrap (x >>= (result << (fun x -> Cons (x, empty () )))) : ListT<'``Monad<'T>``> - - let inline take count (input : ListT<'MT>) : ListT<'MT> = - let rec loop count (input : ListT<'MT>) : ListT<'MT> = wrap <| monad { + let inline take<'T, .. > count (input: ListT<'Monad, 'T>) : ListT<'Monad, 'T> = + let rec loop count input = wrap <| (monad { if count > 0 then - let! v = unwrap input + let! v = unwrap input: '``Monad>`` match v with - | Cons (h, t) -> return Cons (h, loop (count - 1) t) + | Cons (h, t: ListT<'Monad, 'T>) -> return Cons (h, loop (count - 1) t) | Nil -> return Nil - else return Nil } - loop count (input: ListT<'MT>) + else return Nil } : '``Monad>``) + loop count (input: ListT<'Monad, 'T>) - let inline filterM (f: 'T -> '``M``) (input: ListT<'MT>) : ListT<'MT> = - input |> bind (fun v -> lift (f v) |> bind (fun b -> if b then singleton v else empty ())) - - let inline filter f (input: ListT<'MT>) : ListT<'MT> = filterM (f >> result) input - - let inline run (lst: ListT<'MT>) : '``Monad>`` = - let rec loop acc x = unwrap x >>= function + let inline filterM<'T, .. > (f: 'T -> '``Monad``) (input: ListT<'Monad, 'T>) : ListT<'Monad, 'T> = + input + |> bind<_, _, _, '``Monad>``, '``Monad>``> (fun v -> + lift<_, _, '``Monad``, _> (f v) |> bind<_, _, _, '``Monad>``, '``Monad``> (fun b -> + if b then singleton<_, _, '``Monad>``> v else empty<'T, 'Monad, '``Monad>``> ())) + + let inline filter<'T, .. > (f: 'T -> bool) (input: ListT<'Monad, 'T>) : ListT<'Monad, 'T> = + filterM<'T, '``Monad``, '``Monad>``, 'Monad, '``Monad>``> (f >> result) input + + let inline run<'T, .. > (lst: ListT<'Monad, 'T>) : '``Monad>`` = + let rec loop acc x = + (unwrap x: '``Monad>``) + >>= function | Nil -> result (List.rev acc) | Cons (x, xs) -> loop (x::acc) xs loop [] lst +type []ListTOperations = + [] + static member inline ListT<'T, .. > (source: '``Monad>``) : ListT<'Monad, 'T> = + ListT.unfold``, '``Monad>``, 'Monad> + (fun i -> map (fun (lst: list<'T>) -> if lst.Length > i then Some (lst.[i], i + 1) else None) source) 0 -[] -module ListTPrimitives = - let inline listT (al: '``Monad>``) : ListT<'``Monad<'T>``> = - ListT.unfold (fun i -> map (fun (lst:list<_>) -> if lst.Length > i then Some (lst.[i], i+1) else None) al) 0 - - // let inline lift2 (f: 'T->'U->'V) (ListT x: ListT<'``Monad``>) (ListT y: ListT<'``Monad``>) = ListT (lift2 (List.lift2 f) x y) : ListT<'``Monad``> - // let inline lift3 (f: 'T->'U->'V->'W) (ListT x: ListT<'``Monad``>) (ListT y: ListT<'``Monad``>) (ListT z: ListT<'``Monad``>) = ListT (lift3 (List.lift3 f) x y z) : ListT<'``Monad``> +module []ListTOperations = + let inline listT<'T, .. > (source: '``Monad>``) : ListT<'Monad, 'T> = ListTOperations.ListT<_, _, '``Monad<('T * int) option>``, '``Monad>``, _> source -type ListT<'``monad<'t>``> with - static member inline Return (x: 'T) = ListT.singleton x : ListT<'M> - - [] - static member inline Map (x, f) = ListT.map f x - // [] - // static member inline Lift2 (f: 'T->'U->'V, x: ListT<'``Monad``>, y: ListT<'``Monad``>) = ListT.lift2 f x y : ListT<'``Monad``> - // [] - // static member inline Lift3 (f: 'T->'U->'V->'W, x: ListT<'``Monad``>, y: ListT<'``Monad``>, z: ListT<'``Monad``>) = ListT.lift3 f x y z : ListT<'``Monad``> +type ListT<'monad, 't> with + static member inline Return (x: 'T) : ListT<'Monad, 'T> = ListT.singleton<_, _, '``Monad>``> x - static member inline (<*>) (f, x) = ListT.apply f x + [] + static member inline Map (x : ListT<'Monad, 'T>, f: 'T -> 'U) : ListT<'Monad, 'U> = + ListT.map<'T, 'U, 'Monad, '``Monad>``, '``Monad>``> f x - static member inline (>>=) (x, f) = ListT.bind f x - static member inline get_Empty () = ListT.empty () - static member inline (<|>) (x, y) = ListT.concat x y + /// Lifts a function into a ListT. Same as map. + /// To be used in Applicative Style expressions, combined with <*> + /// + /// Functor + static member inline () (x : ListT<'Monad, 'T>, f: 'T -> 'U) : ListT<'Monad, 'U> = + ListT.map<'T, 'U, 'Monad, '``Monad>``, '``Monad>``> f x - static member inline TryWith (source: ListT<'``Monad<'T>``>, f: exn -> ListT<'``Monad<'T>``>) = ListT (TryWith.Invoke (ListT.unwrap source) (ListT.unwrap << f)) - static member inline TryFinally (computation: ListT<'``Monad<'T>``>, f) = ListT (TryFinally.Invoke (ListT.unwrap computation) f) - static member inline Using (resource, f: _ -> ListT<'``Monad<'T>``>) = ListT (Using.Invoke resource (ListT.unwrap << f)) - static member inline Delay (body : unit -> ListT<'``Monad<'T>``>) = ListT (Delay.Invoke (fun _ -> ListT.unwrap (body ()))) : ListT<'``Monad<'T>``> + [] + static member inline Lift2 (f: 'T -> 'U -> 'V, x: ListT<'Monad, 'T>, y: ListT<'Monad, 'U>) : ListT<'Monad, 'V> = + ListT.lift2<_, _, _, _, '``Monad 'V>>``, '``Monad>``, '``Monad>``, '``Monad>``> f x y - static member inline Lift (x: '``Monad<'T>``) = ListT.lift x : ListT<'``Monad<'T>``> + [] + static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, x: ListT<'Monad, 'T>, y: ListT<'Monad, 'U>, z: ListT<'Monad, 'V>) : ListT<'Monad, 'W> = + ListT.lift3<_, _, _, _, _, '``Monad>``, '``Monad 'V -> 'W>>``, '``Monad 'W>>``, '``Monad>``, '``Monad>``, '``Monad>``> f x y z + + static member inline (<*>) (f: ListT<'Monad, ('T -> 'U)>, x: ListT<'Monad, 'T>) : ListT<'Monad, 'U> = + ListT.apply<_, _, _, '``Monad 'U>>``, '``Monad>``, '``Monad>``> f x + + /// + /// Sequences two lists left-to-right, discarding the value of the first argument. + /// + /// Applicative + static member inline ( *>) (x: ListT<'Monad, 'T>, y: ListT<'Monad, 'U>) : ListT<'Monad, 'U> = + let () = ListT.map<_, _, 'Monad, '``Monad 'U)>>``, '``Monad>``> + let (<*>) = ListT.apply<_, _, 'Monad, '``Monad 'U>>``, '``Monad>``, '``Monad>``> + ((fun (_: 'T) (k: 'U) -> k) x: ListT<'Monad, ('U -> 'U)>) <*> y + + /// + /// Sequences two lists left-to-right, discarding the value of the second argument. + /// + /// Applicative + static member inline (<* ) (x: ListT<'Monad, 'U>, y: ListT<'Monad, 'T>) : ListT<'Monad, 'U> = + let () = ListT.map<_, _, 'Monad, '``Monad 'U>>``, '``Monad>``> + let (<*>) = ListT.apply<_, _, 'Monad, '``Monad 'U>>``, '``Monad>``, '``Monad>``> + ((fun (k: 'U) (_: 'T) -> k) x: ListT<'Monad, ('T -> 'U)>) <*> y + + static member inline (>>=) (x: ListT<'Monad, 'T>, f: 'T -> ListT<'Monad, ' U>) : ListT<'Monad, ' U> = + ListT.bind<_, _, _, '``Monad>``, '``Monad>``> f x + + static member inline get_Empty () : ListT<'Monad, 'T> = ListT.empty<_, _, '``Monad>``> () + static member inline (<|>) (x: ListT<'Monad, 'T>, y: ListT<'Monad, 'T>) : ListT<'Monad, 'T> = ListT.concat<_, _, '``Monad>``> x y + + static member inline TryWith (source: ListT<'Monad, 'T>, f: exn -> ListT<'Monad, 'T>) = ListT (TryWith.Invoke (ListT.unwrap source: '``Monad>``) (ListT.unwrap << f)) + static member inline TryFinally (computation: ListT<'Monad, 'T>, f) = ListT (TryFinally.Invoke (ListT.unwrap computation: '``Monad>``) f) + static member inline Using (resource, f: _ -> ListT<'Monad, 'T>) = ListT (Using.Invoke resource (ListT.unwrap << f : 'R -> '``Monad>``)) + static member inline Delay (body : unit -> ListT<'Monad, 'T>) : ListT<'Monad, 'T> = ListT (Delay.Invoke (fun _ -> ListT.unwrap (body ()) : '``Monad>``)) + + static member inline Lift (x: '``Monad<'T>``) = ListT.lift<_, _, '``Monad>``, _> x : ListT<'Monad, 'T> - static member inline LiftAsync (x: Async<'T>) = lift (liftAsync x) : '``ListT<'MonadAsync<'T>>`` + static member inline LiftAsync (x: Async<'T>) = ListT.lift<_, _, '``MonadAsync>``, _> (liftAsync x: '``MonadAsync<'T>``) : ListT<'MonadAsync, 'T> - static member inline Throw (x: 'E) = x |> throw |> lift - static member inline Catch (m: ListT<'``MonadError<'E1,'T>``>, h: 'E1 -> ListT<'``MonadError<'E2,'T>``>) = ListT ((fun v h -> Catch.Invoke v h) (ListT.run m) (ListT.run << h)) : ListT<'``MonadError<'E2,'T>``> + static member inline Throw (x: 'E) : ListT<'``MonadError<'E>``, 'T> = x |> throw |> ListT.lift<_, '``MonadError<'E, 'T>``, '``Monad, 'T>>``, _> + static member inline Catch (m: ListT<'``MonadError<'E1>``, 'T>, h: 'E1 -> ListT<'``MonadError<'E2>``, 'T>) : ListT<'``MonadError<'E2>``, 'T> = + ListT ( + (fun v h -> Catch.Invoke v h) + (ListT.run<'T, '``MonadError<'E1>``, '``MonadError<'E1, ListTNode<'MonadError<'E1>, 'T>>``, '``MonadError<'E1, list<'T>>``> m) + (ListT.run<'T, '``MonadError<'E2>``, '``MonadError<'E2, ListTNode<'MonadError<'E2>, 'T>>``, '``MonadError<'E2, list<'T>>``> << h)) - static member inline CallCC (f: (('T -> ListT<'``MonadCont<'R,list<'U>>``>) -> _)) = ListT (callCC <| fun c -> ListT.run (f (ListT << c << List.singleton))) : ListT<'``MonadCont<'R, list<'T>>``> + static member inline CallCC (f: (('T -> ListT<'``MonadCont<'R>``, 'U>) -> _)) : ListT<'``MonadCont<'R>``, 'T> = + ListT (callCC <| fun c -> ListT.run<'T, '``MonadCont<'R>``, '``MonadCont<'R, ListTNode<'MonadCont<'R>, 'T>>``, '``MonadCont<'R, list<'T>>``> (f (ListT << c << List.singleton))) - static member inline get_Get () = lift get : '``ListT<'MonadState<'S,'S>>`` - static member inline Put (x: 'T) = x |> put |> lift : '``ListT<'MonadState>`` + static member inline get_Get () : ListT<'``MonadState<'S>``, 'S> = ListT.lift<'S, '``MonadState<'S, 'S>``, '``MonadState<'S, ListTNode<'MonadState<'S>, 'S>>``, '``MonadState<'S>``> get + static member inline Put (x: 'T) : ListT<'``MonadState``, 'S> = x |> put |> ListT.lift<_, '``MonadState<'S, 'S>``, '``MonadState<'S, ListTNode<'MonadState<'S>, 'S>>``, _> - static member inline get_Ask () = lift ask : '``ListT<'MonadReader<'R, list<'R>>>`` - static member inline Local (m: ListT<'``MonadReader<'R2,'T>``>, f: 'R1->'R2) = listT (local f (ListT.run m)) + static member inline get_Ask () : ListT<'``MonadReader<'R>``, 'R> = ListT.lift<_, '``MonadReader<'R, 'R>``, '``MonadReader<'R, ListTNode<'MonadReader<'R>, 'R>>``, _> ask + static member inline Local (m: ListT<'``MonadReader<'R2>``, 'T>, f: 'R1 -> 'R2) : ListT<'``MonadReader<'R1>``, 'T> = + listT<'T, '``MonadReader<'R1, list<'T>>``, '``MonadReader<'R1, ('T * int) option>``, '``MonadReader<'R1, ListTNode, 'T>>``, _> (local f (ListT.run<'T, '``MonadReader<'R2>``, '``MonadReader<'R2, ListTNode, 'T>>``, '``MonadReader<'R2, list<'T>>``> m)) - static member inline Take (lst, c, _: Take) = ListT.take c lst + static member inline Take (lst : ListT<'Monad, 'T>, c: int, _: Take) : ListT<'Monad, 'T> = ListT.take<_, _, '``Monad>``> c lst #endif \ No newline at end of file diff --git a/tests/FSharpPlus.Tests/General.fs b/tests/FSharpPlus.Tests/General.fs index b2bf8f4c1..13a56c7c1 100644 --- a/tests/FSharpPlus.Tests/General.fs +++ b/tests/FSharpPlus.Tests/General.fs @@ -1815,7 +1815,7 @@ module MonadTransformers = // test generic put (no unknown(1,1): error FS0073: internal error: Undefined or unsolved type variable: ^_?51242) let initialState = -1 - let _ = put initialState : ListT> + let _ = put initialState : ListT, _> let _ = put initialState : ChoiceT, _> () diff --git a/tests/FSharpPlus.Tests/ListT.fs b/tests/FSharpPlus.Tests/ListT.fs index ba791de2d..903cef016 100644 --- a/tests/FSharpPlus.Tests/ListT.fs +++ b/tests/FSharpPlus.Tests/ListT.fs @@ -19,7 +19,7 @@ module BasicTests = [] let infiniteLists () = - let (infinite: ListT>) = ListT.unfold (fun x -> monad { return (Some (x, x + 1) ) }) 0 + let (infinite: ListT, _>) = ListT.unfold (fun x -> monad { return (Some (x, x + 1) ) }) 0 let finite = take 12 infinite let res = finite <|> infinite CollectionAssert.AreEqual (res |> take 13 |> ListT.run |> extract, [0;1;2;3;4;5;6;7;8;9;10;11;0]) @@ -30,7 +30,7 @@ module BasicTests = let res2 = listT (Task.FromResult [1..4]) >>= (fun x -> listT (Task.FromResult [x * 2])) let res3 = listT (ResizeArray [ [1..4] ]) >>= (fun x -> listT (ResizeArray [ [x * 2] ])) let res4 = listT (lazy [1..4]) >>= (fun x -> listT (lazy ( [x * 2]))) - let (res5: ListT<_ seq>) = listT (seq [ [1..4] ]) >>= (fun x -> listT (seq [ [x * 2] ])) + let (res5: ListT<__ seq, _>) = listT (seq [ [1..4] ]) >>= (fun x -> listT (seq [ [x * 2] ])) () // Note: seq needs type annotation. let bind_for_ideantity () = @@ -38,7 +38,7 @@ module BasicTests = () let computation_expressions () = - let oneTwoThree : ListT<_> = monad.plus { + let oneTwoThree : ListT<_, _> = monad.plus { do! lift <| Async.Sleep 10 yield 1 do! lift <| Async.Sleep 50 diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General.fs index 9a286e587..59a4b3ca4 100644 --- a/tests/FSharpPlusFable.Tests/FSharpTests/General.fs +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General.fs @@ -118,7 +118,7 @@ let monadTransformers = testList "MonadTransformers" [ // test generic put (no unknown(1,1): error FS0073: internal error: Undefined or unsolved type variable: ^_?51242) let initialState = -1 - let _ = put initialState : ListT> + let _ = put initialState : ListT, unit> let _ = put initialState : ChoiceT, unit> ()) From 9f8a5dca006b063297baad38748094d128473217 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 16 Jul 2022 00:24:38 +0200 Subject: [PATCH 22/33] Fix TyrFinally overload set for Fable --- src/FSharpPlus/Control/Monad.fs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index 7c18ec954..60623c847 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -291,6 +291,8 @@ type TryFinallyS = static member TryFinally ((computation: unit -> Id<_> , compensation: unit -> unit), _: TryFinallyS, _, _) = try computation () finally compensation () #if !FABLE_COMPILER static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinallyS, _, True) = Task.tryFinally computation compensation : Task<_> + #else + static member TryFinally ((computation: unit -> Tuple<_> , compensation: unit -> unit), _: TryFinallyS, _, True) = try computation () finally compensation () #endif static member inline Invoke (source: unit ->'``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = From 0cb2e18004db8fe974ac05b313cb01aac8e68051 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 16 Jul 2022 17:19:01 +0200 Subject: [PATCH 23/33] + Fable version of ListT.Take without type params --- src/FSharpPlus/Data/List.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/FSharpPlus/Data/List.fs b/src/FSharpPlus/Data/List.fs index 4755eabaa..332124dc8 100644 --- a/src/FSharpPlus/Data/List.fs +++ b/src/FSharpPlus/Data/List.fs @@ -298,6 +298,10 @@ type ListT<'monad, 't> with static member inline Local (m: ListT<'``MonadReader<'R2>``, 'T>, f: 'R1 -> 'R2) : ListT<'``MonadReader<'R1>``, 'T> = listT<'T, '``MonadReader<'R1, list<'T>>``, '``MonadReader<'R1, ('T * int) option>``, '``MonadReader<'R1, ListTNode, 'T>>``, _> (local f (ListT.run<'T, '``MonadReader<'R2>``, '``MonadReader<'R2, ListTNode, 'T>>``, '``MonadReader<'R2, list<'T>>``> m)) - static member inline Take (lst : ListT<'Monad, 'T>, c: int, _: Take) : ListT<'Monad, 'T> = ListT.take<_, _, '``Monad>``> c lst + #if FABLE_COMPILER_3 + static member inline Take (lst : ListT<'Monad, 'T>, c: int, _: Take) : ListT<'Monad, 'T> = ListT.take c lst + #else + static member inline Take (lst : ListT<'Monad, 'T>, c: int, _: Take) : ListT<'Monad, 'T> = ListT.take<_, _, '``Monad>``> c lst + #endif #endif \ No newline at end of file From a92db9e4b3e85aca8a3e9ab762e399b8f97e7bda Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 17 Jul 2022 07:44:28 +0200 Subject: [PATCH 24/33] More accurate Delay signature --- src/FSharpPlus/Control/Monad.fs | 4 ++-- src/FSharpPlus/Data/List.fs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index 60623c847..61cb1d76f 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -164,13 +164,13 @@ type Delay = static member Delay (_mthd: Delay , x: unit-> Task<_> , _ ) = x () : Task<'T> static member Delay (_mthd: Delay , x: unit-> Lazy<_> , _ ) = lazy (x().Value) : Lazy<'T> - static member inline Invoke (source : unit -> 'R) : 'R = + static member inline Invoke (source : unit -> '``Monad<'T>``) : '``Monad<'T>`` = let inline call (mthd: ^M, input: unit -> ^I) = ((^M or ^I) : (static member Delay : _*_*_ -> _) mthd, input, Unchecked.defaultof) call (Unchecked.defaultof, source) #else - static member inline Invoke source : '``Monad<'T>`` = Bind.Invoke (Return.Invoke ()) source + static member inline Invoke (source : unit -> '``Monad<'T>``) : '``Monad<'T>`` = #endif diff --git a/src/FSharpPlus/Data/List.fs b/src/FSharpPlus/Data/List.fs index 332124dc8..73325650a 100644 --- a/src/FSharpPlus/Data/List.fs +++ b/src/FSharpPlus/Data/List.fs @@ -275,7 +275,7 @@ type ListT<'monad, 't> with static member inline TryWith (source: ListT<'Monad, 'T>, f: exn -> ListT<'Monad, 'T>) = ListT (TryWith.Invoke (ListT.unwrap source: '``Monad>``) (ListT.unwrap << f)) static member inline TryFinally (computation: ListT<'Monad, 'T>, f) = ListT (TryFinally.Invoke (ListT.unwrap computation: '``Monad>``) f) static member inline Using (resource, f: _ -> ListT<'Monad, 'T>) = ListT (Using.Invoke resource (ListT.unwrap << f : 'R -> '``Monad>``)) - static member inline Delay (body : unit -> ListT<'Monad, 'T>) : ListT<'Monad, 'T> = ListT (Delay.Invoke (fun _ -> ListT.unwrap (body ()) : '``Monad>``)) + static member inline Delay (body: unit -> ListT<'Monad, 'T>) : ListT<'Monad, 'T> = ListT (Delay.Invoke (fun () -> ListT.unwrap (body ()) : '``Monad>``)) static member inline Lift (x: '``Monad<'T>``) = ListT.lift<_, _, '``Monad>``, _> x : ListT<'Monad, 'T> From 46d759804f702726d345f38ce0efeb868d3ccbad Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Tue, 19 Jul 2022 11:24:30 +0200 Subject: [PATCH 25/33] + failing test --- tests/FSharpPlus.Tests/ComputationExpressions.fs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/tests/FSharpPlus.Tests/ComputationExpressions.fs b/tests/FSharpPlus.Tests/ComputationExpressions.fs index 299e4e2a6..6ff48d211 100644 --- a/tests/FSharpPlus.Tests/ComputationExpressions.fs +++ b/tests/FSharpPlus.Tests/ComputationExpressions.fs @@ -600,6 +600,15 @@ module ComputationExpressions = with _ -> () } x let _ = monadTransformer3layersTest5 () |> WriterT.run |> ResultT.run + + let monadTransformer3layersTest6 () = + let x: ReaderT, __>, unit> = monad { + try + failwith "Exception in try-with not handled" + () + with _ -> () } + x + let _ = (monadTransformer3layersTest6 () |> ReaderT.run) () // ContT doesn't deal with the inner monad, so we don't need to do anything. From 026d1bd9072811babbfe572716bc083761d4e732 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Tue, 19 Jul 2022 12:27:12 +0200 Subject: [PATCH 26/33] Change TryWith and TryFinally signature --- src/FSharpPlus/Builders.fs | 6 +++--- src/FSharpPlus/Control/Monad.fs | 8 ++++++-- src/FSharpPlus/Data/Cont.fs | 6 +++--- src/FSharpPlus/Data/Error.fs | 20 ++++++++++---------- src/FSharpPlus/Data/List.fs | 4 ++-- src/FSharpPlus/Data/Option.fs | 4 ++-- src/FSharpPlus/Data/Reader.fs | 18 +++++++++--------- src/FSharpPlus/Data/Seq.fs | 4 ++-- src/FSharpPlus/Data/State.fs | 22 +++++++++++----------- src/FSharpPlus/Data/Writer.fs | 26 +++++++++++++------------- 10 files changed, 61 insertions(+), 57 deletions(-) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index ccd1f9c92..1336efeb7 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -69,7 +69,7 @@ module GenericBuilders = inherit Builder<'``monad<'t>``> () member __.Delay expr = expr : unit -> '``Monad<'T>`` member __.Run f = f () : '``monad<'t>`` - member inline __.TryWith (expr, handler) = TryWithS.Invoke expr handler : '``Monad<'T>`` + member inline __.TryWith (expr, handler) = TryWithS.InvokeFromOtherMonad expr handler : '``Monad<'T>`` member inline __.TryFinally (expr, compensation) = TryFinallyS.Invoke expr compensation : '``Monad<'T>`` member inline __.Using (disposable: #IDisposable, body) = Using.Invoke disposable body @@ -78,8 +78,8 @@ module GenericBuilders = inherit Builder<'``monad<'t>``> () member inline __.Delay (expr: _->'``Monad<'T>``) = Delay.Invoke expr : '``Monad<'T>`` member __.Run f = f : '``monad<'t>`` - member inline __.TryWith (expr, handler ) = TryWith.Invoke expr handler : '``Monad<'T>`` - member inline __.TryFinally (expr, compensation) = TryFinally.Invoke expr compensation : '``Monad<'T>`` + member inline __.TryWith (expr, handler ) = TryWithS.Invoke (fun () -> expr) handler : '``Monad<'T>`` + member inline __.TryFinally (expr, compensation) = TryFinallyS.Invoke (fun () -> expr) compensation : '``Monad<'T>`` member inline __.Using (disposable: #IDisposable, body) = Using.Invoke disposable body : '``Monad<'T>`` type MonadPlusStrictBuilder<'``monad<'t>``> () = diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index 61cb1d76f..216adaf8f 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -170,7 +170,7 @@ type Delay = #else - static member inline Invoke (source : unit -> '``Monad<'T>``) : '``Monad<'T>`` = + static member inline Invoke (source : unit -> '``Monad<'T>``) : '``Monad<'T>`` = Bind.Invoke (Return.Invoke ()) source #endif @@ -250,6 +250,10 @@ type TryWithS = static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWithS, _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_> static member inline Invoke (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = + let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, False) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) + + static member inline InvokeFromOtherMonad (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, True) call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) @@ -276,7 +280,7 @@ type TryFinally = let inline call (mthd: 'M, input: unit ->'I, _output: 'I, h: unit -> unit) = ((^M or ^I) : (static member TryFinally : (_*_)*_*_*_ -> _) (input, h), mthd, Unchecked.defaultof, False) call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) - static member inline InvokeOnInstance (source: '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = printfn "Try Finally default 8 for %A" typeof< ^``Monad<'T>``>; (^``Monad<'T>`` : (static member TryFinally : _*_->_) source, f) : '``Monad<'T>`` + static member inline InvokeOnInstance (source: '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = (^``Monad<'T>`` : (static member TryFinally : _*_->_) source, f) : '``Monad<'T>`` type TryFinally with static member inline TryFinally ((computation: unit -> '``Monad<'T>`` , compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: False) = TryFinally.InvokeOnInstance (computation ()) compensation: '``Monad<'T>`` diff --git a/src/FSharpPlus/Data/Cont.fs b/src/FSharpPlus/Data/Cont.fs index f88f5e8af..addbfd4f6 100644 --- a/src/FSharpPlus/Data/Cont.fs +++ b/src/FSharpPlus/Data/Cont.fs @@ -77,9 +77,9 @@ type Cont<'r,'t> with static member (>>=) (x, f: 'T->_) = Cont.bind f x : Cont<'R,'U> static member Delay f = Cont (fun k -> Cont.run (f ()) k) : Cont<'R,'T> - static member TryWith (Cont c, h) = Cont (fun k -> try (c k) with e -> Cont.run (h e) k) : Cont<'R,'T> - static member TryFinally (Cont c, h) = Cont (fun k -> try (c k) finally h ()) : Cont<'R,'T> - static member Using (resource, f: _ -> Cont<'R,'T>) = Cont.TryFinally (f resource, fun () -> dispose resource) + static member TryWith (c: unit -> Cont<_, _>, h) = Cont (fun k -> try (Cont.run (c ()) k) with e -> Cont.run (h e) k) : Cont<'R,'T> + static member TryFinally (c: unit -> Cont<_, _>, h) = Cont (fun k -> try (Cont.run (c ()) k) finally h ()) : Cont<'R,'T> + static member Using (resource, f: _ -> Cont<'R,'T>) = Cont.TryFinally ((fun () -> f resource), fun () -> dispose resource) [] static member CallCC (f: ('T -> Cont<'R,'U>) -> _) = Cont.callCC f : Cont<'R,'T> diff --git a/src/FSharpPlus/Data/Error.fs b/src/FSharpPlus/Data/Error.fs index 6e327e394..50e9710d0 100644 --- a/src/FSharpPlus/Data/Error.fs +++ b/src/FSharpPlus/Data/Error.fs @@ -126,10 +126,10 @@ type ResultT<'e, 'monad, 't> with static member inline (>>=) (x: ResultT<'E, 'Monad, 'T>, f: 'T -> ResultT<'E, 'Monad, 'U>) = ResultT.bind<'T, 'U, 'E, 'Monad, '``Monad>``, '``Monad>``> f x : ResultT<'E, 'Monad, 'U> - static member inline TryWith (source: ResultT<'E, 'Monad, 'T>, f: exn -> ResultT<'E, 'Monad, 'T>) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWith.Invoke (ResultT.run source) (ResultT.run << f)) - static member inline TryFinally (computation: ResultT<'E, 'Monad, 'T>, f) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> (TryFinally.Invoke (ResultT.run computation) f) + static member inline TryWith (source: unit -> ResultT<'E, 'Monad, 'T>, f: exn -> ResultT<'E, 'Monad, 'T>) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWithS.InvokeFromOtherMonad (fun () -> ResultT.run (source ())) (ResultT.run << f)) + static member inline TryFinally (computation: unit -> ResultT<'E, 'Monad, 'T>, f) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> (TryFinallyS.Invoke (fun () -> ResultT.run (computation ())) f) static member inline Using (resource, f: _ -> ResultT<'E, 'Monad, 'T>) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> (Using.Invoke resource (ResultT.run << f)) - static member inline Delay (body : unit -> ResultT<'E, 'Monad, 'T>) = Value ((Delay.Invoke (fun _ -> ResultT.run (body ()) : '``Monad>``)) |> box<'``Monad>``>) + static member inline Delay (body: unit -> ResultT<'E, 'Monad, 'T>) = Value ((Delay.Invoke (fun () -> ResultT.run (body ()) : '``Monad>``)) |> box<'``Monad>``>) [] @@ -161,8 +161,8 @@ type ResultT<'e, 'monad, 't> with static member inline Pass (m: ResultT<'E, '``MonadWriter<'Monoid>``, ('T * ('Monoid -> 'Monoid))>) : ResultT<'E, '``MonadWriter<'Monoid>``, 'T> = ResultTOperations.ResultT<'``MonadWriter<'Monoid, Result<'T, 'E>>``, _, _, _> ((ResultT.run m: '``MonadWriter<'Monoid, Result<('T * ('Monoid -> 'Monoid)), 'E>>``) >>= either (map Result<'T, 'E>.Ok << (pass: '``MonadWriter<'Monoid, ('T * ('Monoid -> 'Monoid))>`` -> '``MonadWriter<'Monoid, 'T>``) << (result: ('T * ('Monoid -> 'Monoid)) -> _)) (result << Result<'T, 'E>.Error)) - static member inline get_Get () : ResultT<'E, '``StateMonad<'S>``, 'S> = ResultT.lift<_, _, '``StateMonad<'S, 'S>``, '``StateMonad<'S, Result<'S, 'E>>``, '``StateMonad<'S>``> get - static member inline Put (x: 'S) : ResultT<'E, '``StateMonad<'S>``, unit> = x |> put |> ResultT.lift<_, _, '``StateMonad<'S, unit>``, '``StateMonad<'S, Result>``, '``StateMonad<'S>``> + static member inline get_Get () : ResultT<'E, '``MonadState<'S>``, 'S> = ResultT.lift<_, _, '``MonadState<'S, 'S>``, '``MonadState<'S, Result<'S, 'E>>``, '``MonadState<'S>``> get + static member inline Put (x: 'S) : ResultT<'E, '``MonadState<'S>``, unit> = x |> put |> ResultT.lift<_, _, '``MonadState<'S, unit>``, '``MonadState<'S, Result>``, '``MonadState<'S>``> @@ -259,10 +259,10 @@ type ChoiceT<'e, 'monad, 't> with static member inline (>>=) (x: ChoiceT<'E, 'Monad, 'T>, f: 'T -> ChoiceT<'E, 'Monad, 'U>) = ChoiceT.bind<'T, 'U, 'E, 'Monad, '``Monad>``, '``Monad>``> f x : ChoiceT<'E, 'Monad, 'U> - static member inline TryWith (source: ChoiceT<'E, 'Monad, 'T>, f: exn -> ChoiceT<'E, 'Monad, 'T>) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWith.Invoke (ChoiceT.run source) (ChoiceT.run << f)) - static member inline TryFinally (computation: ChoiceT<'E, 'Monad, 'T>, f) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> (TryFinally.Invoke (ChoiceT.run computation) f) + static member inline TryWith (source: unit -> ChoiceT<'E, 'Monad, 'T>, f: exn -> ChoiceT<'E, 'Monad, 'T>) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWithS.InvokeFromOtherMonad (fun () -> ChoiceT.run (source ())) (ChoiceT.run << f)) + static member inline TryFinally (computation: unit -> ChoiceT<'E, 'Monad, 'T>, f) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> (TryFinallyS.Invoke (fun () -> ChoiceT.run (computation ())) f) static member inline Using (resource, f: _ -> ChoiceT<'E, 'Monad, 'T>) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> (Using.Invoke resource (ChoiceT.run << f)) - static member inline Delay (body : unit -> ChoiceT<'E, 'Monad, 'T>) = Value ((Delay.Invoke (fun _ -> ChoiceT.run (body ()) : '``Monad>``)) |> box<'``Monad>``>) + static member inline Delay (body: unit -> ChoiceT<'E, 'Monad, 'T>) = Value ((Delay.Invoke (fun () -> ChoiceT.run (body ()) : '``Monad>``)) |> box<'``Monad>``>) [] @@ -294,7 +294,7 @@ type ChoiceT<'e, 'monad, 't> with static member inline Pass (m: ChoiceT<'E, '``MonadWriter<'Monoid>``, ('T * ('Monoid -> 'Monoid))>) : ChoiceT<'E, '``MonadWriter<'Monoid>``, 'T> = ChoiceTOperations.ChoiceT<'``MonadWriter<'Monoid, Choice<'T, 'E>>``, _, _, _> ((ChoiceT.run m: '``MonadWriter<'Monoid, Choice<('T * ('Monoid -> 'Monoid)), 'E>>``) >>= either (map Choice<'T, 'E>.Choice1Of2 << (pass: '``MonadWriter<'Monoid, ('T * ('Monoid -> 'Monoid))>`` -> '``MonadWriter<'Monoid, 'T>``) << (result: ('T * ('Monoid -> 'Monoid)) -> _)) (result << Choice<'T, 'E>.Choice2Of2)) - static member inline get_Get () : ChoiceT<'E, '``StateMonad<'S>``, 'S> = ChoiceT.lift<_, _, '``StateMonad<'S, 'S>``, '``StateMonad<'S, Choice<'S, 'E>>``, '``StateMonad<'S>``> get - static member inline Put (x: 'S) : ChoiceT<'E, '``StateMonad<'S>``, unit> = x |> put |> ChoiceT.lift<_, _, '``StateMonad<'S, unit>``, '``StateMonad<'S, Choice>``, '``StateMonad<'S>``> + static member inline get_Get () : ChoiceT<'E, '``MonadState<'S>``, 'S> = ChoiceT.lift<_, _, '``MonadState<'S, 'S>``, '``MonadState<'S, Choice<'S, 'E>>``, '``MonadState<'S>``> get + static member inline Put (x: 'S) : ChoiceT<'E, '``MonadState<'S>``, unit> = x |> put |> ChoiceT.lift<_, _, '``MonadState<'S, unit>``, '``MonadState<'S, Choice>``, '``MonadState<'S>``> #endif diff --git a/src/FSharpPlus/Data/List.fs b/src/FSharpPlus/Data/List.fs index 73325650a..77111b928 100644 --- a/src/FSharpPlus/Data/List.fs +++ b/src/FSharpPlus/Data/List.fs @@ -272,8 +272,8 @@ type ListT<'monad, 't> with static member inline get_Empty () : ListT<'Monad, 'T> = ListT.empty<_, _, '``Monad>``> () static member inline (<|>) (x: ListT<'Monad, 'T>, y: ListT<'Monad, 'T>) : ListT<'Monad, 'T> = ListT.concat<_, _, '``Monad>``> x y - static member inline TryWith (source: ListT<'Monad, 'T>, f: exn -> ListT<'Monad, 'T>) = ListT (TryWith.Invoke (ListT.unwrap source: '``Monad>``) (ListT.unwrap << f)) - static member inline TryFinally (computation: ListT<'Monad, 'T>, f) = ListT (TryFinally.Invoke (ListT.unwrap computation: '``Monad>``) f) + static member inline TryWith (source: unit -> ListT<'Monad, 'T>, f: exn -> ListT<'Monad, 'T>) = ListT (TryWithS.InvokeFromOtherMonad (fun () -> ListT.unwrap (source ()) : '``Monad>``) (ListT.unwrap << f)) + static member inline TryFinally (computation: unit -> ListT<'Monad, 'T>, f) = ListT (TryFinallyS.Invoke (fun () -> ListT.unwrap (computation ()) : '``Monad>``) f) static member inline Using (resource, f: _ -> ListT<'Monad, 'T>) = ListT (Using.Invoke resource (ListT.unwrap << f : 'R -> '``Monad>``)) static member inline Delay (body: unit -> ListT<'Monad, 'T>) : ListT<'Monad, 'T> = ListT (Delay.Invoke (fun () -> ListT.unwrap (body ()) : '``Monad>``)) diff --git a/src/FSharpPlus/Data/Option.fs b/src/FSharpPlus/Data/Option.fs index 1ee2fd78b..995bbd107 100644 --- a/src/FSharpPlus/Data/Option.fs +++ b/src/FSharpPlus/Data/Option.fs @@ -55,8 +55,8 @@ type OptionT<'``monad>``> with static member inline get_Empty () = OptionT <| result None : OptionT<'``MonadPlus``> static member inline (<|>) (OptionT x, OptionT y) = OptionT <| (x >>= (fun maybe_value -> match maybe_value with Some value -> result (Some value) | _ -> y)) : OptionT<'``MonadPlus``> - static member inline TryWith (source: OptionT<'``Monad>``>, f: exn -> OptionT<'``Monad>``>) = OptionT (TryWith.Invoke (OptionT.run source) (OptionT.run << f)) - static member inline TryFinally (computation: OptionT<'``Monad>``>, f) = OptionT (TryFinally.Invoke (OptionT.run computation) f) + static member inline TryWith (source: unit -> OptionT<'``Monad>``>, f: exn -> OptionT<'``Monad>``>) = OptionT (TryWithS.InvokeFromOtherMonad (fun () -> OptionT.run (source ())) (OptionT.run << f)) + static member inline TryFinally (computation: unit -> OptionT<'``Monad>``>, f) = OptionT (TryFinallyS.Invoke (fun () -> OptionT.run (computation ())) f) static member inline Using (resource, f: _ -> OptionT<'``Monad>``>) = OptionT (Using.Invoke resource (OptionT.run << f)) static member inline Delay (body : unit -> OptionT<'``Monad>``>) = OptionT (Delay.Invoke (fun _ -> OptionT.run (body ()))) : OptionT<'``Monad>``> diff --git a/src/FSharpPlus/Data/Reader.fs b/src/FSharpPlus/Data/Reader.fs index b11d16cd4..ca28eddc3 100644 --- a/src/FSharpPlus/Data/Reader.fs +++ b/src/FSharpPlus/Data/Reader.fs @@ -87,9 +87,9 @@ type Reader<'r,'t> with #endif - static member TryWith (Reader computation, h) = Reader (fun s -> try computation s with e -> Reader.run (h e) s) : Reader<'R,'T> - static member TryFinally (Reader computation, f) = Reader (fun s -> try computation s finally f ()) - static member Using (resource, f: _ -> Reader<'R,'T>) = Reader.TryFinally (f resource, fun () -> dispose resource) + static member TryWith (computation: unit -> Reader<_, _>, h) = Reader (fun s -> try (Reader.run (computation ())) s with e -> Reader.run (h e) s) : Reader<'R,'T> + static member TryFinally (computation: unit -> Reader<_, _>, f) = Reader (fun s -> try (Reader.run (computation ())) s finally f ()) + static member Using (resource, f: _ -> Reader<'R,'T>) = Reader.TryFinally ((fun () -> f resource), fun () -> dispose resource) static member Delay (body: unit->Reader<'R,'T>) = Reader (fun s -> Reader.run (body ()) s) : Reader<'R,'T> @@ -219,17 +219,17 @@ type ReaderT<'r, 'monad, 't> with [] static member inline Zip (x: ReaderT<'S, 'Monad, 'T>, y: ReaderT<'S, 'Monad, 'U>) = ReaderT.zip x y - static member inline TryWith (source: ReaderT<'R, 'Monad, 'T>, f: exn -> ReaderT<'R, 'Monad, 'T>) = - ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWith.InvokeFromOtherMonad (fun () -> (ReaderT.run source s : '``Monad<'T>``)) (fun x -> ReaderT.run (f x) s)) + static member inline TryWith (source: unit -> ReaderT<'R, 'Monad, 'T>, f: exn -> ReaderT<'R, 'Monad, 'T>) = + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWithS.InvokeFromOtherMonad (fun () -> ((ReaderT.run (source ()) s: '``Monad<'T>``))) (fun x -> ReaderT.run (f x) s)) - static member inline TryFinally (computation: ReaderT<'R, 'Monad, 'T>, f) = - ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinallyS.Invoke (fun () -> ReaderT.run computation s) f) + static member inline TryFinally (computation: unit -> ReaderT<'R, 'Monad, 'T>, f) = + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinallyS.Invoke (fun () -> ReaderT.run (computation ()) s) f) static member inline Using (resource, f: _ -> ReaderT<'R, 'Monad, 'T>) = ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> Using.Invoke resource (fun x -> ReaderT.run (f x) s)) - static member inline Delay (body : unit -> ReaderT<'R, 'Monad, 'T>) : ReaderT<'R, 'Monad, 'T> = - Value ((fun s -> Delay.Invoke (fun _ -> (ReaderT.run (body ()) s : '``Monad<'T>``) )) >> box<'``Monad<'T>``>) + static member inline Delay (body: unit -> ReaderT<'R, 'Monad, 'T>) : ReaderT<'R, 'Monad, 'T> = + Value ((fun s -> Delay.Invoke (fun () -> (ReaderT.run (body ()) s : '``Monad<'T>``))) >> box<'``Monad<'T>``>) [] static member inline Lift (m: '``Monad<'T>``) : ReaderT<'R, 'Monad, 'T> = ReaderT.lift m diff --git a/src/FSharpPlus/Data/Seq.fs b/src/FSharpPlus/Data/Seq.fs index d552d9056..4e8f27876 100644 --- a/src/FSharpPlus/Data/Seq.fs +++ b/src/FSharpPlus/Data/Seq.fs @@ -64,8 +64,8 @@ type SeqT<'``monad>``> with static member inline get_Empty () = SeqT <| result Seq.empty : SeqT<'``MonadPlus``> static member inline (<|>) (SeqT x, SeqT y) = SeqT <| (x >>= (fun a -> y >>= (fun b -> result ((Seq.append:seq<_>->seq<_>->_) a b)))) : SeqT<'``MonadPlus``> - static member inline TryWith (source: SeqT<'``Monad>``>, f: exn -> SeqT<'``Monad>``>) = SeqT (TryWith.Invoke (SeqT.run source) (SeqT.run << f)) - static member inline TryFinally (computation: SeqT<'``Monad>``>, f) = SeqT (TryFinally.Invoke (SeqT.run computation) f) + static member inline TryWith (source: unit -> SeqT<'``Monad>``>, f: exn -> SeqT<'``Monad>``>) = SeqT (TryWithS.InvokeFromOtherMonad (fun () -> SeqT.run (source ())) (SeqT.run << f)) + static member inline TryFinally (computation: unit -> SeqT<'``Monad>``>, f) = SeqT (TryFinallyS.Invoke (fun () -> SeqT.run (computation ())) f) static member inline Using (resource, f: _ -> SeqT<'``Monad>``>) = SeqT (Using.Invoke resource (SeqT.run << f)) static member inline Delay (body : unit -> SeqT<'``Monad>``>) = SeqT (Delay.Invoke (fun _ -> SeqT.run (body ()))) : SeqT<'``Monad>``> diff --git a/src/FSharpPlus/Data/State.fs b/src/FSharpPlus/Data/State.fs index c7af6f0e9..b85fdbeb4 100644 --- a/src/FSharpPlus/Data/State.fs +++ b/src/FSharpPlus/Data/State.fs @@ -93,10 +93,10 @@ type State<'s,'t> with static member Zip (x, y) = State.zip x y #endif - static member TryWith (State computation, h) = State (fun s -> try computation s with e -> State.run (h e) s) : State<'S,'T> - static member TryFinally (State computation, f) = State (fun s -> try computation s finally f ()) : State<'S,'T> - static member Using (resource, f: _ -> State<'S,'T>) = State.TryFinally (f resource, fun () -> dispose resource) - static member Delay (body: unit->State<'S,'T>) = State (fun s -> State.run (body ()) s) : State<'S,'T> + static member TryWith (computation: unit -> State<_, _>, h) = State (fun s -> try (State.run (computation ())) s with e -> State.run (h e) s) : State<'S, 'T> + static member TryFinally (computation: unit -> State<_, _>, f) = State (fun s -> try (State.run (computation ())) s finally f ()) : State<'S, 'T> + static member Using (resource, f: _ -> State<'S,'T>) = State.TryFinally ((fun () -> f resource), fun () -> dispose resource) + static member Delay (body: unit -> State<'S,'T>) = State (fun s -> State.run (body ()) s) : State<'S, 'T> #if !FABLE_COMPILER || FABLE_COMPILER_3 @@ -161,7 +161,7 @@ module StateT = let inline map3<'T, 'U, 'V, 'W, 'S, .. > (f: 'T -> 'U -> 'V -> 'W) (StateT (x: 'S -> '``Monad<'T * 'S>``) : StateT<'S, 'Monad, 'T>) (StateT (y: 'S -> '``Monad<'U * 'S>``) : StateT<'S, 'Monad, 'U>) (StateT (z: 'S -> '``Monad<'V * 'S>``): StateT<'S, 'Monad, 'V>) : StateT<'S, 'Monad, 'W> = StateT (fun s -> (x s: '``Monad<'T * 'S>``) >>= fun (g, s1) -> (y s1: '``Monad<'U * 'S>``) >>= fun (h, s2) -> (z s2: '``Monad<'V * 'S>``) >>= fun (i, s3: 'S) -> (result (f g h i, s3) : '``Monad<'W * 'S>``)) - let inline apply<'T, 'U, 'S, .. > (StateT (f: 'S -> '``Monad<('T -> 'U) * 'S>``) : StateT<'S,'Monad,('T -> 'U)>) (StateT a: StateT<'S,'Monad,'T>) : StateT<'S, 'Monad, 'U> = + let inline apply<'T, 'U, 'S, .. > (StateT (f: 'S -> '``Monad<('T -> 'U) * 'S>``) : StateT<'S, 'Monad, ('T -> 'U)>) (StateT a: StateT<'S, 'Monad,'T>) : StateT<'S, 'Monad, 'U> = StateT (fun s -> f s >>= fun (g, t) -> (Map.Invoke (fun (z: 'T, u: 'S) -> ((g z: 'U), u)) (a t: '``Monad<'T * 'S>``) : '``Monad<'U * 'S>``)) // /// Zips two StateTs into one. @@ -233,17 +233,17 @@ type StateT<'s, 'monad, 't> with [] static member inline Zip (x: StateT<'S, 'Monad, 'T>, y: StateT<'S, 'Monad, 'U>) = StateT.zip x y - static member inline TryWith (source: StateT<'S, 'Monad, 'T>, f: exn -> StateT<'S, 'Monad, 'T>) = - StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWith.InvokeFromOtherMonad (fun () -> (StateT.run source s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) + static member inline TryWith (source: unit -> StateT<'S, 'Monad, 'T>, f: exn -> StateT<'S, 'Monad, 'T>) = + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWithS.InvokeFromOtherMonad (fun () -> (StateT.run (source ()) s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) - static member inline TryFinally (computation: StateT<'S,'Monad,'T>, f) = - StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinallyS.Invoke (fun () -> StateT.run computation s) f) + static member inline TryFinally (computation: unit -> StateT<'S,'Monad,'T>, f) = + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinallyS.Invoke (fun () -> StateT.run (computation ()) s) f) static member inline Using (resource: 'S, f: _ -> StateT<'S,'Monad,'T>) = StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> Using.Invoke resource (fun x -> StateT.run (f x) s)) - static member inline Delay (body: unit -> StateT<'S, 'Monad, 'T>) = - Value ((fun s -> Delay.Invoke (fun _ -> (StateT.run (body ()) s: '``Monad<'T * 'S>``) )) >> box<'``Monad<'T * 'S>``>) : StateT<'S, 'Monad, 'T> + static member inline Delay (body: unit -> StateT<'S, 'Monad, 'T>) : StateT<'S, 'Monad, 'T> = + Value ((fun s -> Delay.Invoke (fun () -> (StateT.run (body ()) s: '``Monad<'T * 'S>``))) >> box<'``Monad<'T * 'S>``>) [] diff --git a/src/FSharpPlus/Data/Writer.fs b/src/FSharpPlus/Data/Writer.fs index c52ecd4ae..b2769d4bf 100644 --- a/src/FSharpPlus/Data/Writer.fs +++ b/src/FSharpPlus/Data/Writer.fs @@ -171,7 +171,7 @@ type WriterT<'monoid, 'monad, 't> with else Unchecked.defaultof<_> Value (result (x, getZero ()) : '``Monad<'T * 'Monoid>``) : WriterT<'Monoid,'Monad,'T> - // [] + [] static member inline Map (x: WriterT<'Monoid, 'Monad, 'T>, f: 'T -> 'U) = WriterT.map f x : WriterT<'Monoid, 'Monad, 'U> /// Lifts a function into a WriterT. Same as map. @@ -180,11 +180,11 @@ type WriterT<'monoid, 'monad, 't> with /// Functor static member inline () (f: 'T -> 'U, x: WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'U> = WriterT.map<_, _, _, 'Monad, '``Monad<'T * 'Monoid>``, '``Monad<'U * 'Monoid>``> f x - // [] + [] static member inline Lift2 (f: 'T -> 'U -> 'V, x: WriterT<'Monoid, 'Monad, 'T>, y: WriterT<'Monoid, 'Monad, 'U>) : WriterT<'Monoid, 'Monad, 'V> = WriterT.map2<'T, 'U, 'V, 'Monoid, 'Monad, '``Monad<'T * 'Monoid>``, '``Monad<'U * 'Monoid>``, '``Monad<'V * 'Monoid>``> f x y - // [] + [] static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, x: WriterT<'Monoid, 'Monad, 'T>, y: WriterT<'Monoid, 'Monad, 'U>, z: WriterT<'Monoid, 'Monad, 'V>) : WriterT<'Monoid, 'Monad, 'W> = WriterT.map3<'T, 'U, 'V, 'W, 'Monoid, 'Monad, '``Monad<'T * 'Monoid>``, '``Monad<'U * 'Monoid>``, '``Monad<'V * 'Monoid>``, '``Monad<'W * 'Monoid>``> f x y z @@ -218,13 +218,13 @@ type WriterT<'monoid, 'monad, 't> with static member inline (<|>) (WriterT (m: '``MonadPlus<'T * 'S>``), WriterT (n: '``MonadPlus<'T * 'S>``)) : WriterT<'Monoid, 'MonadPlus, 'T> = WriterTOperations.WriterT (m <|> n) - static member inline TryWith (source: WriterT<'Monoid, 'Monad, 'T>, f: exn -> WriterT<'Monoid, 'Monad, 'T>) = - WriterTOperations.WriterT< '``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryWith.Invoke (WriterT.run source) (WriterT.run << f)) + static member inline TryWith (source: unit -> WriterT<'Monoid, 'Monad, 'T>, f: exn -> WriterT<'Monoid, 'Monad, 'T>) = + WriterTOperations.WriterT< '``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryWithS.InvokeFromOtherMonad (fun () -> WriterT.run (source ())) (WriterT.run << f)) - static member inline TryFinally (computation: WriterT<'Monoid, 'Monad, 'T>, f) = WriterTOperations.WriterT<'``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryFinally.Invoke (WriterT.run computation) f) + static member inline TryFinally (computation: unit -> WriterT<'Monoid, 'Monad, 'T>, f) = WriterTOperations.WriterT<'``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryFinallyS.Invoke (fun () -> WriterT.run (computation ())) f) static member inline Using (resource, f: _ -> WriterT<'Monoid, 'Monad, 'T>) = WriterTOperations.WriterT<'``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (Using.Invoke resource (WriterT.run << f)) - static member inline Delay (body : unit -> WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'T> = - Value ((Delay.Invoke (fun _ -> WriterT.run (body ()) : '``Monad<'T * 'S>``)) |> box<'``Monad<'T * 'S>``>) + static member inline Delay (body: unit -> WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'T> = + Value ((Delay.Invoke (fun () -> WriterT.run (body ()) : '``Monad<'T * 'S>``)) |> box<'``Monad<'T * 'S>``>) static member inline Tell (w: 'Monoid) : WriterT<'Monoid, 'Monad, unit> = @@ -245,7 +245,7 @@ type WriterT<'monoid, 'monad, 't> with WriterT.lift<'T, '``MonadError<'E, 'T>``, '``MonadError<'E, 'T * ^Monoid>``, '``MonadError<'E>``, 'Monoid> (throw x : '``MonadError<'E, 'T>``) static member inline Catch (m: WriterT<'Monoid, '``MonadError<'E1>``, 'T>, h: 'E1 -> WriterT<'Monoid, '``MonadError<'E2>``, 'T>) : WriterT<'Monoid, '``MonadError<'E2>``, 'T> = - WriterTOperations.WriterT (catch (WriterT.run m : '``MonadError<'E1, ('T * 'Monoid)>``) (WriterT.run << h) : '``MonadError<'E2, ('T * 'Monoid)>``) + WriterTOperations.WriterT (catch (WriterT.run m: '``MonadError<'E1, ('T * 'Monoid)>``) (WriterT.run << h) : '``MonadError<'E2, ('T * 'Monoid)>``) // 'Monad : MonadCont<'R, 'Monad> static member inline CallCC (f: ('T -> WriterT<'Monoid, 'Monad, 'U>) -> WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'T> = @@ -256,10 +256,10 @@ type WriterT<'monoid, 'monad, 't> with static member inline Local (WriterT m : WriterT<'Monoid, '``MonadReader<'R2>``, 'T>, f: 'R1 -> 'R2) : WriterT<'Monoid, '``MonadReader<'R1>``, 'T> = WriterTOperations.WriterT (local f (m: '``MonadReader<'R2, 'T * 'Monoid>``) : '``MonadReader<'R1, 'T * 'Monoid>``) - static member inline get_Get () : WriterT<'Monoid, '``StateMonad<'S>``, 'S> = - WriterT.lift<_, '``StateMonad<'S, 'S>``, '``StateMonad<'S, 'S * 'Monoid>``, '``StateMonad<'S>``, _> get + static member inline get_Get () : WriterT<'Monoid, '``MonadState<'S>``, 'S> = + WriterT.lift<_, '``MonadState<'S, 'S>``, '``MonadState<'S, 'S * 'Monoid>``, '``MonadState<'S>``, _> get - static member inline Put (x: 'S) : WriterT<'Monoid, '``StateMonad<'S>``, unit> = - x |> put |> WriterT.lift<_, '``StateMonad<'S, unit>``, '``StateMonad<'S, (unit * 'Monoid)>``, '``StateMonad<'S>``, _> + static member inline Put (x: 'S) : WriterT<'Monoid, '``MonadState<'S>``, unit> = + x |> put |> WriterT.lift<_, '``MonadState<'S, unit>``, '``MonadState<'S, (unit * 'Monoid)>``, '``MonadState<'S>``, _> #endif \ No newline at end of file From 18072da41dccfdb4ed9af12d814ebacc92c3328f Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 20 Jul 2022 18:10:17 +0200 Subject: [PATCH 27/33] Remove #exn type param --- src/FSharpPlus/Control/Monad.fs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index 216adaf8f..99935b0cb 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -215,15 +215,15 @@ type TryWith = static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWith , _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_> static member inline Invoke (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, False) + let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, False) call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) static member inline InvokeFromOtherMonad (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, True) + let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, True) call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) static member inline InvokeForWhile (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, While) + let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, While) call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) @@ -250,15 +250,15 @@ type TryWithS = static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWithS, _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_> static member inline Invoke (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, False) + let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, False) call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) static member inline InvokeFromOtherMonad (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, True) + let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, True) call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) static member inline InvokeForWhile (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*_*_*_ -> _) input, h, mthd, While) + let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, While) call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) From 772ac6d43b820b3944a1a45a73b91d128473c22d Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 20 Jul 2022 22:01:13 +0200 Subject: [PATCH 28/33] Add ambiguity for each default overload --- src/FSharpPlus/Control/Monad.fs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index 99935b0cb..5f057be1a 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -231,11 +231,18 @@ type TryWithS = inherit Default1 [] - static member TryWith (_: unit -> '``Monad<'T>``, _: exn -> '``Monad<'T>``, _: Default3, _defaults: While) = raise Internals.Errors.exnUnreachable + static member TryWith (_: unit -> '``Monad<'T>`` when '``Monad<'T>`` : not struct, _: exn -> '``Monad<'T>``, _: Default4, _defaults: While) = raise Internals.Errors.exnUnreachable + [] + static member TryWith (_: unit -> '``Monad<'T>`` when '``Monad<'T>`` : struct, _: exn -> '``Monad<'T>``, _: Default3, _defaults: While) = raise Internals.Errors.exnUnreachable [] - static member TryWith (_: unit -> '``Monad<'T>``, _: exn -> '``Monad<'T>``, _: Default3, _defaults: False) = raise Internals.Errors.exnUnreachable - static member TryWith (computation: unit -> '``Monad<'T>``, catchHandler: exn -> '``Monad<'T>``, _: Default3, _defaults: True ) = try computation () with e -> catchHandler e + static member TryWith (_: unit -> '``Monad<'T>`` when '``Monad<'T>`` : not struct, _: exn -> '``Monad<'T>``, _: Default4, _defaults: False) = raise Internals.Errors.exnUnreachable + [] + static member TryWith (_: unit -> '``Monad<'T>`` when '``Monad<'T>`` : struct, _: exn -> '``Monad<'T>``, _: Default3, _defaults: False) = raise Internals.Errors.exnUnreachable + + static member TryWith (computation: unit -> '``Monad<'T>`` when '``Monad<'T>`` : not struct, catchHandler: exn -> '``Monad<'T>``, _: Default4, _defaults: True ) = try computation () with e -> catchHandler e + static member TryWith (computation: unit -> '``Monad<'T>`` when '``Monad<'T>`` : struct, catchHandler: exn -> '``Monad<'T>``, _: Default3, _defaults: True ) = try computation () with e -> catchHandler e + static member inline TryWith (computation: unit -> '``Monad<'T>``, catchHandler: exn -> '``Monad<'T>``, _: Default1, _) = (^``Monad<'T>`` : (static member TryWith : _*_->_) computation, catchHandler) : '``Monad<'T>`` static member inline TryWith (_: unit -> ^t when ^t: null and ^t: struct, _ : exn -> 't , _: Default1, _) = () From bc55b44596220de2b0a6eaaff7dd6ad7a36348f9 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Fri, 22 Jul 2022 11:06:40 +0200 Subject: [PATCH 29/33] Unify return type in TryWith --- src/FSharpPlus/Control/Monad.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index 5f057be1a..3578d75ac 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -257,15 +257,15 @@ type TryWithS = static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWithS, _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_> static member inline Invoke (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, False) + let inline call (mthd: 'M, input: unit -> 'I, _output: 'I, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> 'I) input, h, mthd, False) call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) static member inline InvokeFromOtherMonad (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, True) + let inline call (mthd: 'M, input: unit -> 'I, _output: 'I, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> 'I) input, h, mthd, True) call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) static member inline InvokeForWhile (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, While) + let inline call (mthd: 'M, input: unit -> 'I, _output: 'I, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> 'I) input, h, mthd, While) call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) From 860ddc4ea926f4727d41fdcd27a716b1a49ec4f2 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 24 Jul 2022 18:03:24 +0200 Subject: [PATCH 30/33] Clean up try-blocks design --- src/FSharpPlus/Builders.fs | 12 ++-- src/FSharpPlus/Control/Monad.fs | 97 +++++++------------------------ src/FSharpPlus/Data/Error.fs | 8 +-- src/FSharpPlus/Data/List.fs | 4 +- src/FSharpPlus/Data/Option.fs | 4 +- src/FSharpPlus/Data/Reader.fs | 4 +- src/FSharpPlus/Data/Seq.fs | 4 +- src/FSharpPlus/Data/State.fs | 4 +- src/FSharpPlus/Data/Writer.fs | 4 +- tests/FSharpPlus.Tests/General.fs | 4 +- 10 files changed, 45 insertions(+), 100 deletions(-) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 1336efeb7..02783e572 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -69,8 +69,8 @@ module GenericBuilders = inherit Builder<'``monad<'t>``> () member __.Delay expr = expr : unit -> '``Monad<'T>`` member __.Run f = f () : '``monad<'t>`` - member inline __.TryWith (expr, handler) = TryWithS.InvokeFromOtherMonad expr handler : '``Monad<'T>`` - member inline __.TryFinally (expr, compensation) = TryFinallyS.Invoke expr compensation : '``Monad<'T>`` + member inline __.TryWith (expr, handler) = TryWith.Invoke expr handler : '``Monad<'T>`` + member inline __.TryFinally (expr, compensation) = TryFinally.Invoke expr compensation : '``Monad<'T>`` member inline __.Using (disposable: #IDisposable, body) = Using.Invoke disposable body @@ -78,8 +78,8 @@ module GenericBuilders = inherit Builder<'``monad<'t>``> () member inline __.Delay (expr: _->'``Monad<'T>``) = Delay.Invoke expr : '``Monad<'T>`` member __.Run f = f : '``monad<'t>`` - member inline __.TryWith (expr, handler ) = TryWithS.Invoke (fun () -> expr) handler : '``Monad<'T>`` - member inline __.TryFinally (expr, compensation) = TryFinallyS.Invoke (fun () -> expr) compensation : '``Monad<'T>`` + member inline __.TryWith (expr, handler ) = TryWith.InvokeFromDelayedCE (fun () -> expr) handler : '``Monad<'T>`` + member inline __.TryFinally (expr, compensation) = TryFinally.Invoke (fun () -> expr) compensation : '``Monad<'T>`` member inline __.Using (disposable: #IDisposable, body) = Using.Invoke disposable body : '``Monad<'T>`` type MonadPlusStrictBuilder<'``monad<'t>``> () = @@ -126,7 +126,7 @@ module GenericBuilders = member inline this.While (guard, body: '``MonadPlus<'T>``) : '``MonadPlus<'T>`` = // Check the type is lazy, otherwise display a warning. - let __ () = TryWith.InvokeForWhile (Unchecked.defaultof<'``MonadPlus<'T>``>) (fun (_: exn) -> Unchecked.defaultof<'``MonadPlus<'T>``>) : '``MonadPlus<'T>`` + let __ () = TryWith.InvokeFromWhile (Unchecked.defaultof<'``MonadPlus<'T>``>) (fun (_: exn) -> Unchecked.defaultof<'``MonadPlus<'T>``>) : '``MonadPlus<'T>`` this.WhileImpl (guard, body) @@ -166,7 +166,7 @@ module GenericBuilders = member inline this.While (guard, body: '``Monad``) : '``Monad`` = // Check the type is lazy, otherwise display a warning. - let __ () = TryWith.InvokeForWhile (Unchecked.defaultof<'``Monad``>) (fun (_: exn) -> Unchecked.defaultof<'``Monad``>) : '``Monad`` + let __ () = TryWith.InvokeFromWhile (Unchecked.defaultof<'``Monad``>) (fun (_: exn) -> Unchecked.defaultof<'``Monad``>) : '``Monad`` this.WhileImpl (guard, body) member inline this.For (p: #seq<'T>, rest: 'T->'``Monad``) : '``Monad``= diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs index 3578d75ac..52046cb4a 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -195,41 +195,6 @@ open TryBlock type TryWith = inherit Default1 - [] - static member TryWith (_: unit -> '``Monad<'T>``, _: exn -> '``Monad<'T>``, _: Default3, _defaults: While) = raise Internals.Errors.exnUnreachable - - [] - static member TryWith (_: unit -> '``Monad<'T>``, _: exn -> '``Monad<'T>``, _: Default3, _defaults: False) = raise Internals.Errors.exnUnreachable - static member TryWith (computation: unit -> '``Monad<'T>``, catchHandler: exn -> '``Monad<'T>``, _: Default3, _defaults: True ) = try computation () with e -> catchHandler e - - static member inline TryWith (computation: unit -> '``Monad<'T>``, catchHandler: exn -> '``Monad<'T>``, _: Default1, _) = (^``Monad<'T>`` : (static member TryWith : _*_->_) computation (), catchHandler) : '``Monad<'T>`` - static member inline TryWith (_: unit -> ^t when ^t: null and ^t: struct, _ : exn -> 't , _: Default1, _) = () - - static member TryWith (computation: unit -> seq<_> , catchHandler: exn -> seq<_> , _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) - static member TryWith (computation: unit -> NonEmptySeq<_>, catchHandler: exn -> NonEmptySeq<_>, _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) |> NonEmptySeq.unsafeOfSeq - static member TryWith (computation: unit -> 'R -> _ , catchHandler: exn -> 'R -> _ , _: Default2, _) = (fun s -> try (computation ()) s with e -> catchHandler e s) : 'R ->_ - static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWith , _) = async.TryWith ((computation ()), catchHandler) - #if !FABLE_COMPILER - static member TryWith (computation: unit -> Task<_> , catchHandler: exn -> Task<_> , _: TryWith, True) = Task.tryWith computation catchHandler - #endif - static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWith , _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_> - - static member inline Invoke (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, False) - call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) - - static member inline InvokeFromOtherMonad (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, True) - call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) - - static member inline InvokeForWhile (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'R, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> _) input, h, mthd, While) - call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) - - -type TryWithS = - inherit Default1 - [] static member TryWith (_: unit -> '``Monad<'T>`` when '``Monad<'T>`` : not struct, _: exn -> '``Monad<'T>``, _: Default4, _defaults: While) = raise Internals.Errors.exnUnreachable [] @@ -250,69 +215,49 @@ type TryWithS = static member TryWith (computation: unit -> seq<_> , catchHandler: exn -> seq<_> , _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) static member TryWith (computation: unit -> NonEmptySeq<_>, catchHandler: exn -> NonEmptySeq<_>, _: Default2, _) = seq (try (Seq.toArray (computation ())) with e -> Seq.toArray (catchHandler e)) |> NonEmptySeq.unsafeOfSeq static member TryWith (computation: unit -> 'R -> _ , catchHandler: exn -> 'R -> _ , _: Default2, _) = (fun s -> try (computation ()) s with e -> catchHandler e s) : 'R ->_ - static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWithS, _) = async.TryWith ((computation ()), catchHandler) + static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWith, _) = async.TryWith ((computation ()), catchHandler) #if !FABLE_COMPILER - static member TryWith (computation: unit -> Task<_> , catchHandler: exn -> Task<_> , _: TryWithS, True) = Task.tryWith computation catchHandler + static member TryWith (computation: unit -> Task<_> , catchHandler: exn -> Task<_> , _: TryWith, True) = Task.tryWith computation catchHandler #endif - static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWithS, _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_> + static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWith, _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_> static member inline Invoke (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit -> 'I, _output: 'I, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> 'I) input, h, mthd, False) - call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) - - static member inline InvokeFromOtherMonad (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = let inline call (mthd: 'M, input: unit -> 'I, _output: 'I, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> 'I) input, h, mthd, True) - call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) - static member inline InvokeForWhile (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = + /// Entry point for F#+ delayed builders, it doesn't consider defaults for try-with. + /// A compiler error is displayed if an implementation is not found. + static member inline InvokeFromDelayedCE (source: unit ->'``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = + let inline call (mthd: 'M, input: unit -> 'I, _output: 'I, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> 'I) input, h, mthd, False) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) + + /// Entry point for F#+ delayed builders from While method + /// It doesn't consider defaults for TryWith, an error message is displayed if a suitable TryWith implementation is not found. + static member inline InvokeFromWhile (source: '``Monad<'T>``) (f: exn -> '``Monad<'T>``) : '``Monad<'T>`` = let inline call (mthd: 'M, input: unit -> 'I, _output: 'I, h: exn -> 'I) = ((^M or ^I) : (static member TryWith : _*(exn -> _)*_*_ -> 'I) input, h, mthd, While) - call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) + call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) type TryFinally = inherit Default1 - static member TryFinally ((computation: unit -> seq<_> , compensation: unit -> unit), _: Default2, _, _) = seq (try (Seq.toArray (computation ())) finally compensation ()) - static member TryFinally ((computation: unit -> NonEmptySeq<_>, compensation: unit -> unit), _: Default2, _, _) = seq (try (Seq.toArray (computation ())) finally compensation ()) |> NonEmptySeq.unsafeOfSeq - [] static member TryFinally ((_: unit -> 'R -> _ , _: unit -> unit), _: Default2 , _, _defaults: False) = raise Internals.Errors.exnUnreachable - static member TryFinally ((computation: unit -> 'R -> _ , compensation: unit -> unit), _: Default2 , _, _defaults: True ) = fun s -> try computation () s finally compensation () static member TryFinally ((computation: unit -> Id<_> , compensation: unit -> unit), _: TryFinally, _, _) = try computation () finally compensation () - static member TryFinally ((computation: unit -> Async<_>, compensation: unit -> unit), _: TryFinally, _, _) = async.TryFinally (computation (), compensation) : Async<_> - static member TryFinally ((computation: unit -> Lazy<_> , compensation: unit -> unit), _: TryFinally, _, _) = lazy (try (computation ()).Force () finally compensation ()) : Lazy<_> - - static member inline Invoke (source: '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit ->'I, _output: 'I, h: unit -> unit) = ((^M or ^I) : (static member TryFinally : (_*_)*_*_*_ -> _) (input, h), mthd, Unchecked.defaultof, False) - call (Unchecked.defaultof, (fun () -> source), Unchecked.defaultof<'``Monad<'T>``>, f) - - static member inline InvokeOnInstance (source: '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = (^``Monad<'T>`` : (static member TryFinally : _*_->_) source, f) : '``Monad<'T>`` - -type TryFinally with - static member inline TryFinally ((computation: unit -> '``Monad<'T>`` , compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: False) = TryFinally.InvokeOnInstance (computation ()) compensation: '``Monad<'T>`` - static member inline TryFinally (( _ : unit -> ^t when ^t:null and ^t:struct , _ : unit -> unit), _: Default1, _: TryFinally , _) = () - -type TryFinallyS = - inherit Default1 - - [] - static member TryFinally ((_: unit -> 'R -> _ , _: unit -> unit), _: Default2 , _, _defaults: False) = raise Internals.Errors.exnUnreachable - - static member TryFinally ((computation: unit -> Id<_> , compensation: unit -> unit), _: TryFinallyS, _, _) = try computation () finally compensation () #if !FABLE_COMPILER - static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinallyS, _, True) = Task.tryFinally computation compensation : Task<_> + static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinally, _, True) = Task.tryFinally computation compensation : Task<_> #else - static member TryFinally ((computation: unit -> Tuple<_> , compensation: unit -> unit), _: TryFinallyS, _, True) = try computation () finally compensation () + static member TryFinally ((computation: unit -> Tuple<_> , compensation: unit -> unit), _: TryFinally, _, True) = try computation () finally compensation () #endif static member inline Invoke (source: unit ->'``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = - let inline call (mthd: 'M, input: unit ->'I, _output: 'I, h: unit -> unit) = ((^M or ^I) : (static member TryFinally : (_*_)*_*_*_ -> _) (input, h), mthd, Unchecked.defaultof, True) - call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) + let inline call (mthd: 'M, input: unit ->'I, _output: 'I, h: unit -> unit) = ((^M or ^I) : (static member TryFinally : (_*_)*_*_*_ -> _) (input, h), mthd, Unchecked.defaultof, True) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) static member inline InvokeOnInstance (source: unit -> '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = (^``Monad<'T>`` : (static member TryFinally : _*_->_) source, f) : '``Monad<'T>`` -type TryFinallyS with +type TryFinally with [] static member TryFinally ((_: unit -> '``Monad<'T>`` when '``Monad<'T>`` : struct, _: unit -> unit), _: Default3, _: Default2, _defaults: False) = raise Internals.Errors.exnUnreachable @@ -323,7 +268,7 @@ type TryFinallyS with static member TryFinally ((computation: unit -> '``Monad<'T>`` when '``Monad<'T>`` : struct, compensation: unit -> unit), _: Default3, _: Default2, _defaults: True) = try computation () finally compensation () static member TryFinally ((computation: unit -> '``Monad<'T>`` when '``Monad<'T>`` : not struct, compensation: unit -> unit), _: Default3, _: Default1, _defaults: True) = try computation () finally compensation () - static member inline TryFinally ((computation: unit -> '``Monad<'T>`` , compensation: unit -> unit), _: Default1, _: TryFinallyS, _defaults: _) = TryFinallyS.InvokeOnInstance computation compensation: '``Monad<'T>`` + static member inline TryFinally ((computation: unit -> '``Monad<'T>`` , compensation: unit -> unit), _: Default1, _: TryFinally, _defaults: _) = TryFinally.InvokeOnInstance computation compensation: '``Monad<'T>`` static member inline TryFinally (( _: unit -> ^t when ^t : null and ^t : struct , _ : unit -> unit), _: Default1, _ , _ ) = () @@ -349,7 +294,7 @@ type Using = type Using with static member inline Using (resource: 'T when 'T :> IDisposable, body: 'T -> '``Monad<'U>`` when '``Monad<'U>``: struct , _: Default3) = using resource body static member inline Using (resource: 'T when 'T :> IDisposable, body: 'T -> '``Monad<'U>`` when '``Monad<'U>``: not struct , _: Default2) = using resource body - static member inline Using (resource: 'T when 'T :> IDisposable, body: 'T -> '``Monad<'U>`` , _: Default1) = TryFinally.InvokeOnInstance (body resource) (fun () -> if not (isNull (box resource)) then resource.Dispose ()) : '``Monad<'U>`` + static member inline Using (resource: 'T when 'T :> IDisposable, body: 'T -> '``Monad<'U>`` , _: Default1) = TryFinally.InvokeOnInstance (fun () -> body resource) (fun () -> if not (isNull (box resource)) then resource.Dispose ()) : '``Monad<'U>`` static member inline Using (resource: 'T when 'T :> IDisposable, body: 'T -> '``Monad<'U>`` , _: Using ) = Using.InvokeOnInstance resource body : '``Monad<'U>`` static member inline Using (_ , _ : 'a -> ^t when ^t : null and ^t: struct , _: Using ) = () diff --git a/src/FSharpPlus/Data/Error.fs b/src/FSharpPlus/Data/Error.fs index 50e9710d0..c90200105 100644 --- a/src/FSharpPlus/Data/Error.fs +++ b/src/FSharpPlus/Data/Error.fs @@ -126,8 +126,8 @@ type ResultT<'e, 'monad, 't> with static member inline (>>=) (x: ResultT<'E, 'Monad, 'T>, f: 'T -> ResultT<'E, 'Monad, 'U>) = ResultT.bind<'T, 'U, 'E, 'Monad, '``Monad>``, '``Monad>``> f x : ResultT<'E, 'Monad, 'U> - static member inline TryWith (source: unit -> ResultT<'E, 'Monad, 'T>, f: exn -> ResultT<'E, 'Monad, 'T>) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWithS.InvokeFromOtherMonad (fun () -> ResultT.run (source ())) (ResultT.run << f)) - static member inline TryFinally (computation: unit -> ResultT<'E, 'Monad, 'T>, f) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> (TryFinallyS.Invoke (fun () -> ResultT.run (computation ())) f) + static member inline TryWith (source: unit -> ResultT<'E, 'Monad, 'T>, f: exn -> ResultT<'E, 'Monad, 'T>) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWith.Invoke (fun () -> ResultT.run (source ())) (ResultT.run << f)) + static member inline TryFinally (computation: unit -> ResultT<'E, 'Monad, 'T>, f) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> (TryFinally.Invoke (fun () -> ResultT.run (computation ())) f) static member inline Using (resource, f: _ -> ResultT<'E, 'Monad, 'T>) = ResultTOperations.ResultT< '``Monad>``, 'Monad, 'E, 'T> (Using.Invoke resource (ResultT.run << f)) static member inline Delay (body: unit -> ResultT<'E, 'Monad, 'T>) = Value ((Delay.Invoke (fun () -> ResultT.run (body ()) : '``Monad>``)) |> box<'``Monad>``>) @@ -259,8 +259,8 @@ type ChoiceT<'e, 'monad, 't> with static member inline (>>=) (x: ChoiceT<'E, 'Monad, 'T>, f: 'T -> ChoiceT<'E, 'Monad, 'U>) = ChoiceT.bind<'T, 'U, 'E, 'Monad, '``Monad>``, '``Monad>``> f x : ChoiceT<'E, 'Monad, 'U> - static member inline TryWith (source: unit -> ChoiceT<'E, 'Monad, 'T>, f: exn -> ChoiceT<'E, 'Monad, 'T>) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWithS.InvokeFromOtherMonad (fun () -> ChoiceT.run (source ())) (ChoiceT.run << f)) - static member inline TryFinally (computation: unit -> ChoiceT<'E, 'Monad, 'T>, f) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> (TryFinallyS.Invoke (fun () -> ChoiceT.run (computation ())) f) + static member inline TryWith (source: unit -> ChoiceT<'E, 'Monad, 'T>, f: exn -> ChoiceT<'E, 'Monad, 'T>) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> <| (TryWith.Invoke (fun () -> ChoiceT.run (source ())) (ChoiceT.run << f)) + static member inline TryFinally (computation: unit -> ChoiceT<'E, 'Monad, 'T>, f) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> (TryFinally.Invoke (fun () -> ChoiceT.run (computation ())) f) static member inline Using (resource, f: _ -> ChoiceT<'E, 'Monad, 'T>) = ChoiceTOperations.ChoiceT< '``Monad>``, 'Monad, 'E, 'T> (Using.Invoke resource (ChoiceT.run << f)) static member inline Delay (body: unit -> ChoiceT<'E, 'Monad, 'T>) = Value ((Delay.Invoke (fun () -> ChoiceT.run (body ()) : '``Monad>``)) |> box<'``Monad>``>) diff --git a/src/FSharpPlus/Data/List.fs b/src/FSharpPlus/Data/List.fs index 77111b928..9f9e8660e 100644 --- a/src/FSharpPlus/Data/List.fs +++ b/src/FSharpPlus/Data/List.fs @@ -272,8 +272,8 @@ type ListT<'monad, 't> with static member inline get_Empty () : ListT<'Monad, 'T> = ListT.empty<_, _, '``Monad>``> () static member inline (<|>) (x: ListT<'Monad, 'T>, y: ListT<'Monad, 'T>) : ListT<'Monad, 'T> = ListT.concat<_, _, '``Monad>``> x y - static member inline TryWith (source: unit -> ListT<'Monad, 'T>, f: exn -> ListT<'Monad, 'T>) = ListT (TryWithS.InvokeFromOtherMonad (fun () -> ListT.unwrap (source ()) : '``Monad>``) (ListT.unwrap << f)) - static member inline TryFinally (computation: unit -> ListT<'Monad, 'T>, f) = ListT (TryFinallyS.Invoke (fun () -> ListT.unwrap (computation ()) : '``Monad>``) f) + static member inline TryWith (source: unit -> ListT<'Monad, 'T>, f: exn -> ListT<'Monad, 'T>) = ListT (TryWith.Invoke (fun () -> ListT.unwrap (source ()) : '``Monad>``) (ListT.unwrap << f)) + static member inline TryFinally (computation: unit -> ListT<'Monad, 'T>, f) = ListT (TryFinally.Invoke (fun () -> ListT.unwrap (computation ()) : '``Monad>``) f) static member inline Using (resource, f: _ -> ListT<'Monad, 'T>) = ListT (Using.Invoke resource (ListT.unwrap << f : 'R -> '``Monad>``)) static member inline Delay (body: unit -> ListT<'Monad, 'T>) : ListT<'Monad, 'T> = ListT (Delay.Invoke (fun () -> ListT.unwrap (body ()) : '``Monad>``)) diff --git a/src/FSharpPlus/Data/Option.fs b/src/FSharpPlus/Data/Option.fs index 995bbd107..c54af4db1 100644 --- a/src/FSharpPlus/Data/Option.fs +++ b/src/FSharpPlus/Data/Option.fs @@ -55,8 +55,8 @@ type OptionT<'``monad>``> with static member inline get_Empty () = OptionT <| result None : OptionT<'``MonadPlus``> static member inline (<|>) (OptionT x, OptionT y) = OptionT <| (x >>= (fun maybe_value -> match maybe_value with Some value -> result (Some value) | _ -> y)) : OptionT<'``MonadPlus``> - static member inline TryWith (source: unit -> OptionT<'``Monad>``>, f: exn -> OptionT<'``Monad>``>) = OptionT (TryWithS.InvokeFromOtherMonad (fun () -> OptionT.run (source ())) (OptionT.run << f)) - static member inline TryFinally (computation: unit -> OptionT<'``Monad>``>, f) = OptionT (TryFinallyS.Invoke (fun () -> OptionT.run (computation ())) f) + static member inline TryWith (source: unit -> OptionT<'``Monad>``>, f: exn -> OptionT<'``Monad>``>) = OptionT (TryWith.Invoke (fun () -> OptionT.run (source ())) (OptionT.run << f)) + static member inline TryFinally (computation: unit -> OptionT<'``Monad>``>, f) = OptionT (TryFinally.Invoke (fun () -> OptionT.run (computation ())) f) static member inline Using (resource, f: _ -> OptionT<'``Monad>``>) = OptionT (Using.Invoke resource (OptionT.run << f)) static member inline Delay (body : unit -> OptionT<'``Monad>``>) = OptionT (Delay.Invoke (fun _ -> OptionT.run (body ()))) : OptionT<'``Monad>``> diff --git a/src/FSharpPlus/Data/Reader.fs b/src/FSharpPlus/Data/Reader.fs index ca28eddc3..e336c7127 100644 --- a/src/FSharpPlus/Data/Reader.fs +++ b/src/FSharpPlus/Data/Reader.fs @@ -220,10 +220,10 @@ type ReaderT<'r, 'monad, 't> with static member inline Zip (x: ReaderT<'S, 'Monad, 'T>, y: ReaderT<'S, 'Monad, 'U>) = ReaderT.zip x y static member inline TryWith (source: unit -> ReaderT<'R, 'Monad, 'T>, f: exn -> ReaderT<'R, 'Monad, 'T>) = - ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWithS.InvokeFromOtherMonad (fun () -> ((ReaderT.run (source ()) s: '``Monad<'T>``))) (fun x -> ReaderT.run (f x) s)) + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryWith.Invoke (fun () -> ((ReaderT.run (source ()) s: '``Monad<'T>``))) (fun x -> ReaderT.run (f x) s)) static member inline TryFinally (computation: unit -> ReaderT<'R, 'Monad, 'T>, f) = - ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinallyS.Invoke (fun () -> ReaderT.run (computation ()) s) f) + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinally.Invoke (fun () -> ReaderT.run (computation ()) s) f) static member inline Using (resource, f: _ -> ReaderT<'R, 'Monad, 'T>) = ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> Using.Invoke resource (fun x -> ReaderT.run (f x) s)) diff --git a/src/FSharpPlus/Data/Seq.fs b/src/FSharpPlus/Data/Seq.fs index 4e8f27876..e9cfc021e 100644 --- a/src/FSharpPlus/Data/Seq.fs +++ b/src/FSharpPlus/Data/Seq.fs @@ -64,8 +64,8 @@ type SeqT<'``monad>``> with static member inline get_Empty () = SeqT <| result Seq.empty : SeqT<'``MonadPlus``> static member inline (<|>) (SeqT x, SeqT y) = SeqT <| (x >>= (fun a -> y >>= (fun b -> result ((Seq.append:seq<_>->seq<_>->_) a b)))) : SeqT<'``MonadPlus``> - static member inline TryWith (source: unit -> SeqT<'``Monad>``>, f: exn -> SeqT<'``Monad>``>) = SeqT (TryWithS.InvokeFromOtherMonad (fun () -> SeqT.run (source ())) (SeqT.run << f)) - static member inline TryFinally (computation: unit -> SeqT<'``Monad>``>, f) = SeqT (TryFinallyS.Invoke (fun () -> SeqT.run (computation ())) f) + static member inline TryWith (source: unit -> SeqT<'``Monad>``>, f: exn -> SeqT<'``Monad>``>) = SeqT (TryWith.Invoke (fun () -> SeqT.run (source ())) (SeqT.run << f)) + static member inline TryFinally (computation: unit -> SeqT<'``Monad>``>, f) = SeqT (TryFinally.Invoke (fun () -> SeqT.run (computation ())) f) static member inline Using (resource, f: _ -> SeqT<'``Monad>``>) = SeqT (Using.Invoke resource (SeqT.run << f)) static member inline Delay (body : unit -> SeqT<'``Monad>``>) = SeqT (Delay.Invoke (fun _ -> SeqT.run (body ()))) : SeqT<'``Monad>``> diff --git a/src/FSharpPlus/Data/State.fs b/src/FSharpPlus/Data/State.fs index b85fdbeb4..e74b23101 100644 --- a/src/FSharpPlus/Data/State.fs +++ b/src/FSharpPlus/Data/State.fs @@ -234,10 +234,10 @@ type StateT<'s, 'monad, 't> with static member inline Zip (x: StateT<'S, 'Monad, 'T>, y: StateT<'S, 'Monad, 'U>) = StateT.zip x y static member inline TryWith (source: unit -> StateT<'S, 'Monad, 'T>, f: exn -> StateT<'S, 'Monad, 'T>) = - StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWithS.InvokeFromOtherMonad (fun () -> (StateT.run (source ()) s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryWith.Invoke (fun () -> (StateT.run (source ()) s : '``Monad<'T * 'S>`` )) (fun x -> StateT.run (f x) s)) static member inline TryFinally (computation: unit -> StateT<'S,'Monad,'T>, f) = - StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinallyS.Invoke (fun () -> StateT.run (computation ()) s) f) + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinally.Invoke (fun () -> StateT.run (computation ()) s) f) static member inline Using (resource: 'S, f: _ -> StateT<'S,'Monad,'T>) = StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> Using.Invoke resource (fun x -> StateT.run (f x) s)) diff --git a/src/FSharpPlus/Data/Writer.fs b/src/FSharpPlus/Data/Writer.fs index b2769d4bf..d8c9430eb 100644 --- a/src/FSharpPlus/Data/Writer.fs +++ b/src/FSharpPlus/Data/Writer.fs @@ -219,9 +219,9 @@ type WriterT<'monoid, 'monad, 't> with WriterTOperations.WriterT (m <|> n) static member inline TryWith (source: unit -> WriterT<'Monoid, 'Monad, 'T>, f: exn -> WriterT<'Monoid, 'Monad, 'T>) = - WriterTOperations.WriterT< '``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryWithS.InvokeFromOtherMonad (fun () -> WriterT.run (source ())) (WriterT.run << f)) + WriterTOperations.WriterT< '``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryWith.Invoke (fun () -> WriterT.run (source ())) (WriterT.run << f)) - static member inline TryFinally (computation: unit -> WriterT<'Monoid, 'Monad, 'T>, f) = WriterTOperations.WriterT<'``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryFinallyS.Invoke (fun () -> WriterT.run (computation ())) f) + static member inline TryFinally (computation: unit -> WriterT<'Monoid, 'Monad, 'T>, f) = WriterTOperations.WriterT<'``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (TryFinally.Invoke (fun () -> WriterT.run (computation ())) f) static member inline Using (resource, f: _ -> WriterT<'Monoid, 'Monad, 'T>) = WriterTOperations.WriterT<'``Monad<'T * 'Monoid>``, 'Monad, 'Monoid, 'T> (Using.Invoke resource (WriterT.run << f)) static member inline Delay (body: unit -> WriterT<'Monoid, 'Monad, 'T>) : WriterT<'Monoid, 'Monad, 'T> = Value ((Delay.Invoke (fun () -> WriterT.run (body ()) : '``Monad<'T * 'S>``)) |> box<'``Monad<'T * 'S>``>) diff --git a/tests/FSharpPlus.Tests/General.fs b/tests/FSharpPlus.Tests/General.fs index 13a56c7c1..93893a96e 100644 --- a/tests/FSharpPlus.Tests/General.fs +++ b/tests/FSharpPlus.Tests/General.fs @@ -185,7 +185,7 @@ type WrappedSeqB<'s> = WrappedSeqB of 's seq with WrappedSeqB (Seq.delay (f >> run)) static member TryFinally (computation, compensation) = SideEffects.add "Using WrappedSeqA's TryFinally" - try computation finally compensation () + try computation () finally compensation () static member Using (resource, body) = SideEffects.add "Using WrappedSeqB's Using" using resource body @@ -203,7 +203,7 @@ type WrappedSeqC<'s> = WrappedSeqC of 's seq with WrappedSeqC (Seq.delay (f >> run)) static member TryFinally (computation, compensation) = SideEffects.add "Using WrappedSeqC's TryFinally" - try computation finally compensation () + try computation () finally compensation () type WrappedSeqD<'s> = WrappedSeqD of 's seq with static member Return x = SideEffects.add "Using WrappedSeqD's Return"; WrappedSeqD (Seq.singleton x) From ffe568504ff84aa0f3f8f3571e088ae9b304150d Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sun, 18 Sep 2022 08:39:08 +0200 Subject: [PATCH 31/33] add / remove spaces --- src/FSharpPlus/Data/Reader.fs | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/FSharpPlus/Data/Reader.fs b/src/FSharpPlus/Data/Reader.fs index e336c7127..ce4988752 100644 --- a/src/FSharpPlus/Data/Reader.fs +++ b/src/FSharpPlus/Data/Reader.fs @@ -43,7 +43,7 @@ module Reader = type Reader<'r,'t> with [] - static member Map (x: Reader<'R,'T>, f) = Reader.map f x : Reader<'R,'U> + static member Map (x: Reader<'R,'T>, f) = Reader.map f x : Reader<'R,'U> /// Lifts a function into a Reader. Same as map. /// To be used in Applicative Style expressions, combined with <*> @@ -59,38 +59,38 @@ type Reader<'r,'t> with /// Sequences two Readers left-to-right, discarding the value of the first argument. /// /// Applicative - static member ( *>) (x: Reader<'R, 'T>, y: Reader<'R, 'U>) : Reader<'R, 'U> = ((fun (_: 'T) (k: 'U) -> k) x : Reader<'R, 'U->'U>) y + static member ( *>) (x: Reader<'R, 'T>, y: Reader<'R, 'U>) : Reader<'R, 'U> = ((fun (_: 'T) (k: 'U) -> k) x : Reader<'R, 'U -> 'U>) y /// /// Sequences two Readers left-to-right, discarding the value of the second argument. /// /// Applicative - static member (<* ) (x: Reader<'R, 'U>, y: Reader<'R, 'T>) : Reader<'R, 'U> = ((fun (k: 'U) (_: 'T) -> k ) x : Reader<'R, 'T->'U>) y + static member (<* ) (x: Reader<'R, 'U>, y: Reader<'R, 'T>) : Reader<'R, 'U> = ((fun (k: 'U) (_: 'T) -> k ) x : Reader<'R, 'T -> 'U>) y [] - static member Lift2 (f, x: Reader<'R,'T>, y: Reader<'R,'U>) = Reader.map2 f x y : Reader<'R,'V> + static member Lift2 (f, x: Reader<'R, 'T>, y: Reader<'R, 'U>) = Reader.map2 f x y : Reader<'R, 'V> [] - static member Lift3 (f, x: Reader<'R,'T>, y: Reader<'R,'U>, z: Reader<'R,'V>) = Reader.map3 f x y z : Reader<'R,'W> + static member Lift3 (f, x: Reader<'R, 'T>, y: Reader<'R, 'U>, z: Reader<'R,'V>) = Reader.map3 f x y z : Reader<'R, 'W> - static member get_Ask () = Reader.ask : Reader<'R,'R> + static member get_Ask () : Reader<'R, 'R> = Reader.ask [] - static member Local (m, f: 'R1->'R2) = Reader.local f m : Reader<'R1,'T> + static member Local (m, f: 'R1 -> 'R2) : Reader<'R1, 'T> = Reader.local f m #if !FABLE_COMPILER || FABLE_COMPILER_3 [] static member Zip (x, y) = Reader.zip x y static member inline Extract (Reader (f : 'Monoid -> 'T)) = f (Zero.Invoke ()) : 'T - static member inline (=>>) (Reader (g : 'Monoid -> 'T), f : Reader<'Monoid,'T> -> 'U) = Reader (fun a -> f (Reader (fun b -> (g (Plus.Invoke a b))))) : Reader<'Monoid,'U> + static member inline (=>>) (Reader (g : 'Monoid -> 'T), f : Reader<'Monoid, 'T> -> 'U) : Reader<'Monoid, 'U> = Reader (fun a -> f (Reader (fun b -> (g (Plus.Invoke a b))))) #endif - static member TryWith (computation: unit -> Reader<_, _>, h) = Reader (fun s -> try (Reader.run (computation ())) s with e -> Reader.run (h e) s) : Reader<'R,'T> + static member TryWith (computation: unit -> Reader<_, _>, h) : Reader<'R, 'T> = Reader (fun s -> try (Reader.run (computation ())) s with e -> Reader.run (h e) s) static member TryFinally (computation: unit -> Reader<_, _>, f) = Reader (fun s -> try (Reader.run (computation ())) s finally f ()) - static member Using (resource, f: _ -> Reader<'R,'T>) = Reader.TryFinally ((fun () -> f resource), fun () -> dispose resource) - static member Delay (body: unit->Reader<'R,'T>) = Reader (fun s -> Reader.run (body ()) s) : Reader<'R,'T> + static member Using (resource, f: _ -> Reader<'R, 'T>) = Reader.TryFinally ((fun () -> f resource), fun () -> dispose resource) + static member Delay (body: unit->Reader<'R, 'T>) : Reader<'R, 'T> = Reader (fun s -> Reader.run (body ()) s) #if !FABLE_COMPILER || FABLE_COMPILER_3 @@ -103,8 +103,8 @@ type ReaderT<'r, 'monad, 't> = type []ReaderTOperations = [] - static member inline ReaderT< ^``monad<'t>``, ^monad, 'r, 't when (Map or ^``monad<'t>`` or ^monad) : (static member Map: ( ^``monad<'t>`` * ('t -> __)) * Map -> ^monad) - and (Map or ^monad or ^``monad<'t>``) : (static member Map: ( ^monad * (__ -> 't)) * Map -> ^``monad<'t>``) + static member inline ReaderT< ^``monad<'t>``, ^monad, 'r, 't when (Map or ^``monad<'t>`` or ^monad) : (static member Map: (^``monad<'t>`` * ('t -> __)) * Map -> ^monad) + and (Map or ^monad or ^``monad<'t>``) : (static member Map: (^monad * (__ -> 't)) * Map -> ^``monad<'t>``) > (f: 'r -> '``monad<'t>``) : ReaderT<'r, 'monad, 't> = if opaqueId false then let _: 'monad = Unchecked.defaultof<'``monad<'t>``> |> map (fun (_: 't) -> Unchecked.defaultof<__>) From de380146a532db7e0dc39efb5a8cb78a81676eb6 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sun, 18 Sep 2022 23:26:42 +0200 Subject: [PATCH 32/33] Better apply for ListT (not bind based) --- src/FSharpPlus/Data/List.fs | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/src/FSharpPlus/Data/List.fs b/src/FSharpPlus/Data/List.fs index 9f9e8660e..f1e9d820e 100644 --- a/src/FSharpPlus/Data/List.fs +++ b/src/FSharpPlus/Data/List.fs @@ -100,10 +100,15 @@ module ListT = let mresult x = result x wrap ((mresult <| ListTNode<'Monad, 'T>.Cons (v, (wrap (mresult ListTNode<'Monad, 'T>.Nil): ListT<'Monad, 'T> ))) : '``Monad>``) : ListT<'Monad, 'T> - let inline apply<'T, 'U, .. > (f: ListT<'Monad, ('T -> 'U)>) (x: ListT<'Monad, 'T>) : ListT<'Monad, 'U> = - bind<_, _, _, '``Monad>``, '``Monad 'U)>>``> (fun (x1: _) -> - bind<_, _, _, '``Monad>``, '``Monad>``> (fun x2 -> - singleton<_, _, '``Monad>``> (x1 x2)) x) f + let inline apply<'T, 'U, .. > (f: ListT<'Monad, ('T -> 'U)>) (source: ListT<'Monad, 'T>) : ListT<'Monad, 'U> = + let rec loop f input = + ListT ( + (unwrap f: '``Monad 'U)>>``) >>= function + | Nil -> result Nil + | Cons (f: 'T -> 'U, fs: ListT<'Monad, ('T -> 'U)>) -> + let res = concat<'U, _, '``Monad>``> (map<'T, 'U, 'Monad, '``Monad>``, '``Monad>``> f input) (loop fs input) + unwrap res : '``Monad>``) + loop f source /// Safely builds a new list whose elements are the results of applying the given function /// to each of the elements of the two lists pairwise. @@ -147,7 +152,7 @@ module ListT = /// List with values returned from mapping function. let inline lift2<'T, 'U, 'V, .. > (f: 'T -> 'U -> 'V) (x: ListT<'Monad, 'T>) (y : ListT<'Monad, 'U>) : ListT<'Monad, 'V> = f 'V, 'Monad, '``Monad 'V>>``, '``Monad>``> /> x - 'V>>``, '``Monad>``, '``Monad>``> /> y + >``, '``Monad>``, '``Monad 'V>>``> /> y /// Combines values from three list and calls a mapping function on this combination. /// Mapping function taking three element combination as input. @@ -158,8 +163,8 @@ module ListT = /// List with values returned from mapping function. let inline lift3<'T, 'U, 'V, 'W, .. > (f: 'T -> 'U -> 'V -> 'W) (x: ListT<'Monad, 'T>) (y : ListT<'Monad, 'U>) (z: ListT<'Monad, 'V>) : ListT<'Monad, 'W> = f 'V -> 'W, 'Monad, '``Monad 'V -> 'W>>``, '``Monad>``> /> x - 'W , 'Monad, '``Monad 'V -> 'W>>``, '``Monad 'W>>``, '``Monad>``> /> y - 'W>>`` , '``Monad>`` , '``Monad>``> /> z + 'W , 'Monad, '``Monad 'W>>``, '``Monad>``, '``Monad 'V -> 'W>>``> /> y + >`` , '``Monad>``, '``Monad 'W>>``> /> z let inline append (head: 'T) tail = wrap ((result <| ListTNode<'Monad, 'T>.Cons (head, (tail: ListT<'Monad, 'T> ))) : '``Monad>``) : ListT<'Monad, 'T> @@ -246,7 +251,7 @@ type ListT<'monad, 't> with ListT.lift3<_, _, _, _, _, '``Monad>``, '``Monad 'V -> 'W>>``, '``Monad 'W>>``, '``Monad>``, '``Monad>``, '``Monad>``> f x y z static member inline (<*>) (f: ListT<'Monad, ('T -> 'U)>, x: ListT<'Monad, 'T>) : ListT<'Monad, 'U> = - ListT.apply<_, _, _, '``Monad 'U>>``, '``Monad>``, '``Monad>``> f x + ListT.apply<_, _, _, '``Monad>``, '``Monad>``, '``Monad 'U>>``> f x /// /// Sequences two lists left-to-right, discarding the value of the first argument. @@ -254,7 +259,7 @@ type ListT<'monad, 't> with /// Applicative static member inline ( *>) (x: ListT<'Monad, 'T>, y: ListT<'Monad, 'U>) : ListT<'Monad, 'U> = let () = ListT.map<_, _, 'Monad, '``Monad 'U)>>``, '``Monad>``> - let (<*>) = ListT.apply<_, _, 'Monad, '``Monad 'U>>``, '``Monad>``, '``Monad>``> + let (<*>) = ListT.apply<_, _, 'Monad, '``Monad>``, '``Monad>``, '``Monad 'U>>``> ((fun (_: 'T) (k: 'U) -> k) x: ListT<'Monad, ('U -> 'U)>) <*> y /// @@ -263,7 +268,7 @@ type ListT<'monad, 't> with /// Applicative static member inline (<* ) (x: ListT<'Monad, 'U>, y: ListT<'Monad, 'T>) : ListT<'Monad, 'U> = let () = ListT.map<_, _, 'Monad, '``Monad 'U>>``, '``Monad>``> - let (<*>) = ListT.apply<_, _, 'Monad, '``Monad 'U>>``, '``Monad>``, '``Monad>``> + let (<*>) = ListT.apply<_, _, 'Monad, '``Monad>``, '``Monad>``, '``Monad 'U>>``> ((fun (k: 'U) (_: 'T) -> k) x: ListT<'Monad, ('T -> 'U)>) <*> y static member inline (>>=) (x: ListT<'Monad, 'T>, f: 'T -> ListT<'Monad, ' U>) : ListT<'Monad, ' U> = @@ -304,4 +309,4 @@ type ListT<'monad, 't> with static member inline Take (lst : ListT<'Monad, 'T>, c: int, _: Take) : ListT<'Monad, 'T> = ListT.take<_, _, '``Monad>``> c lst #endif -#endif \ No newline at end of file +#endif From 4840c2ac746189288684a851241eca58a4cbc89c Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 16 Sep 2023 08:48:29 +0200 Subject: [PATCH 33/33] Fix in Try methods --- src/FSharpPlus/Data/ValueOption.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Data/ValueOption.fs b/src/FSharpPlus/Data/ValueOption.fs index e698a2370..078e1d557 100644 --- a/src/FSharpPlus/Data/ValueOption.fs +++ b/src/FSharpPlus/Data/ValueOption.fs @@ -70,8 +70,8 @@ type ValueOptionT<'``monad>``> with static member inline get_Empty () : ValueOptionT<'``MonadPlus``> = ValueOptionT <| result ValueNone static member inline (<|>) (ValueOptionT x, ValueOptionT y) : ValueOptionT<'``MonadPlus``> = ValueOptionT <| (x >>= function ValueSome value -> result (ValueSome value) | _ -> y) - static member inline TryWith (source: ValueOptionT<'``Monad>``>, f: exn -> ValueOptionT<'``Monad>``>) = ValueOptionT (TryWith.Invoke (ValueOptionT.run source) (ValueOptionT.run << f)) - static member inline TryFinally (computation: ValueOptionT<'``Monad>``>, f) = ValueOptionT (TryFinally.Invoke (ValueOptionT.run computation) f) + static member inline TryWith (source: unit -> ValueOptionT<'``Monad>``>, f: exn -> ValueOptionT<'``Monad>``>) = ValueOptionT (TryWith.Invoke (fun () -> ValueOptionT.run (source ())) (ValueOptionT.run << f)) + static member inline TryFinally (computation: unit -> ValueOptionT<'``Monad>``>, f) = ValueOptionT (TryFinally.Invoke (fun () -> ValueOptionT.run (computation ())) f) static member inline Using (resource, f: _ -> ValueOptionT<'``Monad>``>) = ValueOptionT (Using.Invoke resource (ValueOptionT.run << f)) static member inline Delay (body : unit -> ValueOptionT<'``Monad>``>) = ValueOptionT (Delay.Invoke (fun _ -> ValueOptionT.run (body ()))) : ValueOptionT<'``Monad>``>