From d4e4f4261ef26a4900349aa1b62cf536a949fd14 Mon Sep 17 00:00:00 2001 From: gmpl Date: Thu, 7 Nov 2013 23:38:13 +0100 Subject: [PATCH] + Default method technique !!! Implemented in Functor.fs for: . Map based on Apply. . Apply Based on Pure + Bind. . Join based on Bind. . Duplicate based on Extract. --- FsControl.Core/Cont.fs | 4 +- FsControl.Core/ContT.fs | 2 +- FsControl.Core/ErrorT.fs | 4 +- FsControl.Core/Functor.fs | 133 ++++++++++++++++++++++++----------- FsControl.Core/MonadTrans.fs | 10 +-- FsControl.Core/Reader.fs | 4 +- FsControl.Core/ReaderT.fs | 2 +- FsControl.Core/State.fs | 6 +- FsControl.Core/StateT.fs | 2 +- FsControl.Core/Writer.fs | 4 +- FsControl.Core/WriterT.fs | 6 +- 11 files changed, 112 insertions(+), 65 deletions(-) diff --git a/FsControl.Core/Cont.fs b/FsControl.Core/Cont.fs index 304b6c1..d4714de 100644 --- a/FsControl.Core/Cont.fs +++ b/FsControl.Core/Cont.fs @@ -11,7 +11,7 @@ module Cont = let callCC (f:(_->Cont<'r,'b>)->_) = Cont <| fun k -> run (f (fun a -> Cont(fun _ -> k a))) k type Cont<'R,'A> with - static member instance (Functor.Map, Cont m:Cont<'r,'a>, _) = fun (f:_->'b) -> Cont(fun c -> m (c << f)) + static member instance (_:Functor.Map, Cont m:Cont<'r,'a>, _) = fun (f:_->'b) -> Cont(fun c -> m (c << f)) static member instance (Applicative.Pure, _:Cont<'r,'a> ) = fun n -> Cont(fun k -> k n) :Cont<'r,'a> static member instance (Monad.Bind , Cont m, _:Cont<'r,'b>) = fun f -> Cont(fun k -> m (fun a -> Cont.run(f a) k)) :Cont<'r,'b> - static member instance (Applicative.Apply, f:Cont<'r,_>, x:Cont<'r,'a>, _:Cont<'r,'b>) = fun () -> DefaultImpl.ApplyFromMonad f x :Cont<'r,'b> \ No newline at end of file + static member instance (_:Applicative.Apply, f:Cont<'r,_>, x:Cont<'r,'a>, _:Cont<'r,'b>) = fun () -> DefaultImpl.ApplyFromMonad f x :Cont<'r,'b> \ No newline at end of file diff --git a/FsControl.Core/ContT.fs b/FsControl.Core/ContT.fs index 3c7d2b9..b5da7d3 100644 --- a/FsControl.Core/ContT.fs +++ b/FsControl.Core/ContT.fs @@ -15,7 +15,7 @@ module ContT = let map f (ContT m) = ContT(f << m) type ContT<'Mr,'A> with - static member instance (Functor.Map, ContT m, _) = fun f -> ContT(fun c -> m (c << f)) + static member instance (_:Functor.Map, ContT m, _) = fun f -> ContT(fun c -> m (c << f)) static member instance (Applicative.Pure, _:ContT<'mr,'a> ) = fun a -> ContT((|>) a) :ContT<'mr,'a> static member instance (Monad.Bind , ContT m, _:ContT<'mr,'b>) = fun k -> ContT(fun c -> m (fun a -> ContT.run(k a) c)) :ContT<'mr,'b> diff --git a/FsControl.Core/ErrorT.fs b/FsControl.Core/ErrorT.fs index 49d5592..d48f201 100644 --- a/FsControl.Core/ErrorT.fs +++ b/FsControl.Core/ErrorT.fs @@ -17,10 +17,10 @@ module ErrorT = let map f (ErrorT m) = ErrorT(f m) type ErrorT<'R> with - static member inline instance (Functor.Map, ErrorT x :ErrorT<'ma>, _) = fun (f) -> ErrorT (Functor.fmap (Error.map f) x) :ErrorT<'mb> + static member inline instance (_:Functor.Map, ErrorT x :ErrorT<'ma>, _) = fun (f) -> ErrorT (Functor.fmap (Error.map f) x) :ErrorT<'mb> static member inline instance (Applicative.Pure, _:ErrorT<'ma>) = ErrorT << return' << Choice1Of2 :'a -> ErrorT<'ma> - static member inline instance (Applicative.Apply, ErrorT(f:'ma_b), ErrorT(x:'ma), _:ErrorT<'mb>) = fun () -> + static member inline instance (_:Applicative.Apply, ErrorT(f:'ma_b), ErrorT(x:'ma), _:ErrorT<'mb>) = fun () -> ErrorT(fmap (<*>) f <*> x) :ErrorT<'mb> static member inline instance (Monad.Bind , ErrorT x :ErrorT<'ma>, _:ErrorT<'mb>) = fun (f: 'a -> ErrorT<'mb>) -> (ErrorT <| do'() { diff --git a/FsControl.Core/Functor.fs b/FsControl.Core/Functor.fs index 22694d0..87a1cd0 100644 --- a/FsControl.Core/Functor.fs +++ b/FsControl.Core/Functor.fs @@ -31,6 +31,21 @@ module Monad = let inline internal (>>=) x (f:_->'R) : 'R = Inline.instance (Bind, x) f + type JoinDefault() = + static member inline instance (_:JoinDefault, x:#obj, _:#obj) = fun () -> x >>= id :#obj + + type Join() = + inherit JoinDefault() + static member instance (_:Join, x:option> , _:option<'a> ) = fun () -> Option.bind id x + static member instance (_:Join, x:List<_> , _:List<'b> ) = fun () -> List.collect id x + static member instance (_:Join, x:'b [] [] , _:'b [] ) = fun () -> Array.collect id x + + let Join = Join() + + let inline internal join (x:'Monad'Monad'a) : 'Monad'a = Inline.instance (Join, x) () + + + open Monad module Applicative = @@ -58,37 +73,41 @@ module Applicative = type DefaultImpl = static member inline ApplyFromMonad f x = f >>= fun x1 -> x >>= fun x2 -> pure'(x1 x2) - type Apply = Apply with - static member instance (Apply, f:List<_> , x:List<'a> , _:List<'b> ) = fun () -> DefaultImpl.ApplyFromMonad f x :List<'b> - static member instance (Apply, f:_ [] , x:'a [] , _:'b [] ) = fun () -> DefaultImpl.ApplyFromMonad f x :'b [] - static member instance (Apply, f:'r -> _ , g: _ -> 'a , _: 'r -> 'b ) = fun () -> fun x -> f x (g x) :'b - static member inline instance (Apply, (a:'m, f) , (b:'m, x:'a) , _:'m * 'b ) = fun () -> (mappend a b, f x) :'m *'b - static member instance (Apply, f:Async<_> , x:Async<'a> , _:Async<'b> ) = fun () -> DefaultImpl.ApplyFromMonad f x :Async<'b> + type ApplyDefault() = + static member inline instance (_:ApplyDefault, f:#obj , x, _:#obj) = fun () -> (f >>= fun x1 -> x >>= fun x2 -> pure'(x1 x2)) - static member instance (Apply, f:option<_> , x:option<'a> , _:option<'b> ) = fun () -> + type Apply() = + inherit ApplyDefault() + static member instance (_:Apply, f:List<_> , x:List<'a> , _:List<'b> ) = fun () -> DefaultImpl.ApplyFromMonad f x :List<'b> + static member instance (_:Apply, f:_ [] , x:'a [] , _:'b [] ) = fun () -> DefaultImpl.ApplyFromMonad f x :'b [] + static member instance (_:Apply, f:'r -> _ , g: _ -> 'a , _: 'r -> 'b ) = fun () -> fun x -> f x (g x) :'b + static member inline instance (_:Apply, (a:'m, f) , (b:'m, x:'a) , _:'m * 'b ) = fun () -> (mappend a b, f x) :'m *'b + static member instance (_:Apply, f:Async<_> , x:Async<'a> , _:Async<'b> ) = fun () -> DefaultImpl.ApplyFromMonad f x :Async<'b> + + static member instance (_:Apply, f:option<_> , x:option<'a> , _:option<'b> ) = fun () -> match (f,x) with | Some f, Some x -> Some (f x) | _ -> None :option<'b> - - static member instance (Apply, f:Choice<_,'e>, x:Choice<'a,'e>, _:Choice<'b,'e>) = fun () -> + + static member instance (_:Apply, f:Choice<_,'e>, x:Choice<'a,'e>, _:Choice<'b,'e>) = fun () -> match (f,x) with | (Choice1Of2 a, Choice1Of2 b) -> Choice1Of2 (a b) | (Choice2Of2 a, _) -> Choice2Of2 a | (_, Choice2Of2 b) -> Choice2Of2 b :Choice<'b,'e> - static member instance (Apply, KeyValue(k:'k,f), KeyValue(k:'k,x:'a), _:keyValue<'k,'b>) :unit->keyValue<'k,'b> = fun () -> keyValue(k, f x) - static member instance (Apply, f:Map<'k,_> , x:Map<'k,'a> , _:Map<'k,'b> ) :unit->Map<'k,'b> = fun () -> Map (seq { + static member instance (_:Apply, KeyValue(k:'k,f), KeyValue(k:'k,x:'a), _:keyValue<'k,'b>) :unit->keyValue<'k,'b> = fun () -> keyValue(k, f x) + static member instance (_:Apply, f:Map<'k,_> , x:Map<'k,'a> , _:Map<'k,'b> ) :unit->Map<'k,'b> = fun () -> Map (seq { for KeyValue(k, vf) in f do match Map.tryFind k x with | Some vx -> yield k, vf vx | _ -> () }) - static member instance (Apply, f:_ Expr , x:'a Expr , _:'b Expr ) = fun () -> <@ (%f) %x @> :'b Expr + static member instance (_:Apply, f:_ Expr , x:'a Expr , _:'b Expr ) = fun () -> <@ (%f) %x @> :'b Expr - static member instance (Apply, f:('a->'b) ResizeArray, x:'a ResizeArray, _:'b ResizeArray) = fun () -> + static member instance (_:Apply, f:('a->'b) ResizeArray, x:'a ResizeArray, _:'b ResizeArray) = fun () -> new ResizeArray<'b>(Seq.collect (fun x1 -> Seq.collect (fun x2 -> Seq.singleton (x1 x2)) x) f) :'b ResizeArray - + let Apply = Apply() let inline internal (<*>) x y = Inline.instance (Apply, x, y) () @@ -114,31 +133,37 @@ module Functor = static member inline MapFromApplicative f x = pure' f <*> x static member inline MapFromMonad f x = x >>= (pure' << f) - type Map = Map with - static member instance (Map, x:option<_> , _) = fun f -> Option.map f x - static member instance (Map, x:List<_> , _:List<'b>) = fun f -> List.map f x :List<'b> - static member instance (Map, g:_->_ , _) = (>>) g - static member instance (Map, (m,a) , _) = fun f -> (m, f a) - static member instance (Map, x:_ [] , _) = fun f -> Array.map f x - static member instance (Map, x:_ [,] , _) = fun f -> Array2D.map f x - static member instance (Map, x:_ [,,] , _) = fun f -> Array3D.map f x - static member instance (Map, x:_ [,,,] , _) = fun f -> + type MapDefault() = + static member inline instance (_:MapDefault, x:'f when 'f :> obj, _:'r when 'r :> obj) = fun (f:'a->'b) -> pure' f <*> x :'r + + type Map() = + inherit MapDefault() + static member instance (_:Map, x:option<_> , _) = fun f -> Option.map f x + static member instance (_:Map, x:List<_> , _:List<'b>) = fun f -> List.map f x :List<'b> + static member instance (_:Map, g:_->_ , _) = (>>) g + static member instance (_:Map, (m,a) , _) = fun f -> (m, f a) + static member instance (_:Map, x:_ [] , _) = fun f -> Array.map f x + static member instance (_:Map, x:_ [,] , _) = fun f -> Array2D.map f x + static member instance (_:Map, x:_ [,,] , _) = fun f -> Array3D.map f x + static member instance (_:Map, x:_ [,,,] , _) = fun f -> Array4D.init (x.GetLength 0) (x.GetLength 1) (x.GetLength 2) (x.GetLength 3) (fun a b c d -> f x.[a,b,c,d]) - static member instance (Map, x:Async<_> , _) = fun f -> DefaultImpl.MapFromMonad f x - static member instance (Map, x:Choice<_,_> , _) = fun f -> Error.map f x - static member instance (Map, KeyValue(k, x) , _) = fun (f:'b->'c) -> keyValue(k, f x) - static member instance (Map, x:Map<'a,'b> , _) = fun (f:'b->'c) -> Map.map (const' f) x : Map<'a,'c> - static member instance (Map, x:Expr<_> , _) = fun f -> <@ f %x @> - static member instance (Map, x:_ ResizeArray, _) = fun f -> new ResizeArray<'b>(Seq.map f x) - static member instance (Map, x:_ IObservable, _) = fun f -> Observable.map f x + static member instance (_:Map, x:Async<_> , _) = fun f -> DefaultImpl.MapFromMonad f x + static member instance (_:Map, x:Choice<_,_> , _) = fun f -> Error.map f x + static member instance (_:Map, KeyValue(k, x) , _) = fun (f:'b->'c) -> keyValue(k, f x) + static member instance (_:Map, x:Map<'a,'b> , _) = fun (f:'b->'c) -> Map.map (const' f) x : Map<'a,'c> + static member instance (_:Map, x:Expr<_> , _) = fun f -> <@ f %x @> + static member instance (_:Map, x:_ ResizeArray, _) = fun f -> new ResizeArray<'b>(Seq.map f x) + static member instance (_:Map, x:_ IObservable, _) = fun f -> Observable.map f x // Restricted - static member instance (Map, x:Nullable<_> , _) = fun f -> if x.HasValue then Nullable(f x.Value) else Nullable() - static member instance (Map, x:string , _) = fun f -> String.map f x - static member instance (Map, x:StringBuilder, _) = fun f -> new StringBuilder(String.map f (x.ToString())) - static member instance (Map, x:Set<_> , _) = fun f -> Set.map f x + static member instance (_:Map, x:Nullable<_> , _) = fun f -> if x.HasValue then Nullable(f x.Value) else Nullable() + static member instance (_:Map, x:string , _) = fun f -> String.map f x + static member instance (_:Map, x:StringBuilder, _) = fun f -> new StringBuilder(String.map f (x.ToString())) + static member instance (_:Map, x:Set<_> , _) = fun f -> Set.map f x + let Map = Map() + let inline internal fmap f x = Inline.instance (Map, x) f @@ -183,20 +208,42 @@ module Comonad = let inline internal extract x = Inline.instance (Extract, x) () - type Duplicate = Duplicate with - static member instance (Duplicate, (w:'w, a:'a), _:'w * ('w*'a)) = fun () -> (w,(w,a)) - static member inline instance (Duplicate, f:'m->'a, _:'m->'m->'a) = fun () a b -> f (mappend a b) + type Extend = Extend with + static member instance (Extend, (w:'w, a:'a), _:'w *'b) = fun (f:_->'b) -> (w, f (w,a)) + static member inline instance (Extend, (g:'m -> 'a), _:'m->'b) = fun (f:_->'b) a -> f (fun b -> g (mappend a b)) // Restricted - static member instance (Duplicate, s:List<'a>, _:List>) = fun () -> + static member instance (Extend, s:List<'a>, _:List<'b>) = fun g -> let rec tails = function [] -> [] | x::xs as s -> s::(tails xs) - tails s + List.map g (tails s) - let inline internal duplicate x = Inline.instance (Duplicate, x) () + static member instance (Extend, s:'a [], _:'b []) = fun g -> + let rec tails = function [] -> [] | x::xs as s -> s::(tails xs) + Array.map g (s |> Array.toList |> tails |> List.toArray |> Array.map List.toArray) + + let inline internal extend g s = Inline.instance (Extend, s) g + let inline internal (=>>) s g = extend g s + type DuplicateDefault() = + static member inline instance (_:DuplicateDefault, x:#obj, _:#obj) = fun () -> extend id x :#obj - let inline internal extend g s = fmap g (duplicate s) - let inline internal (=>>) s g = fmap g (duplicate s) + type Duplicate() = + inherit DuplicateDefault() + static member instance (_:Duplicate, (w:'w, a:'a), _:'w * ('w*'a)) = fun () -> (w, (w, a)) + static member inline instance (_:Duplicate, f:'m -> 'a , _:'m->'m->'a ) = fun () a b -> f (mappend a b) + + // Restricted + static member instance (_:Duplicate, s:List<'a>, _:List>) = fun () -> + let rec tails = function [] -> [] | x::xs as s -> s::(tails xs) + tails s + + static member instance (_:Duplicate, s: array<'a>, _: array>) = fun () -> + let rec tails = function [] -> [] | x::xs as s -> s::(tails xs) + s |> Array.toList |> tails |> List.toArray |> Array.map List.toArray + + let Duplicate = Duplicate() + + let inline internal duplicate x = Inline.instance (Duplicate, x) () // MonadPlus class ------------------------------------------------------------ @@ -212,4 +259,4 @@ module MonadPlus = static member instance (Mplus, x:_ [] , _) = fun y -> Array.append x y let inline internal mzero () = Inline.instance Mzero () - let inline internal mplus (x:'a) (y:'a) : 'a = Inline.instance (Mplus, x) y + let inline internal mplus (x:'a) (y:'a) : 'a = Inline.instance (Mplus, x) y \ No newline at end of file diff --git a/FsControl.Core/MonadTrans.fs b/FsControl.Core/MonadTrans.fs index 8e1b971..e11e58e 100644 --- a/FsControl.Core/MonadTrans.fs +++ b/FsControl.Core/MonadTrans.fs @@ -14,9 +14,9 @@ module OptionT = let map f (OptionT m) = OptionT (f m) type OptionT<'Ma> with - static member inline instance (Functor.Map, OptionT x :OptionT<'ma>, _) = fun (f:'a->'b) -> OptionT (fmap (Option.map f) x) :OptionT<'mb> + static member inline instance (_:Functor.Map , OptionT x :OptionT<'ma>, _) = fun (f:'a->'b) -> OptionT (fmap (Option.map f) x) :OptionT<'mb> static member inline instance (Applicative.Pure, _:OptionT<'ma>) = OptionT << return' << Some :'a -> OptionT<'ma> - static member inline instance (Applicative.Apply, OptionT(f), OptionT(x), _:OptionT<'r>) = fun () -> + static member inline instance (_:Applicative.Apply, OptionT(f), OptionT(x), _:OptionT<'r>) = fun () -> OptionT(fmap (<*>) f <*> x) :OptionT<'r> static member inline instance (Monad.Bind , OptionT x :OptionT<'ma>, _:OptionT<'mb>) = fun (f: 'a -> OptionT<'mb>) -> (OptionT <| do'() { @@ -36,9 +36,9 @@ module ListT = let map f (ListT m) = ListT (f m) type ListT<'Ma> with - static member inline instance (Functor.Map , ListT x:ListT<'ma>, _) = fun (f:'a->'b) -> ListT (fmap (List.map f) x):ListT<'mb> - static member inline instance (Applicative.Pure, _:ListT<'ma>) = ListT << return' << singleton :'a -> ListT<'ma> - static member inline instance (Applicative.Apply, ListT(f), ListT(x), _:ListT<'r>) = fun () -> + static member inline instance (_:Functor.Map , ListT x:ListT<'ma>, _) = fun (f:'a->'b) -> ListT (fmap (List.map f) x):ListT<'mb> + static member inline instance (Applicative.Pure, _:ListT<'ma>) = ListT << return' << singleton :'a -> ListT<'ma> + static member inline instance (_:Applicative.Apply, ListT(f), ListT(x), _:ListT<'r>) = fun () -> ListT(fmap (<*>) f <*> x) :ListT<'r> static member inline instance (Monad.Bind , ListT x:ListT<'ma>, _:ListT<'mb>) = fun (k: 'a -> ListT<'mb>) -> diff --git a/FsControl.Core/Reader.fs b/FsControl.Core/Reader.fs index 965e347..4ea5601 100644 --- a/FsControl.Core/Reader.fs +++ b/FsControl.Core/Reader.fs @@ -13,7 +13,7 @@ module Reader = let ask() = Reader id type Reader<'R,'A> with - static member instance (Functor.Map , Reader m:Reader<'r,'a>, _) = fun (f:_->'b) -> Reader(fun r -> f (m r)) + static member instance (_:Functor.Map, Reader m:Reader<'r,'a>, _) = fun (f:_->'b) -> Reader(fun r -> f (m r)) static member instance (Applicative.Pure, _:Reader<'r,'a> ) = fun a -> Reader(fun _ -> a) :Reader<'r,'a> static member instance (Monad.Bind , Reader m, _:Reader<'r,'b>) = fun k -> Reader(fun r -> Reader.run(k (m r)) r) :Reader<'r,'b> - static member instance (Applicative.Apply, f:Reader<'r,_>, x:Reader<'r,'a>, _:Reader<'r,'b>) = fun () -> DefaultImpl.ApplyFromMonad f x :Reader<'r,'b> \ No newline at end of file + static member instance (_:Applicative.Apply, f:Reader<'r,_>, x:Reader<'r,'a>, _:Reader<'r,'b>) = fun () -> DefaultImpl.ApplyFromMonad f x :Reader<'r,'b> \ No newline at end of file diff --git a/FsControl.Core/ReaderT.fs b/FsControl.Core/ReaderT.fs index ccad706..dde8f15 100644 --- a/FsControl.Core/ReaderT.fs +++ b/FsControl.Core/ReaderT.fs @@ -17,7 +17,7 @@ module ReaderT = let map f (ReaderT m) = ReaderT(f << m) type ReaderT<'R,'Ma> with - static member inline instance (Functor.Map , ReaderT m , _) = fun f -> ReaderT <| fun r -> do'(){ + static member inline instance (_:Functor.Map , ReaderT m , _) = fun f -> ReaderT <| fun r -> do'(){ let! a = m r return (f a)} diff --git a/FsControl.Core/State.fs b/FsControl.Core/State.fs index 4816da6..9e5787a 100644 --- a/FsControl.Core/State.fs +++ b/FsControl.Core/State.fs @@ -15,7 +15,7 @@ module State = let put x = State (fun _ -> ((), x)) :State<'s,_> type State<'S,'A> with - static member instance (Functor.Map , State m, _) = fun f -> State(fun s -> let (a, s') = m s in (f a, s')) :State<'s,_> + static member instance (_:Functor.Map , State m, _) = fun f -> State(fun s -> let (a, s') = m s in (f a, s')) :State<'s,_> static member instance (Applicative.Pure, _:State<'s,'a> ) = fun a -> State(fun s -> (a, s)) :State<'s,'a> - static member instance (Monad.Bind , State m, _:State<'s,'b>) = fun k -> State(fun s -> let (a, s') = m s in State.run(k a) s') :State<'s,'b> - static member instance (Applicative.Apply, f:State<'s,_>, x:State<'s,'a>, _:State<'s,'b>) = fun () -> DefaultImpl.ApplyFromMonad f x :State<'s,'b> \ No newline at end of file + static member instance (Monad.Bind , State m, _:State<'s,'b>) = fun k -> State(fun s -> let (a, s') = m s in State.run(k a) s') :State<'s,'b> + static member instance (_:Applicative.Apply, f:State<'s,_>, x:State<'s,'a>, _:State<'s,'b>) = fun () -> DefaultImpl.ApplyFromMonad f x :State<'s,'b> \ No newline at end of file diff --git a/FsControl.Core/StateT.fs b/FsControl.Core/StateT.fs index ac80f45..9a2cc24 100644 --- a/FsControl.Core/StateT.fs +++ b/FsControl.Core/StateT.fs @@ -17,7 +17,7 @@ module StateT = let map f (StateT m) = StateT(f << m) type StateT<'S,'MaS> with - static member inline instance (Functor.Map, StateT m, _) = fun f -> StateT <| fun s -> do'(){ + static member inline instance (_:Functor.Map, StateT m, _) = fun f -> StateT <| fun s -> do'(){ let! (x, s') = m s return (f x, s')} diff --git a/FsControl.Core/Writer.fs b/FsControl.Core/Writer.fs index 4a39fd5..b7e8d11 100644 --- a/FsControl.Core/Writer.fs +++ b/FsControl.Core/Writer.fs @@ -17,7 +17,7 @@ module Writer = let pass (Writer((a, f), w)) = Writer( a, f w) :Writer<'w,_> type Writer<'W,'A> with - static member instance (Functor.Map, Writer(a,w), _) = fun f -> Writer(f a, w) :Writer<'w,_> + static member instance (_:Functor.Map , Writer(a,w), _) = fun f -> Writer(f a, w) :Writer<'w,_> static member inline instance (Applicative.Pure, _:Writer<'w,'a> ) = fun a -> Writer(a, mempty()) :Writer<'w,'a> static member inline instance (Monad.Bind , Writer(a, w), _:Writer<'w,'b>) = fun k -> Writer(let (b, w') = Writer.run(k a) in (b, mappend w w')) :Writer<'w,'b> - static member inline instance (Applicative.Apply, f:Writer<'w,_>, x:Writer<'w,'a>, _:Writer<'w,'b>) = fun () -> DefaultImpl.ApplyFromMonad f x :Writer<'w,'b> \ No newline at end of file + static member inline instance (_:Applicative.Apply, f:Writer<'w,_>, x:Writer<'w,'a>, _:Writer<'w,'b>) = fun () -> DefaultImpl.ApplyFromMonad f x :Writer<'w,'b> \ No newline at end of file diff --git a/FsControl.Core/WriterT.fs b/FsControl.Core/WriterT.fs index 71ce099..14c0ebd 100644 --- a/FsControl.Core/WriterT.fs +++ b/FsControl.Core/WriterT.fs @@ -22,12 +22,12 @@ module WriterT = return w} type WriterT<'WMa> with - static member inline instance (Functor.Map, WriterT m, _) = fun f -> WriterT <| do'(){ + static member inline instance (_:Functor.Map, WriterT m, _) = fun f -> WriterT <| do'(){ let! (a, w) = m return (f a, w)} - static member inline instance (Applicative.Pure, _:WriterT<'wma>) :'a -> WriterT<'wma> = fun a -> WriterT (return' (a, mempty())) - static member inline instance (Applicative.Apply, WriterT(f), WriterT(x), _:WriterT<'r>) = fun () -> + static member inline instance (Applicative.Pure , _:WriterT<'wma> ) :'a -> WriterT<'wma> = fun a -> WriterT (return' (a, mempty())) + static member inline instance (_:Applicative.Apply, WriterT(f), WriterT(x), _:WriterT<'r> ) = fun () -> WriterT(fmap (<*>) f <*> x) :WriterT<'r> static member inline instance (Monad.Bind, WriterT (m:'wma), _:WriterT<'wmb>) :('a -> WriterT<'wmb>) -> WriterT<'wmb> = fun k -> WriterT <| do'(){