diff --git a/docsrc/content/abstraction-monad.fsx b/docsrc/content/abstraction-monad.fsx index dd6fab944..ddea5d204 100644 --- a/docsrc/content/abstraction-monad.fsx +++ b/docsrc/content/abstraction-monad.fsx @@ -152,7 +152,7 @@ let some14 = (** ```f# -let fn : ResultT>> = +let fn : ResultT, _> = monad { let! x1 = lift ask let! x2 = @@ -190,7 +190,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 @@ -262,11 +262,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 diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index dd2b69f8c..def833ace 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -68,20 +68,20 @@ module GenericBuilders = type StrictBuilder<'``monad<'t>``> () = inherit Builder<'``monad<'t>``> () - member inline _.Delay ([]expr) = expr : unit -> '``Monad<'T>`` - member inline _.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 __.Delay expr = expr : unit -> '``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 _.Using (disposable: #IDisposable, []body) = Using.Invoke disposable body type DelayedBuilder<'``monad<'t>``> () = 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 _.Using (disposable: #IDisposable, []body) = Using.Invoke disposable body : '``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.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>``> () = inherit StrictBuilder<'``monad<'t>``> () @@ -127,7 +127,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) @@ -167,7 +167,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 89635d765..47fc85ef2 100644 --- a/src/FSharpPlus/Control/Monad.fs +++ b/src/FSharpPlus/Control/Monad.fs @@ -185,7 +185,7 @@ 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 -> '``Monad<'T>``) : '``Monad<'T>`` = + static member inline Invoke (source : unit -> 'R) : 'R = let inline call (mthd: ^M, input: unit -> ^I) = ((^M or ^I) : (static member Delay : _*_*_ -> _) mthd, input, Unchecked.defaultof) call (Unchecked.defaultof, source) @@ -193,8 +193,6 @@ type Delay = static member inline Invoke (source : unit -> '``Monad<'T>``) : '``Monad<'T>`` = Bind.Invoke (Return.Invoke ()) source - #endif - #if NETSTANDARD2_1 && !FABLE_COMPILER static member Delay (_mthd: Delay , x: unit-> ValueTask<_> , _ ) = x () : ValueTask<'T> #endif @@ -221,71 +219,66 @@ type TryWith = inherit Default1 [] - 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>`` : 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>`` when '``Monad<'T>`` : struct, _: 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: False) = raise Internals.Errors.exnUnreachable - + 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 (_: 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 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 (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) + 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 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 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, True) + call (Unchecked.defaultof, source, Unchecked.defaultof<'``Monad<'T>``>, f) - static member inline InvokeForStrict (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) + /// 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) - 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) + /// 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) 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<_> #if !FABLE_COMPILER 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), _: TryFinally, _, True) = try computation () finally compensation () #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>`` = + 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: '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = (^``Monad<'T>`` : (static member TryFinally : _*_->_) source, f) : '``Monad<'T>`` + static member inline InvokeOnInstance (source: unit -> '``Monad<'T>``) (f: unit -> unit) : '``Monad<'T>`` = (^``Monad<'T>`` : (static member TryFinally : _*_->_) source, f) : '``Monad<'T>`` type TryFinally with @@ -298,8 +291,8 @@ type TryFinally 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, _: TryFinally, _) = TryFinally.InvokeOnInstance (computation ()) compensation: '``Monad<'T>`` - static member inline TryFinally (( _ : unit -> ^t when ^t:null and ^t:struct , _ : unit -> unit), _: Default1, _ , _) = () + 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, _ , _ ) = () type Using = @@ -324,7 +317,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/Cont.fs b/src/FSharpPlus/Data/Cont.fs index 9aec5f299..d73917e77 100644 --- a/src/FSharpPlus/Data/Cont.fs +++ b/src/FSharpPlus/Data/Cont.fs @@ -83,9 +83,9 @@ type Cont<'r,'t> with static member (>=>) (f, (g: 'U -> _)) : 'T -> Cont<'R, 'V> = fun x -> Cont.bind g (f x) 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/Coproduct.fs b/src/FSharpPlus/Data/Coproduct.fs index 9dc662945..95282c634 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/Error.fs b/src/FSharpPlus/Data/Error.fs index a226b59df..c90200105 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,184 +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 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>``> + 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>``) + + + +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 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 Map (x: ResultT<'E, 'Monad, 'T>, f: 'T->'U) : ResultT<'E, 'Monad, 'U> = ResultT.map f x - 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 Lift2 (f: 'T -> 'U -> 'V, x: ResultT<'E, 'Monad, 'T>, y: ResultT<'E, 'Monad, 'U>) : ResultT<'E, 'Monad, 'V> = + ResultT.map2 f x y - /// - /// Composes left-to-right two Result functions (Kleisli composition). - /// - /// Monad - static member inline (>=>) (f: 'T -> ResultT<'``Monad``>, g: 'U -> ResultT<'``Monad``>) : 'T -> ResultT<'``Monad``> = fun x -> ResultT.bind g (f x) - - static member inline get_Zero () : ResultT<'``MonadPlus>``> = ResultT <| result (Error zero) - static member inline (+) (ResultT x, ResultT y) : ResultT<'``MonadPlus>``> = - ResultT <| (x >>= function - | Ok x -> y >>= function - | Ok y -> result (Ok (x ++ y)) - | Error _ -> result (Ok x) - | Error x -> y >>= function - | Ok y -> result (Ok y) - | Error y -> result (Error (x ++ y))) - - static member inline get_Empty () : ResultT<'``MonadPlus>``> = ResultT <| result (Error zero) - static member inline (<|>) (ResultT x, ResultT y) : ResultT<'``MonadPlus>``> = - ResultT <| (x >>= function - | Ok value -> result (Ok value) - | Error x -> y >>= function - | Ok value -> result (Ok value) - | Error y -> result (Error (x ++ y))) - - 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 Lift (x: '``Monad<'T>``) : ResultT<'``Monad>``> = ResultT.lift x + 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<'E, 'Monad, 'T -> 'U>, x: ResultT<'E, 'Monad, 'T>) = ResultT.apply f x : ResultT<'E, 'Monad, 'U> - 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 (>>=) (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 LiftAsync (x: Async<'T>) = ResultT.lift (liftAsync x) : ResultT<'``MonadAsync<'T>``> + 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>``>) - 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 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 Lift (x: '``Monad<'T>``) : ResultT<'E, 'Monad, 'T> = ResultT.lift<_, _, _, ^``Monad>``, 'Monad> x - static member inline Tell (w: 'Monoid) = w |> tell |> ResultT.lift : ResultT<'``Writer<'Monoid,Result>``> + 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 LiftAsync (x: Async<'T>) : ResultT<'E, 'MonadAsync, 'T> = + ResultT.lift<_, _, _, '``Monad>``, _> (liftAsync x: '``MonadAsync<'T>``) + + // '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 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 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 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, '``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>``> -[] -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>``)))) -type ChoiceT<'``monad>``> with - - static member inline Return (x: 'T) = ChoiceT (result (Choice1Of2 x)) : ChoiceT<'``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>``) - [] - static member inline Map (x: ChoiceT<'``Monad>``>, f: 'T->'U) = ChoiceT.map f x : ChoiceT<'``Monad>``> [] - static member inline Lift2 (f: 'T->'U->'V, x: ChoiceT<'``Monad``>, y: ChoiceT<'``Monad``>) : ChoiceT<'``Monad``> = ChoiceT.map2 f x y + static member inline Map (x: ChoiceT<'E, 'Monad, 'T>, f: 'T->'U) : ChoiceT<'E, 'Monad, 'U> = ChoiceT.map f x - 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 Lift2 (f: 'T -> 'U -> 'V, x: ChoiceT<'E, 'Monad, 'T>, y: ChoiceT<'E, 'Monad, 'U>) : ChoiceT<'E, 'Monad, 'V> = + ChoiceT.map2 f x y - /// - /// Composes left-to-right two Choice functions (Kleisli composition). - /// - /// Monad - static member inline (>=>) (f: 'T -> ChoiceT<'``Monad``>, g: 'U -> ChoiceT<'``Monad``>) : 'T -> ChoiceT<'``Monad``> = fun x -> ChoiceT.bind g (f x) - - static member inline get_Zero () : ChoiceT<'``MonadPlus>``> = ChoiceT <| result (Choice2Of2 zero) - static member inline (+) (ChoiceT x, ChoiceT y) : ChoiceT<'``MonadPlus>``> = - ChoiceT <| (x >>= function - | Choice1Of2 x -> y >>= function - | Choice1Of2 y -> result (Choice1Of2 (x ++ y)) - | Choice2Of2 _ -> result (Choice1Of2 x) - | Choice2Of2 x -> y >>= function - | Choice1Of2 y -> result (Choice1Of2 y) - | Choice2Of2 y -> result (Choice2Of2 (x ++ y))) - - static member inline get_Empty () : ChoiceT<'``MonadPlus>``> = ChoiceT <| result (Choice2Of2 zero) - static member inline (<|>) (ChoiceT x, ChoiceT y) : ChoiceT<'``MonadPlus>``> = - ChoiceT <| (x >>= function - | Choice1Of2 value -> result (Choice1Of2 value) - | Choice2Of2 x -> y >>= function - | Choice1Of2 value -> result (Choice1Of2 value) - | Choice2Of2 y -> result (Choice2Of2 (x ++ y))) - - static member inline TryWith (source: ChoiceT<'``Monad>``>, f: exn -> ChoiceT<'``Monad>``>) = ChoiceT (TryWith.Invoke (ChoiceT.run source) (ChoiceT.run << f)) - static member inline TryFinally (computation: ChoiceT<'``Monad>``>, f) = ChoiceT (TryFinally.Invoke (ChoiceT.run computation) f) - static member inline Using (resource, f: _ -> ChoiceT<'``Monad>``>) = ChoiceT (Using.Invoke resource (ChoiceT.run << f)) - static member inline Delay (body : unit -> ChoiceT<'``Monad>``>) = ChoiceT (Delay.Invoke (fun _ -> ChoiceT.run (body ()))) - [] - static member inline Lift (x: '``Monad<'T>``) : ChoiceT<'``Monad>``> = ChoiceT.lift x + 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 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 (<*>) (f: ChoiceT<'E, 'Monad, 'T -> 'U>, x: ChoiceT<'E, 'Monad, 'T>) = ChoiceT.apply f x : ChoiceT<'E, 'Monad, 'U> - static member inline LiftAsync (x: Async<'T>) = ChoiceT.lift (liftAsync x) : ChoiceT<'``MonadAsync<'T>``> + 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 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 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>``>) + + + [] + static member inline Lift (x: '``Monad<'T>``) : ChoiceT<'E, 'Monad, 'T> = ChoiceT.lift<_, _, _, ^``Monad>``, 'Monad> x - 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 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 Tell (w: 'Monoid) = w |> tell |> ChoiceT.lift : ChoiceT<'``Writer<'Monoid,Choice>``> + static member inline LiftAsync (x: Async<'T>) : ChoiceT<'E, 'MonadAsync, 'T> = + ChoiceT.lift<_, _, _, '``Monad>``, _> (liftAsync x: '``MonadAsync<'T>``) + + // '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, '``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/Free.fs b/src/FSharpPlus/Data/Free.fs index b5605cbf3..b5b584716 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 rec loop (y: Free<_,_>) (z: Free<_,_>) (x: Free<_,_>) = + 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,'W>>``,'``Functor,'V>>``,'``Functor<'V>``,'``Functor<'W>``> (f x) y z : Free<'``Functor<'W>``,'W> - | Roll (x: ^``Functor,'T>>``) -> Roll (Map.Invoke (loop y z: Free<'``Functor<'T>``,'T> -> _) x: '``Functor,'W>>``) - loop y z x + | 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,15 +77,15 @@ 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>>``) + /// Lift any Functor into a Free structure + let inline liftF (x: '``Functor<'T>``) : Free<'Functor, 'T> = Roll (Map.Invoke (Pure: 'T -> Free<'Functor, 'T>) x : '``Functor>``) /// Lift a natural transformation from functor F to functor G into a natural transformation from Free of F to Free of G. let inline hoist (f: ^``F, 'T>>`` -> ^``G, 'T>>``) (x: Free<'``F<'T>``, 'T>) : Free<'``G<'T>``, 'T> = @@ -100,21 +100,21 @@ module Free = loop f x -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 diff --git a/src/FSharpPlus/Data/List.fs b/src/FSharpPlus/Data/List.fs index 814cfa892..9fd8ddf3a 100644 --- a/src/FSharpPlus/Data/List.fs +++ b/src/FSharpPlus/Data/List.fs @@ -43,68 +43,277 @@ 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> = Nil | Cons of 't * ListT<'monad, 't> /// Basic operations on ListT [] module ListT = - let run (ListT m) = m : '``Monad>`` - /// Embed a Monad<'T> into a ListT<'Monad>> - let inline lift (x: '``Monad<'T>``) : ListT<'``Monad>``> = - if opaqueId false then x |> liftM List.singleton |> ListT - else x |> map List.singleton |> ListT + 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 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 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 internal mapM f as' = sequence (List.map f as') + let inline empty<'T, .. > () = wrap ((result ListTNode<'Monad, 'T>.Nil) : '``Monad>``) : ListT<'Monad, 'T> - 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 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``> - let inline map (f: 'T->'U) (ListT m: ListT<'``Monad``>) = ListT (map (List.map f) m) : ListT<'``Monad``> + /// Concatenates the elements of two lists + 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> -type ListT<'``monad>``> with + let inline bind<'T, 'U, .. > f (source: ListT<'Monad, 'T>) : ListT<'Monad, ' U> = + let rec loop f input = + ListT ( + (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 - static member inline Return (x: 'T) = [x] |> result |> ListT : ListT<'``Monad``> + 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) : '``Monad>``) |> wrap + loop f s + + 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: '``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 + 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)>) (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. + /// 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 + >``, '``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. + /// 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 '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> + + let inline head (x: ListT<'Monad, 'T>) = + (unwrap x: '``Monad>``) >>= function + | Nil -> failwith "empty list" + | Cons (head, _: ListT<'Monad, 'T>) -> result head : '``Monad<'T>`` + + let inline tail (x: ListT<'Monad, 'T>) : ListT<'Monad, 'T> = + ((unwrap x: '``Monad>``) >>= function + | Nil -> failwith "empty list" + | Cons (_: 'T, tail: ListT<'Monad, 'T>) -> (unwrap tail: '``Monad>``)) |> wrap + + let inline iterM<'T, .. > (action: 'T -> '``Monad``) (lst: ListT<'Monad, 'T>) : '``Monad`` = + let rec loop lst action = + (unwrap lst: '``Monad>``) >>= function + | Nil -> result () + | Cons (h, t) -> action h >>= (fun () -> loop t action) + loop lst action + + let inline iter<'T, .. > (action: 'T -> unit) (lst: ListT<'Monad, 'T>) : '``Monad`` = + iterM<'T, '``Monad``, '``Monad>``, 'Monad> (action >> result) lst + + 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: '``Monad>`` + match v with + | Cons (h, t: ListT<'Monad, 'T>) -> return Cons (h, loop (count - 1) t) + | Nil -> return Nil + else return Nil } : '``Monad>``) + loop count (input: ListT<'Monad, 'T>) + + 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 []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<'Monad, 'T> = ListT.singleton<_, _, '``Monad>``> x [] - static member inline Map (x: ListT<'``Monad``>, f: 'T->'U) = ListT.map f x : ListT<'``Monad``> + static member inline Map (x : ListT<'Monad, 'T>, f: 'T -> 'U) : ListT<'Monad, 'U> = + ListT.map<'T, 'U, 'Monad, '``Monad>``, '``Monad>``> f x + + /// 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 Lift2 (f: 'T->'U->'V, x: ListT<'``Monad``>, y: ListT<'``Monad``>) = ListT.lift2 f x y : ListT<'``Monad``> + 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 Lift3 (f: 'T->'U->'V->'W, x: ListT<'``Monad``>, y: ListT<'``Monad``>, z: ListT<'``Monad``>) = ListT.lift3 f x y z : ListT<'``Monad``> + 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>``, '``Monad>``, '``Monad 'U>>``> 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 + /// + /// 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>``, '``Monad>``, '``Monad 'U>>``> + ((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>``, '``Monad>``, '``Monad 'U>>``> + ((fun (k: 'U) (_: 'T) -> k) x: ListT<'Monad, ('T -> 'U)>) <*> y - 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: ListT<'Monad, 'T>, f: 'T -> ListT<'Monad, ' U>) : ListT<'Monad, ' U> = + ListT.bind<_, _, _, '``Monad>``, '``Monad>``> f x - 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 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 Lift (x: '``Monad<'T>``) : ListT<'``Monad>``> = ListT.lift x + 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>``)) + + static member inline Lift (x: '``Monad<'T>``) = ListT.lift<_, _, '``Monad>``, _> x : ListT<'Monad, 'T> - static member inline LiftAsync (x: Async<'T>) = ListT.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 |> ListT.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 () = ListT.lift get : ListT<'``MonadState<'S,'S>``> - static member inline Put (x: 'S) = x |> put |> ListT.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 () = ListT.lift ask : ListT<'``MonadReader<'R, list<'R>>``> - static member inline Local (ListT (m: '``MonadReader<'R2,'T>``), f: 'R1->'R2) = ListT (local f 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)) + + #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 diff --git a/src/FSharpPlus/Data/Option.fs b/src/FSharpPlus/Data/Option.fs index 7935d333b..e2946fe38 100644 --- a/src/FSharpPlus/Data/Option.fs +++ b/src/FSharpPlus/Data/Option.fs @@ -69,8 +69,8 @@ type OptionT<'``monad>``> with static member inline get_Empty () : OptionT<'``MonadPlus``> = OptionT <| result None static member inline (<|>) (OptionT x, OptionT y) : OptionT<'``MonadPlus``> = OptionT <| (x >>= function Some value -> result (Some value) | _ -> y) - 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 (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 3879f6f78..ce4988752 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 @@ -41,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 <*> @@ -57,153 +59,206 @@ 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 (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 Delay (body: unit->Reader<'R,'T>) = Reader (fun s -> Reader.run (body ()) 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<'R, 'T> = Reader (fun s -> Reader.run (body ()) s) #if !FABLE_COMPILER || FABLE_COMPILER_3 /// 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 - - /// - /// Takes a Reader value and a function from a plain type to a Reader value, and returns a new Reader value. - /// - /// Monad - static member inline (>>=) (x: ReaderT<_,'``Monad<'T>``>, f: 'T->ReaderT<'R,'``Monad<'U>``>) = ReaderT.bind f x : ReaderT<'R, '``Monad<'U>``> - - /// - /// Composes left-to-right two Reader functions (Kleisli composition). - /// - /// Monad - static member (>=>) (f, (g: 'U -> _)) : 'T -> Reader<'R, 'V> = fun x -> Reader.bind g (f x) - - /// - /// Composes left-to-right two Reader functions (Kleisli composition). - /// - /// Monad - static member inline (>=>) (f: 'T -> ReaderT<_,'``Monad<'U>``>, g: 'U -> ReaderT<'R,'``Monad<'V>``>) : 'T -> ReaderT<'R,'``Monad<'V>``> = fun x -> ReaderT.bind g (f x) - - 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: unit -> ReaderT<'R, 'Monad, 'T>, f: exn -> ReaderT<'R, 'Monad, 'T>) = + 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 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 inline TryFinally (computation: unit -> ReaderT<'R, 'Monad, 'T>, f) = + ReaderTOperations.ReaderT<'``Monad<'T>``, 'Monad, 'R, 'T> (fun s -> TryFinally.Invoke (fun () -> ReaderT.run (computation ()) s) f) - [] - static member Lift m = ReaderT (fun _ -> m) : ReaderT<'R,'``Monad<'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 LiftAsync (x: Async<'T>) = (ReaderT.lift (liftAsync x) : ReaderT<'R,'``MonadAsync<'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 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 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/Seq.fs b/src/FSharpPlus/Data/Seq.fs index d552d9056..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: 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 (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 8a28e223f..f5af41b84 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 @@ -99,10 +100,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 @@ -112,103 +113,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 - /// - /// Composes left-to-right two State functions (Kleisli composition). - /// - /// Monad - static member inline (>=>) (f: 'T -> StateT<'S, '``Monad<'U * 'S>``>, g: 'U -> StateT<'S, '``Monad<'V * 'S>``>) : 'T -> StateT<'S, '``Monad<'V * 'S>``> = fun x -> StateT.bind g (f x) + 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: unit -> StateT<'S, 'Monad, 'T>, f: exn -> StateT<'S, 'Monad, 'T>) = + 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 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: unit -> StateT<'S,'Monad,'T>, f) = + StateTOperations.StateT< '``Monad<'T * 'S>``, 'Monad, 'S, 'T> (fun s -> TryFinally.Invoke (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>) : StateT<'S, 'Monad, 'T> = + Value ((fun s -> Delay.Invoke (fun () -> (StateT.run (body ()) s: '``Monad<'T * 'S>``))) >> box<'``Monad<'T * 'S>``>) - 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/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>``> diff --git a/src/FSharpPlus/Data/Writer.fs b/src/FSharpPlus/Data/Writer.fs index 1b1109d94..ce65aa5ee 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 @@ -111,105 +114,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>``> - -type WriterT<'``monad<'t * 'monoid>``> with - - static member inline Return (x: 'T) = WriterT (result (x, getZero ())) : WriterT<'``Monad<'T * '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<'monoid, 'monad, 't> with + + 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 - /// - /// Composes left-to-right two Writer functions (Kleisli composition). - /// - /// Monad - static member inline (>=>) (f: 'T -> WriterT<'``Monad<'U * 'Monoid>``>, g: 'U -> WriterT<'``Monad<'V * 'Monoid>``>) : 'T -> WriterT<'``Monad<'V * 'Monoid>``> = fun x -> WriterT.bind g (f x) + static member inline get_Empty () : WriterT<'Monoid, 'MonadPlus, 'T> = + WriterTOperations.WriterT (getEmpty () : '``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: unit -> WriterT<'Monoid, 'Monad, 'T>, f: exn -> WriterT<'Monoid, 'Monad, 'T>) = + 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> (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>``>) - 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 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 Tell (w: 'Monoid) : WriterT<'Monoid, 'Monad, unit> = + WriterTOperations.WriterT (result ((), w) : '``Monad``) - 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 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, '``MonadState<'S>``, 'S> = + WriterT.lift<_, '``MonadState<'S, 'S>``, '``MonadState<'S, 'S * 'Monoid>``, '``MonadState<'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, '``MonadState<'S>``, unit> = + x |> put |> WriterT.lift<_, '``MonadState<'S, unit>``, '``MonadState<'S, (unit * 'Monoid)>``, '``MonadState<'S>``, _> #endif \ No newline at end of file diff --git a/src/FSharpPlus/Internals.fs b/src/FSharpPlus/Internals.fs index 646b0d4bf..cec269375 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 /// diff --git a/tests/FSharpPlus.Tests/ComputationExpressions.fs b/tests/FSharpPlus.Tests/ComputationExpressions.fs index 30956ff82..f641cecf5 100644 --- a/tests/FSharpPlus.Tests/ComputationExpressions.fs +++ b/tests/FSharpPlus.Tests/ComputationExpressions.fs @@ -185,7 +185,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) @@ -524,7 +524,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) } @@ -535,7 +535,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) } @@ -548,7 +548,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) } @@ -630,7 +630,7 @@ module ComputationExpressions = let _ = strictMonadTest () let monadTransformer3layersTest1 () = - let x: StateT>> = monad { + let x: StateT, __>, unit> = monad { try failwith "Exception in try-with not handled" () @@ -639,7 +639,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" () @@ -648,7 +648,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" () @@ -657,33 +657,42 @@ 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 + + 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. @@ -730,7 +739,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" @@ -743,7 +752,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" @@ -756,7 +765,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" @@ -764,14 +773,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" @@ -779,7 +788,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/FSharpPlus.Tests.fsproj b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj index 46ee59d92..cd6971b18 100644 --- a/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj +++ b/tests/FSharpPlus.Tests/FSharpPlus.Tests.fsproj @@ -26,6 +26,7 @@ + diff --git a/tests/FSharpPlus.Tests/Free.fs b/tests/FSharpPlus.Tests/Free.fs index e26973f1c..d3ae87c94 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 diff --git a/tests/FSharpPlus.Tests/General.fs b/tests/FSharpPlus.Tests/General.fs index 7f26ffd7b..cfb866cb8 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) @@ -1397,7 +1397,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 @@ -1420,7 +1420,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 @@ -1431,15 +1431,15 @@ 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 : ListT, _> + 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 @@ -1457,9 +1457,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)) @@ -1491,7 +1491,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/FSharpPlus.Tests/ListT.fs b/tests/FSharpPlus.Tests/ListT.fs new file mode 100644 index 000000000..903cef016 --- /dev/null +++ b/tests/FSharpPlus.Tests/ListT.fs @@ -0,0 +1,52 @@ +module FSharpPlus.Tests.ListT + +open System +open FSharpPlus +open FSharpPlus.Data +open NUnit.Framework +open FsCheck +open Helpers +open System.Collections.Generic +open System.Threading.Tasks + +module BasicTests = + [] + let wrap_unwrap () = + 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) + + [] + 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]) + + // Compile tests + let binds () = + let res1 = listT [| [1..4] |] >>= fun x -> listT [| [x * 2] |] + 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]) + () + + 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 applicatives () = + let x = (+) listT None <*> listT (Some [1;2;3;4]) + let y = (+) listT (async.Return [1]) <*> listT (async.Return [2]) + () diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General.fs index fe7e0757f..583251e63 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 @@ -118,14 +118,14 @@ 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 : ListT, unit> + 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