atl 15320.1 → 15321.1

raw patch · 5 files changed

+73/−6 lines, 5 files

Files

• Control/Arrow/Reader/Class.hs +4/−1
• Control/Arrow/State.hs +1/−3
• Control/Arrow/Writer.hs +46/−0
• Control/Arrow/Writer/Class.hs +20/−0
• atl.cabal +2/−2

@@ -11,4 +11,7 @@ };  asks :: (ArrowReader r s) => (r -> a) -> s () a;-asks x = ask >>> arr x;+asks = asksA . arr;++asksA :: (ArrowReader r s) => s r a -> s () a;+asksA x = ask >>> x;

@@ -6,6 +6,7 @@ import Control.Arrow.Transformer; import Control.Arrow.State.Class; import Control.Category;+import Util;  newtype StateT s r a b = StateT { runStateT :: r (a, s) (b, s) }; @@ -18,9 +19,6 @@   id = StateT id;   StateT x . StateT y = StateT (x . y); };--swap_snds_A :: Arrow r => r ((a, b), c) ((a, c), b);-swap_snds_A = arr $ \ ((x, y), z) -> ((x, z), y);  instance (Arrow r) => Arrow (StateT s r) where {   arr = StateT . arr . (*** id);

@@ -0,0 +1,46 @@+{-# LANGUAGE KindSignatures, ScopedTypeVariables #-}++module Control.Arrow.Writer (module Control.Arrow.Writer.Class, WriterT (..)) where++import Prelude hiding ((.), id);++import Control.Arrow;+import Control.Arrow.Transformer;+import Control.Arrow.Writer.Class;+import Control.Category;+import Data.Monoid;+import Util;++newtype WriterT w r a b = WriterT { runWriterT :: r a (b, w) };++instance Monoid w => ArrowTransformer (WriterT w) where {+  lift = WriterT . (&&& arr (const mempty));+  tmap f = WriterT . f . runWriterT;+};++instance (Monoid w, Arrow r) => Category (WriterT w r) where {+  id = lift id;+  WriterT x . WriterT y = WriterT $+                          arr (\ ((v, w2), w1) -> (v, w1 `mappend` w2)) <<< x *** id <<< y;+};++instance (Monoid w, Arrow r) => Arrow (WriterT w r) where {+  arr = WriterT . arr . (&&& const mempty);+  first = WriterT . (.) swap_snds_A . first . runWriterT;+};++instance (Monoid w, ArrowApply r) => ArrowApply (WriterT w r) where {+  app = WriterT $ arr runWriterT *** id >>> app;+};++instance (Monoid w, Arrow r) => ArrowWriter w (WriterT w r) where {+  tell = WriterT $ constA () &&& id;+  look = lift (runWriterT id);+  censor = withWriterT;+};++withWriterTA :: (Arrow r) => r x w -> WriterT x r a b -> WriterT w r a b;+withWriterTA a = WriterT . (>>> id *** a) . runWriterT;++withWriterT :: (Arrow r) => (x -> w) -> WriterT x r a b -> WriterT w r a b;+withWriterT = withWriterTA . arr;

@@ -0,0 +1,20 @@+{-# LANGUAGE FunctionalDependencies #-}++module Control.Arrow.Writer.Class where++import Prelude hiding ((.), id);++import Control.Arrow;+import Control.Category;++class Arrow r => ArrowWriter w r | r -> w where {+  tell :: r w ();+  look :: r a (a, w);+  censor :: (w -> w) -> r a b -> r a b;+};++looksA :: ArrowWriter w r => r w b -> r a (a, b);+looksA x = look >>> id *** x;++looks :: ArrowWriter w r => (w -> b) -> r a (a, b);+looks = looksA . arr;

@@ -1,5 +1,5 @@ Name:atl-Version:15320.1+Version:15321.1 Description:Arrow Transformer Library License:LGPL License-File:license.txt@@ -13,5 +13,5 @@ Library {   Build-Depends: base >= 4 && < 5   Extensions: UnicodeSyntax, RankNTypes, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts-  Exposed-Modules: Control.Arrow.Transformer, Control.Arrow.Reader, Control.Arrow.Reader.Class, Control.Arrow.List.Class, Control.Arrow.Abort, Control.Arrow.Abort.Class, Control.Arrow.State, Control.Arrow.State.Class+  Exposed-Modules: Control.Arrow.Transformer, Control.Arrow.Reader, Control.Arrow.Reader.Class, Control.Arrow.List.Class, Control.Arrow.Abort, Control.Arrow.Abort.Class, Control.Arrow.State, Control.Arrow.State.Class, Control.Arrow.Writer, Control.Arrow.Writer.Class }