arrows 0.4 → 0.4.1

raw patch · 10 files changed

+77/−30 lines, 10 filesdep ~base

Dependency ranges changed: base

Files

• Control/Arrow/Operations.hs +1/−0
• Control/Arrow/Transformer/Automaton.hs +9/−5
• Control/Arrow/Transformer/CoState.hs +8/−2
• Control/Arrow/Transformer/Error.hs +9/−3
• Control/Arrow/Transformer/Reader.hs +12/−6
• Control/Arrow/Transformer/State.hs +9/−2
• Control/Arrow/Transformer/Static.hs +8/−2
• Control/Arrow/Transformer/Stream.hs +10/−5
• Control/Arrow/Transformer/Writer.hs +9/−3
• arrows.cabal +2/−2

@@ -33,6 +33,7 @@ 	) where  import Control.Arrow+import Control.Category ((>>>)) import Data.Monoid  -- $conventions

@@ -21,10 +21,13 @@ import Control.Arrow.Transformer  import Control.Applicative-import Control.Arrow hiding (pure)+import Control.Arrow+import Control.Category import Data.Monoid import Data.Stream +import Prelude hiding (id,(.))+ -- | An arrow type comprising Mealy-style automata, each step of which is -- is a computation in the original arrow type. @@ -34,12 +37,13 @@ 	lift f = c 		where c = Automaton (f &&& arr (const c)) +instance Arrow a => Category (Automaton a) where+	id = lift id+	Automaton f . Automaton g =+		Automaton (arr (\((z, cf), cg) -> (z, cf . cg)) . first f . g)+ instance Arrow a => Arrow (Automaton a) where 	arr f = lift (arr f)-	Automaton f >>> Automaton g =-		Automaton (f >>>-			 first g >>>-			 arr (\((z, cg), cf) -> (z, cf >>> cg))) 	first (Automaton f) = 		Automaton (first f >>> 			 arr (\((x', c), y) -> ((x', y), first c)))

@@ -21,14 +21,20 @@ import Control.Arrow.Operations  import Control.Applicative-import Control.Arrow hiding (pure)+import Control.Arrow+import Control.Category import Data.Monoid +import Prelude hiding (id,(.))+ newtype CoStateArrow s a b c = CST (a (s -> b) (s -> c)) +instance Category a => Category (CoStateArrow s a) where+	id = CST id+	CST f . CST g = CST (f . g)+ instance Arrow a => Arrow (CoStateArrow s a) where 	arr f = CST (arr (f .))-	CST f >>> CST g = CST (f >>> g) 	first (CST f) = CST (arr unzipMap >>> first f >>> arr zipMap)  zipMap :: (s -> a, s -> b) -> (s -> (a,b))

@@ -25,9 +25,12 @@ import Control.Arrow.Transformer  import Control.Applicative-import Control.Arrow hiding (pure)+import Control.Arrow+import Control.Category import Data.Monoid +import Prelude hiding (id,(.))+ -- | An arrow that augments an existing arrow with possible errors. -- The 'ArrowError' class contains methods for raising and handling -- these errors.@@ -62,10 +65,13 @@  -- liftings of standard classes +instance ArrowChoice a => Category (ErrorArrow ex a) where+	id = ErrorArrow (arr Right)+	ErrorArrow f . ErrorArrow g =+		ErrorArrow (arr (either Left id) . right f . g)+ instance ArrowChoice a => Arrow (ErrorArrow ex a) where 	arr f = ErrorArrow (arr (Right . f))-	ErrorArrow f >>> ErrorArrow g =-		ErrorArrow (f >>> right g >>> arr (either Left id)) 	first (ErrorArrow f) = ErrorArrow (first f >>> arr rstrength)  instance ArrowChoice a => ArrowChoice (ErrorArrow ex a) where

@@ -23,12 +23,16 @@ import Control.Arrow.Transformer  import Control.Applicative-import Control.Arrow hiding (pure)+import Control.Arrow+import Control.Category import Data.Monoid +import Prelude hiding (id,(.))+ -- | An arrow type that augments an existing arrow with a read-only state -- (or environment).  The 'ArrowReader' class contains the operations -- on this state.+ newtype ReaderArrow r a b c = ReaderArrow (a (b, r) c)  -- | Encapsulation of a state-reading computation, taking a value for the@@ -49,11 +53,14 @@  -- liftings of standard classes +instance Arrow a => Category (ReaderArrow r a) where+	id = ReaderArrow (arr fst)+	ReaderArrow f . ReaderArrow g =+		ReaderArrow (f . first g . arr dupenv)+		where	dupenv (a, r) = ((a, r), r)+ instance Arrow a => Arrow (ReaderArrow r a) where 	arr f = ReaderArrow (arr (f . fst))-	ReaderArrow f >>> ReaderArrow g =-		ReaderArrow (arr dupenv >>> first f >>> g)-		where	dupenv (a, r) = ((a, r), r) 	first (ReaderArrow f) = ReaderArrow (arr swapsnd >>> first f)  swapsnd :: ((a, r), b) -> ((a, b), r)@@ -82,8 +89,7 @@  instance Arrow a => ArrowReader r (ReaderArrow r a) where 	readState = ReaderArrow (arr snd)-	newReader (ReaderArrow f) =-		ReaderArrow (arr (\((x, _), r) -> (x, r)) >>> f)+	newReader (ReaderArrow f) = ReaderArrow (arr fst >>> f)  instance Arrow a => ArrowAddReader r (ReaderArrow r a) a where 	liftReader = lift

@@ -25,19 +25,26 @@ import Control.Arrow.Transformer  import Control.Applicative-import Control.Arrow hiding (pure)+import Control.Arrow+import Control.Category import Data.Monoid +import Prelude hiding (id,(.))+ -- | An arrow type that augments an existing arrow with a modifiable -- state.  The 'ArrowState' class contains the operations on this state.+ newtype StateArrow s a b c = ST (a (b, s) (c, s))  swapsnd :: ((a, b), c) -> ((a, c), b) swapsnd ~(~(x, y), z) = ((x, z), y) +instance Category a => Category (StateArrow s a) where+	id = ST id+	ST f . ST g = ST (f . g)+ instance Arrow a => Arrow (StateArrow s a) where 	arr f = ST (arr (\(x, s) -> (f x, s)))-	ST f >>> ST g = ST (f >>> g) 	first (ST f) = ST (arr swapsnd >>> first f >>> arr swapsnd)  instance Arrow a => ArrowTransformer (StateArrow s) a where

@@ -22,10 +22,13 @@ import Control.Arrow.Transformer  import Control.Applicative-import Control.Arrow hiding (pure)+import Control.Arrow+import Control.Category import Control.Monad import Data.Monoid +import Prelude hiding (id,(.))+ -- | An arrow type that augments the underlying arrow with static information.  newtype StaticArrow f a b c = SA (f (a b c))@@ -33,9 +36,12 @@ instance (Arrow a, Applicative f) => ArrowTransformer (StaticArrow f) a where 	lift f = SA (pure f) +instance (Category a, Applicative f) => Category (StaticArrow f a) where+	id = SA (pure id)+	SA f . SA g = SA ((.) <$> f <*> g)+ instance (Arrow a, Applicative f) => Arrow (StaticArrow f a) where 	arr f = SA (pure (arr f))-	SA f >>> SA g = SA ((>>>) <$> f <*> g) 	first (SA f) = SA (first <$> f)  -- The following promotions follow directly from the arrow transformer.

@@ -24,23 +24,28 @@ import Control.Arrow.Operations import Control.Arrow.Transformer -import Data.Stream (Stream(..))-import qualified Data.Stream as Stream- import Control.Applicative-import Control.Arrow hiding (pure)+import Control.Arrow+import Control.Category import Control.Monad.ST import Data.Monoid+import Data.Stream (Stream(..))+import qualified Data.Stream as Stream +import Prelude hiding (id,(.))+ -- | Arrows between streams. -- -- /Note/: 'lift' is only a functor if '***' in the underlying arrow is.  newtype StreamArrow a b c = Str (a (Stream b) (Stream c)) +instance Category a => Category (StreamArrow a) where+	id = Str id+	Str f . Str g = Str (f . g)+ instance Arrow a => Arrow (StreamArrow a) where 	arr f = Str (arr (fmap f))-	Str f >>> Str g = Str (f >>> g) 	first (Str f) = 		Str (arr Stream.unzip >>> first f >>> arr (uncurry Stream.zip)) 

@@ -23,9 +23,12 @@ import Control.Arrow.Transformer  import Control.Applicative-import Control.Arrow hiding (pure)+import Control.Arrow+import Control.Category import Data.Monoid +import Prelude hiding (id,(.))+ -- | An arrow type that augments an existing arrow with accumulating -- output.  The 'ArrowWriter' class contains the relevant operations. @@ -58,10 +61,13 @@  -- liftings of standard classes +instance (Arrow a, Monoid w) => Category (WriterArrow w a) where+	id = WriterArrow (arr unit)+	WriterArrow f . WriterArrow g =+		WriterArrow (arr join . first f . g)+ instance (Arrow a, Monoid w) => Arrow (WriterArrow w a) where 	arr f = WriterArrow (arr (unit . f))-	WriterArrow f >>> WriterArrow g =-		WriterArrow (f >>> first g >>> arr join) 	first (WriterArrow f) = WriterArrow (first f >>> arr rstrength)  instance (ArrowChoice a, Monoid w) => ArrowChoice (WriterArrow w a) where

@@ -1,6 +1,6 @@ Name:           arrows-Version:        0.4-Build-Depends:  base >= 2.0 && < 3.1, Stream+Version:        0.4.1+Build-Depends:  base >= 4.0 && < 4.1, Stream Build-Type:     Simple License:        BSD3 License-file:   LICENSE