packages feed

arrows (empty) → 0.2

raw patch · 16 files changed

+1574/−0 lines, 16 filesdep +basebuild-type:Customsetup-changed

Dependencies added: base

Files

+ Control/Arrow/Internals.hs view
@@ -0,0 +1,256 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Internals+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- Manipulation of composite arrow types, beyond the basic lifting and+-- encapsulation provided with each arrow transformer.+--+-- The signatures are designed to be compatible with the proposed notation+-- for arrows, cf. <http://www.haskell.org/arrows/>.++-- #hide+module Control.Arrow.Internals (+		ArrowAddState(..),+		ArrowAddReader(..),+		ArrowAddWriter(..),+		ArrowAddError(..),+		ArrowAddStream(..),+	) where++import Control.Arrow+import Control.Arrow.Operations+import Data.Stream++-- | Adding a 'Control.Arrow.Transformer.State.StateArrow' to an+-- arrow type, but not necessarily as the outer arrow transformer.+--+-- Typically a composite arrow type is built by applying a series+-- of arrow transformer to a base arrow (usually either a function+-- arrow or a 'Kleisli' arrow.  One can add a transformer to the+-- top of this stack using the 'Control.Arrow.Transformer.lift'+-- method of the 'Control.Arrow.Transformer.ArrowTransformer' class,+-- or remove a state transformer from the top of the stack using the+-- 'Control.Arrow.Transformer.State.runState' encapsulation operator.+-- The methods of this class add and remove state transformers anywhere+-- in the stack.  In the instance+--+-- >	instance Arrow a => ArrowAddState s (ArrowState s a) a+--+-- they are equivalent to 'Control.Arrow.Transformer.lift' and+-- 'Control.Arrow.Transformer.State.runState' respectively.+-- Instances are lifted through other transformers with+--+-- >	instance ArrowAddState s a a' =>+-- >		ArrowAddState s (FooArrow a) (FooArrow a')++class (ArrowState s a, Arrow a') => ArrowAddState s a a' | a -> a' where++	-- | Lift a computation from an arrow to one with an added state.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		(|liftState cmd|)++	liftState :: a' e b -> a e b++	-- | Elimination of a state transformer from a computation,+	-- exposing the initial and final states.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> do+	-- >		...+	-- >		(result, final_state) <- (|elimState cmd|) init_state++	elimState :: a e b -> a' (e,s) (b,s)++-- | Adding a 'Control.Arrow.Transformer.Reader.ReaderArrow' to an+-- arrow type, but not necessarily as the outer arrow transformer.+--+-- Typically a composite arrow type is built by applying a series+-- of arrow transformer to a base arrow (usually either a function+-- arrow or a 'Kleisli' arrow.  One can add a transformer to the+-- top of this stack using the 'Control.Arrow.Transformer.lift'+-- method of the 'Control.Arrow.Transformer.ArrowTransformer' class,+-- or remove a state transformer from the top of the stack using the+-- 'Control.Arrow.Transformer.Reader.runReader' encapsulation operator.+-- The methods of this class add and remove state transformers anywhere+-- in the stack.  In the instance+--+-- >	instance Arrow a => ArrowAddReader r (ArrowReader r a) a+--+-- they are equivalent to 'Control.Arrow.Transformer.lift' and+-- 'Control.Arrow.Transformer.Reader.runReader' respectively.+-- Instances are lifted through other transformers with+--+-- >	instance ArrowAddReader r a a' =>+-- >		ArrowAddReader r (FooArrow a) (FooArrow a')++class (ArrowReader r a, Arrow a') => ArrowAddReader r a a' | a -> a' where++	-- | Lift a computation from an arrow to one with an added environment.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		(|liftReader cmd|)++	liftReader :: a' e b -> a e b++	-- | Elimination of a state reader from a computation,+	-- taking a value for the state.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		(|elimReader cmd|) env++	elimReader :: a e b -> a' (e,r) b++-- | Adding a 'Control.Arrow.Transformer.Writer.WriterArrow' to an+-- arrow type, but not necessarily as the outer arrow transformer.+--+-- Typically a composite arrow type is built by applying a series+-- of arrow transformer to a base arrow (usually either a function+-- arrow or a 'Kleisli' arrow.  One can add a transformer to the+-- top of this stack using the 'Control.Arrow.Transformer.lift'+-- method of the 'Control.Arrow.Transformer.ArrowTransformer' class,+-- or remove a state transformer from the top of the stack using the+-- 'Control.Arrow.Transformer.Writer.runWriter' encapsulation operator.+-- The methods of this class add and remove state transformers anywhere+-- in the stack.  In the instance+--+-- >	instance Arrow a => ArrowAddWriter w (ArrowWriter w a) a+--+-- they are equivalent to 'Control.Arrow.Transformer.lift' and+-- 'Control.Arrow.Transformer.Writer.runWriter' respectively.+-- Instances are lifted through other transformers with+--+-- >	instance ArrowAddWriter w a a' =>+-- >		ArrowAddWriter w (FooArrow a) (FooArrow a')++class (ArrowWriter w a, Arrow a') => ArrowAddWriter w a a' | a -> a' where++	-- | Lift a computation from an arrow to one with added output.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		(|liftWriter cmd|)++	liftWriter :: a' e b -> a e b++	-- | Elimination of an output writer from a computation,+	-- providing the accumulated output.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> do+	-- >		...+	-- >		(result, output) <- (|elimWriter cmd|)++	elimWriter :: a e b -> a' e (b,w)++-- | Adding a 'Control.Arrow.Transformer.Error.ErrorArrow' to an+-- arrow type, but not necessarily as the outer arrow transformer.+--+-- Typically a composite arrow type is built by applying a series+-- of arrow transformer to a base arrow (usually either a function+-- arrow or a 'Kleisli' arrow.  One can add a transformer to the+-- top of this stack using the 'Control.Arrow.Transformer.lift'+-- method of the 'Control.Arrow.Transformer.ArrowTransformer' class,+-- or remove a state transformer from the top of the stack using the+-- 'Control.Arrow.Transformer.Error.runError' encapsulation operator.+-- The methods of this class add and remove state transformers anywhere+-- in the stack.  In the instance+--+-- >	instance Arrow a => ArrowAddError ex (ArrowError ex a) a+--+-- they are equivalent to 'Control.Arrow.Transformer.lift' and+-- 'Control.Arrow.Transformer.Error.runError' respectively.+-- Instances are lifted through other transformers with+--+-- >	instance ArrowAddError ex a a' =>+-- >		ArrowAddError ex (FooArrow a) (FooArrow a')+--+-- This could be combined with 'Control.Arrow.Transformer.Error.handle',+-- since the resulting arrow is always the arrow of the handler.+-- Separating them has the advantage of consistency with the other arrows,+-- and might give more helpful type error messages.++class (ArrowError ex a, Arrow a') => ArrowAddError ex a a' | a -> a' where++	-- | Lift a computation from an arrow to one with error handling.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		(|liftError cmd|)++	liftError :: a' e b -> a e b++	-- | Elimination of errors from a computation,+	-- by completely handling any errors.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		body `elimError` \ex -> handler++	elimError :: a e b -> a' (e,ex) b -> a' e b++-- | Adding a 'Control.Arrow.Transformer.Stream.StreamArrow' to an+-- arrow type, but not necessarily as the outer arrow transformer.+--+-- Typically a composite arrow type is built by applying a series+-- of arrow transformer to a base arrow (usually either a function+-- arrow or a 'Kleisli' arrow.  One can add a transformer to the+-- top of this stack using the 'Control.Arrow.Transformer.lift'+-- method of the 'Control.Arrow.Transformer.ArrowTransformer' class,+-- or remove a state transformer from the top of the stack using the+-- 'Control.Arrow.Transformer.Stream.runStream' encapsulation operator.+-- The methods of this class add and remove state transformers anywhere+-- in the stack.  In the instance+--+-- >	instance Arrow a => ArrowAddStream (ArrowStream a) a+--+-- they are equivalent to 'Control.Arrow.Transformer.lift' and+-- 'Control.Arrow.Transformer.Stream.runStream' respectively.+-- Instances are lifted through other transformers with+--+-- >	instance ArrowAddStream a a' =>+-- >		ArrowAddStream (FooArrow a) (FooArrow a')++class (ArrowCircuit a, Arrow a') => ArrowAddStream a a' | a -> a' where++	-- | Lift a computation from an arrow to a stream processing one.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		(|liftStream cmd|)++	liftStream :: a' e b -> a e b++	-- | Run a stream processor on a stream of inputs,+	-- obtaining a stream of outputs.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> do+	-- >		...+	-- >		ys <- (|elimStream (\x -> ...)|) xs+	--+	-- Here @xs@ refers to the input stream and @x@ to individual+	-- elements of that stream.  @ys@ is bound to the output stream.++	elimStream :: a (e,b) c -> a' (e,Stream b) (Stream c)
+ Control/Arrow/Operations.hs view
@@ -0,0 +1,171 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Operations+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- Subclasses of 'Arrow' providing additional operations.+--+-- The signatures are designed to be compatible with the proposed+-- notation for arrows, cf. <http://www.haskell.org/arrows/>.++module Control.Arrow.Operations (+		-- * Conventions+		-- $conventions++		-- * State transformers+		ArrowState(..),+		-- * State readers+		ArrowReader(..),+		-- * Monoid writers+		ArrowWriter(..),+		-- * Errors+		ArrowError(..),+		tryInUnlessDefault,+		-- * Synchronous circuits+		ArrowCircuit(..),+	) where++import Control.Arrow+import Data.Monoid++-- $conventions+-- The arrow classes defined in this module have names like @Arrow@/Foo/,+-- and contain operations specific to such arrows.  Some of these include+-- a method @new@/Foo/, which maps computations to computations of the+-- same arrow type, but exposing some of the internals of the arrow.+--+-- Arrow transformers have names like /Bar/@Arrow@, and are+-- instances of appropriate arrow classes.  For each arrow+-- transformer, there is typically an encapsulation operator+-- @run@/Bar/ that removes that transformer from the outside of an+-- arrow type.  The 'Control.Arrow.Transformer.lift' method of the+-- 'Control.Arrow.Transformer.ArrowTransformer' class adds an arrow+-- transformer to the outside of an arrow type.+--+-- Typically a composite arrow type is built by applying a series of arrow+-- transformers to a base arrow (usually either a function arrow or a+-- 'Kleisli' arrow.  The 'Control.Arrow.Transformer.lift' method and the+-- @run@/Bar/ function operate only on the arrow transformer at the top+-- of this stack.  For more sophisticated manipulation of this stack of+-- arrow transformers, many arrow transformers provide an @ArrowAdd@/Bar/+-- class, with methods methods @lift@/Bar/ and @elim@/Bar/ to add and remove+-- the transformer anywhere in the stack.++-- | An arrow type that provides a read-only state (an environment).+-- If you also need to modify the state, use 'ArrowState'.++class Arrow a => ArrowReader r a | a -> r where+	-- | Obtain the current value of the state.+	readState :: a b r++	-- | Run a subcomputation in the same arrow, but with a different+	-- environment.  The environment of the outer computation is+	-- unaffected.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		(|newReader cmd|) env++	newReader :: a e b -> a (e,r) b++-- | An arrow type that provides a modifiable state,+-- based of section 9 of /Generalising Monads to Arrows/, by John Hughes,+-- /Science of Computer Programming/ 37:67-111, May 2000.++class Arrow a => ArrowState s a | a -> s where+	-- | Obtain the current value of the state.+	fetch :: a e s+	-- | Assign a new value to the state.+	store :: a s ()++-- | An arrow type that collects additional output (of some 'Monoid' type).++class (Monoid w, Arrow a) => ArrowWriter w a | a -> w where+	-- | Add a piece of additional output.+	write :: a w ()++	-- | Run a subcomputation in the same arrow, making its additional+	-- output accessible.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> do+	-- >		...+	-- >		(value, output) <- (|newWriter cmd|)++	newWriter :: a e b -> a e (b,w)++-- | An arrow type that includes errors (or exceptions).+--+-- Minimal definition: 'raise' and 'tryInUnless'.+--+-- /TODO:/ the operations here are inconsistent with other arrow transformers.++class Arrow a => ArrowError ex a | a -> ex where+	-- | Raise an error.+	raise :: a ex b++	-- | Traditional exception construct.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		body `handle` \ex -> handler++	handle :: a e b		-- ^ computation that may raise errors+		-> a (e,ex) b	-- ^ computation to handle errors+		-> a e b+	handle f h = tryInUnless f (arr snd) h++	-- | Exception construct in the style of /Exceptional Syntax/,+	-- by Nick Benton and Andrew Kennedy, /JFP/ 11(4):395-410, July 2001.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		(|tryInUnless+	-- >			body+	-- >			(\res -> success)+	-- >			(\ex -> handler)+	-- >		|)+	tryInUnless :: a e b	-- ^ computation that may raise errors+		-> a (e,b) c	-- ^ computation to receive successful results+		-> a (e,ex) c	-- ^ computation to handle errors+		-> a e c++	-- | Handler that returns the error as a value.+	newError :: a e b -> a e (Either ex b)+	newError f = handle (f >>> arr Right) (arr (Left . snd))++-- | A suitable value for 'tryInUnless' when the arrow type belongs to+-- 'ArrowChoice'.  To use it, you must define either 'handle' or 'newError'.++tryInUnlessDefault :: (ArrowError ex a, ArrowChoice a) =>+		a e b		-- ^ computation that may raise errors+		-> a (e,b) c	-- ^ computation to receive successful results+		-> a (e,ex) c	-- ^ computation to handle errors+		-> a e c+tryInUnlessDefault f s h = arr id &&& newError f >>> arr dist >>> h ||| s+	where	dist (e, Left ex) = Left (e, ex)+		dist (e, Right b) = Right (e, b)++-- tryInUnless (and thus handle) could be replaced by newError if:+-- 1. When ArrowChoice is available, tryInUnless and newError are equivalent.+-- 2. When tryInUnless is available, so is ArrowChoice.+--    (Counterexample: general CoKleisli)++-- | An arrow type that can be used to interpret synchronous circuits.++class ArrowLoop a => ArrowCircuit a where+	-- | A delay component.+	delay :: b		-- ^ the value to return initially.+		-> a b b	-- ^ an arrow that propagates its input+				-- with a one-tick delay.
+ Control/Arrow/Transformer.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Transformer+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- Arrow transformers, for making new arrow types out of old ones.++module Control.Arrow.Transformer (+		ArrowTransformer(..)+	) where++import Control.Arrow++-- | Construct a new arrow from an existing one.+class (Arrow a, Arrow (f a)) => ArrowTransformer f a where++	-- | A transformation of arrows, preserving 'arr', '>>>' and 'first'.+	--+	-- Typical usage in arrow notation:+	--+	-- >	proc p -> ...+	-- >		(|lift cmd|)++	lift :: a b c -> f a b c
+ Control/Arrow/Transformer/All.hs view
@@ -0,0 +1,20 @@+-- #hide+module Control.Arrow.Transformer.All(+	module Control.Arrow.Transformer.Automaton,+	module Control.Arrow.Transformer.CoState,+	module Control.Arrow.Transformer.Error,+	module Control.Arrow.Transformer.Reader,+	module Control.Arrow.Transformer.State,+	module Control.Arrow.Transformer.Static,+	module Control.Arrow.Transformer.Stream,+	module Control.Arrow.Transformer.Writer+	) where++import Control.Arrow.Transformer.Automaton+import Control.Arrow.Transformer.CoState+import Control.Arrow.Transformer.Error+import Control.Arrow.Transformer.Reader+import Control.Arrow.Transformer.State+import Control.Arrow.Transformer.Static+import Control.Arrow.Transformer.Stream+import Control.Arrow.Transformer.Writer
+ Control/Arrow/Transformer/Automaton.hs view
@@ -0,0 +1,151 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Transformer.Automaton+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- Simple Mealy-style automata.++module Control.Arrow.Transformer.Automaton(+		Automaton, runAutomaton,+	) where++import Control.Arrow+import Control.Arrow.Internals+import Control.Arrow.Operations+import Control.Arrow.Transformer+import Data.Stream++-- | An arrow type comprising Mealy-style automata, each step of which is+-- is a computation in the original arrow type.++newtype Automaton a b c = Automaton (a b (c, Automaton a b c))++instance Arrow a => ArrowTransformer Automaton a where+	lift f = c+		where c = Automaton (f &&& arr (const c))++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)))++instance ArrowChoice a => ArrowChoice (Automaton a) where+	left (Automaton f) = left_f+		where	left_f = Automaton (left f >>> arr combine)+			combine (Left (y, cf)) = (Left y, left cf)+			combine (Right z) = (Right z, left_f)++instance ArrowZero a => ArrowZero (Automaton a) where+	zeroArrow = Automaton zeroArrow++instance ArrowPlus a => ArrowPlus (Automaton a) where+	Automaton f <+> Automaton g = Automaton (f <+> g)++-- Circuit combinators++instance ArrowLoop a => ArrowLoop (Automaton a) where+	loop (Automaton f) =+		Automaton (loop (f >>>+			arr (\((x, y), cf) -> ((x, loop cf), y))))++instance ArrowLoop a => ArrowCircuit (Automaton a) where+	delay x = Automaton (arr (\x' -> (x, delay x')))++--	runAutomaton (Automaton f) = proc (e, Cons x xs) -> do+--		(y, c) <- f <- (e, x)+--		ys <- runAutomaton c -<< (e, xs)+--		returnA -< Cons y ys++-- | Encapsulating an automaton by running it on a stream of inputs,+-- obtaining a stream of outputs.+--+-- Typical usage in arrow notation:+--+-- >	proc p -> do+-- >		...+-- >		ys <- (|runAutomaton (\x -> ...)|) xs+--+-- Here @xs@ refers to the input stream and @x@ to individual+-- elements of that stream.  @ys@ is bound to the output stream.++runAutomaton :: (ArrowLoop a, ArrowApply a) =>+	Automaton a (e,b) c -> a (e,Stream b) (Stream c)+runAutomaton (Automaton f) =+	arr (\(e, Cons x xs) -> ((e, x), (e, xs))) >>>+	first f >>>+	arr (\((y, c), (e, xs)) -> (y, (runAutomaton c, (e, xs)))) >>>+	second app >>>+	arr (uncurry Cons)++instance (ArrowLoop a, ArrowApply a) => ArrowAddStream (Automaton a) a where+	liftStream = lift+	elimStream = runAutomaton++-- other promotions++instance ArrowWriter w a => ArrowWriter w (Automaton a) where+	write = lift write+	newWriter (Automaton f) =+		Automaton (newWriter f >>>+			arr (\((c, f'), w) -> ((c, w), newWriter f')))++instance ArrowError r a => ArrowError r (Automaton a) where+	raise = lift raise+	tryInUnless f0@(Automaton f) s0@(Automaton s) h0@(Automaton h) =+		Automaton (tryInUnless f sA hA)+		where	sA = arr (\(b,(c,f')) -> ((b,c),f')) >>> first s >>>+			     arr (\((d,s'),f') -> (d, tryInUnless f' s' h0))+			hA = h >>> arr (\(d,h') -> (d, tryInUnless f0 s0 h'))+	newError (Automaton f) = Automaton (newError f >>> arr h)+		where	h (Left ex) = (Left ex, newError (Automaton f))+			h (Right (c, f')) = (Right c, newError f')++instance ArrowReader r a => ArrowReader r (Automaton a) where+	readState = lift readState+	newReader (Automaton f) =+		Automaton (newReader f >>> second (arr newReader))++instance ArrowState s a => ArrowState s (Automaton a) where+	fetch = lift fetch+	store = lift store++-- encapsulations++instance ArrowAddWriter w a a' =>+		ArrowAddWriter w (Automaton a) (Automaton a') where+	liftWriter (Automaton f) =+		Automaton (liftWriter f >>>+			arr (\(c, f') -> (c, liftWriter f')))+	elimWriter (Automaton f) =+		Automaton (elimWriter f >>>+			arr (\((c, f'), w) -> ((c, w), elimWriter f')))++instance ArrowAddReader r a a' =>+		ArrowAddReader r (Automaton a) (Automaton a') where+	liftReader (Automaton f) =+		Automaton (liftReader f >>>+			arr (\(c, f') -> (c, liftReader f')))+	elimReader (Automaton f) =+		Automaton (elimReader f >>> second (arr elimReader))+++instance ArrowAddState r a a' =>+		ArrowAddState r (Automaton a) (Automaton a') where+	liftState (Automaton f) =+		Automaton (liftState f >>>+			arr (\(c, f') -> (c, liftState f')))+	elimState (Automaton f) =+		Automaton (elimState f >>>+			arr (\((c, f'), s) -> ((c, s), elimState f')))
+ Control/Arrow/Transformer/CoState.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Transformer.CoState+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- Transformation of state readers.+--+-- /TODO:/ define operations for this arrow.++module Control.Arrow.Transformer.CoState(+		CoStateArrow,+	) where++import Control.Arrow+import Control.Arrow.Operations++newtype CoStateArrow s a b c = CST (a (s -> b) (s -> c))++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))+zipMap h s = (fst h s, snd h s)++unzipMap :: (s -> (a,b)) -> (s -> a, s -> b)+unzipMap h = (fst . h, snd . h)++-- there is no transformer++-- promotions of standard classes++instance ArrowLoop a => ArrowLoop (CoStateArrow s a) where+	loop (CST f) = CST (loop (arr zipMap >>> f >>> arr unzipMap))++instance ArrowZero a => ArrowZero (CoStateArrow s a) where+	zeroArrow = CST zeroArrow++instance ArrowPlus a => ArrowPlus (CoStateArrow s a) where+	CST f <+> CST g = CST (f <+> g)
+ Control/Arrow/Transformer/Error.hs view
@@ -0,0 +1,150 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Transformer.Error+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- An arrow transformer that adds error handling.+--+-- /TODO:/ the operations here are inconsistent with other arrow transformers.++module Control.Arrow.Transformer.Error(+		ErrorArrow,+		runError,+		ArrowAddError(..),+	) where++import Control.Arrow+import Control.Arrow.Internals+import Control.Arrow.Operations+import Control.Arrow.Transformer+import Data.Monoid++-- | An arrow that augments an existing arrow with possible errors.+-- The 'ArrowError' class contains methods for raising and handling+-- these errors.++newtype ErrorArrow ex a b c = ErrorArrow (a b (Either ex c))++rstrength :: (Either ex a, b) -> Either ex (a, b)+rstrength (Left ex, _) = Left ex+rstrength (Right a, b) = Right (a, b)++-- | Encapsulate an error-raising computation,+-- by completely handling any errors.+--+-- Typical usage in arrow notation:+--+-- >	proc p -> ...+-- >		body `runError` \ex -> handler++runError :: ArrowChoice a =>+	ErrorArrow ex a e b	-- ^ computation that may raise errors+	-> a (e,ex) b		-- ^ computation to handle errors+	-> a e b+runError (ErrorArrow f) h =+	arr id &&& f >>> arr strength >>> h ||| arr id+	where	strength (x, Left y) = Left (x, y)+		strength (_, Right z) = Right z++-- transformer++instance ArrowChoice a => ArrowTransformer (ErrorArrow ex) a where+	lift f = ErrorArrow (f >>> arr Right)++-- liftings of standard classes++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+	left (ErrorArrow f) = ErrorArrow (left f >>> arr assocsum)++assocsum :: Either (Either a b) c -> Either a (Either b c)+assocsum (Left (Left a)) = Left a+assocsum (Left (Right b)) = Right (Left b)+assocsum (Right c) = Right (Right c)++instance (ArrowChoice a, ArrowApply a) => ArrowApply (ErrorArrow ex a) where+        app = ErrorArrow (arr (\(ErrorArrow f, x) -> (f, x)) >>> app)++-- this instance has the right type, but it doesn't satisfy right+-- tightening, or sliding of non-strict functions.++instance (ArrowChoice a, ArrowLoop a) => ArrowLoop (ErrorArrow ex a) where+	loop (ErrorArrow f) = ErrorArrow (loop (f >>> arr dist))+		where	dist x = (fstRight x, snd $ fromRight x)+			fstRight (Left x) = Left x+			fstRight (Right (x,_)) = Right x+			fromRight (Left _) = error "fromRight"+			fromRight (Right y) = y++-- fresh instances++instance ArrowChoice a => ArrowError ex (ErrorArrow ex a) where+	raise = ErrorArrow (arr Left)+	handle (ErrorArrow f) (ErrorArrow h) =+		ErrorArrow (arr id &&& f >>> arr strength >>> h ||| arr Right)+		where	strength (x, Left y) = Left (x, y)+			strength (_, Right z) = Right z+	tryInUnless (ErrorArrow f) (ErrorArrow s) (ErrorArrow h) =+		ErrorArrow (arr id &&& f >>> arr distr >>> h ||| s)+		where	distr (b, Left ex) = Left (b, ex)+			distr (b, Right c) = Right (b, c)++instance ArrowChoice a => ArrowAddError ex (ErrorArrow ex a) a where+	liftError = lift+	elimError = runError++instance (Monoid ex, ArrowChoice a) => ArrowZero (ErrorArrow ex a) where+	zeroArrow = ErrorArrow (arr (const (Left mempty)))++instance (Monoid ex, ArrowChoice a) => ArrowPlus (ErrorArrow ex a) where+	f <+> g = handle f $ handle (arr fst >>> g) $+			ErrorArrow (arr (\((_,ex1), ex2) ->+				Left (ex1 `mappend` ex2)))++-- liftings of other arrow classes++-- specializations of general promotions++instance (ArrowReader r a, ArrowChoice a)+		 => ArrowReader r (ErrorArrow ex a) where+	readState = lift readState+	newReader (ErrorArrow f) = ErrorArrow (newReader f)++instance (ArrowState s a, ArrowChoice a) =>+                ArrowState s (ErrorArrow ex a) where+	fetch = lift fetch+	store = lift store++instance (ArrowWriter w a, ArrowChoice a) =>+		ArrowWriter w (ErrorArrow ex a) where+	write = lift write+	newWriter (ErrorArrow f) = ErrorArrow (newWriter f >>> arr rstrength)++-- promotions++instance (ArrowAddReader r a a', ArrowChoice a, ArrowChoice a') =>+		ArrowAddReader r (ErrorArrow ex a) (ErrorArrow ex a') where+	liftReader (ErrorArrow f) = ErrorArrow (liftReader f)+	elimReader (ErrorArrow f) = ErrorArrow (elimReader f)++instance (ArrowAddState s a a', ArrowChoice a, ArrowChoice a') =>+		ArrowAddState s (ErrorArrow ex a) (ErrorArrow ex a') where+	liftState (ErrorArrow f) = ErrorArrow (liftState f)+	elimState (ErrorArrow f) = ErrorArrow (elimState f >>> arr rstrength)++instance (ArrowAddWriter w a a', ArrowChoice a, ArrowChoice a') =>+		ArrowAddWriter w (ErrorArrow ex a) (ErrorArrow ex a') where+	liftWriter (ErrorArrow f) = ErrorArrow (liftWriter f)+	elimWriter (ErrorArrow f) = ErrorArrow (elimWriter f >>> arr rstrength)
+ Control/Arrow/Transformer/Reader.hs view
@@ -0,0 +1,129 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Transformer.Reader+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- Arrow transformer that adds a read-only state (i.e. an environment).++module Control.Arrow.Transformer.Reader(+		ReaderArrow,+		runReader,+		ArrowAddReader(..),+	) where++import Control.Arrow+import Control.Arrow.Internals+import Control.Arrow.Operations+import Control.Arrow.Transformer++-- | 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+-- state.+--+-- Typical usage in arrow notation:+--+-- >	proc p -> ...+-- >		(|runReader cmd|) env++runReader :: Arrow a => ReaderArrow r a e b -> a (e,r) b+runReader (ReaderArrow f) = f++-- arrow transformer++instance Arrow a => ArrowTransformer (ReaderArrow r) a where+	lift f = ReaderArrow (arr fst >>> f)++-- liftings of standard classes++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)+swapsnd ~(~(a, r), b) = ((a, b), r)++instance ArrowChoice a => ArrowChoice (ReaderArrow r a) where+	left (ReaderArrow f) = ReaderArrow (arr dist' >>> left f)+		where	dist' :: (Either b c, r) -> Either (b, r) c+			dist' (Left b, r) = Left (b, r)+			dist' (Right c, _) = Right c++instance ArrowApply a => ArrowApply (ReaderArrow r a) where+	app = ReaderArrow+		(arr (\((ReaderArrow f, a), r) -> (f, (a, r))) >>> app)++instance ArrowZero a => ArrowZero (ReaderArrow r a) where+	zeroArrow = lift zeroArrow++instance ArrowPlus a => ArrowPlus (ReaderArrow r a) where+	ReaderArrow f <+> ReaderArrow g = ReaderArrow (f <+> g)++instance ArrowLoop a => ArrowLoop (ReaderArrow r a) where+	loop (ReaderArrow f) = ReaderArrow (loop (arr swapsnd >>> f))++-- new instances++instance Arrow a => ArrowReader r (ReaderArrow r a) where+	readState = ReaderArrow (arr snd)+	newReader (ReaderArrow f) =+		ReaderArrow (arr (\((x, _), r) -> (x, r)) >>> f)++instance Arrow a => ArrowAddReader r (ReaderArrow r a) a where+	liftReader = lift+	elimReader = runReader++-- liftings of other classes++instance ArrowCircuit a => ArrowCircuit (ReaderArrow r a) where+	delay x = lift (delay x)++instance ArrowError ex a => ArrowError ex (ReaderArrow r a) where+	raise = lift raise+	handle (ReaderArrow f) (ReaderArrow h) = ReaderArrow (handle f (arr swapsnd >>> h))+	tryInUnless (ReaderArrow f) (ReaderArrow s) (ReaderArrow h) =+		ReaderArrow (tryInUnless f (arr swapsnd >>> s) (arr swapsnd >>> h))+	newError (ReaderArrow f) = ReaderArrow (newError f)++instance ArrowState s a => ArrowState s (ReaderArrow r a) where+	fetch = lift fetch+	store = lift store++instance ArrowWriter s a => ArrowWriter s (ReaderArrow r a) where+	write = lift write+	newWriter (ReaderArrow f) = ReaderArrow (newWriter f)++-- Promotions of encapsulation operators.++instance ArrowAddError ex a a' =>+		ArrowAddError ex (ReaderArrow r a) (ReaderArrow r a') where+	liftError (ReaderArrow f) = ReaderArrow (liftError f)+	elimError (ReaderArrow f) (ReaderArrow h) =+		ReaderArrow (elimError f (arr swapsnd >>> h))++instance ArrowAddState s a a' =>+		ArrowAddState s (ReaderArrow r a) (ReaderArrow r a') where+	liftState (ReaderArrow f) = ReaderArrow (liftState f)+	elimState (ReaderArrow f) = ReaderArrow (arr swapsnd >>> elimState f)++-- instance ArrowAddReader r a a' =>+-- 		ArrowAddReader r (ReaderArrow r a) (ReaderArrow r a') where+-- 	elimReader (ReaderArrow f) = ReaderArrow (arr swapsnd >>> elimReader f)++instance ArrowAddWriter s a a' =>+		ArrowAddWriter s (ReaderArrow r a) (ReaderArrow r a') where+	liftWriter (ReaderArrow f) = ReaderArrow (liftWriter f)+	elimWriter (ReaderArrow f) = ReaderArrow (elimWriter f)
+ Control/Arrow/Transformer/State.hs view
@@ -0,0 +1,126 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Transformer.State+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- An arrow transformer that adds a modifiable state,+-- based of section 9 of /Generalising Monads to Arrows/, by John Hughes,+-- /Science of Computer Programming/ 37:67-111, May 2000.++module Control.Arrow.Transformer.State(+		StateArrow,+		runState,+		ArrowAddState(..),+	) where++import Control.Arrow+import Control.Arrow.Internals+import Control.Arrow.Operations+import Control.Arrow.Transformer++-- | 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 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+	lift f = ST (first f)++-- | Encapsulation of a state-using computation, exposing the initial+-- and final states.+--+-- Typical usage in arrow notation:+--+-- >	proc p -> do+-- >		...+-- >		(result, final_state) <- (|runState cmd|) init_state++runState :: Arrow a => StateArrow s a e b -> a (e,s) (b,s)+runState (ST f) = f++-- operations++instance Arrow a => ArrowState s (StateArrow s a) where+	fetch = ST (arr (\(_, s) -> (s, s)))+	store = ST (arr (\(s, _) -> ((), s)))++instance Arrow a => ArrowAddState s (StateArrow s a) a where+	liftState = lift+	elimState = runState++-- The following promotions follow directly from the arrow transformer.++instance ArrowZero a => ArrowZero (StateArrow s a) where+	zeroArrow = ST zeroArrow++instance ArrowCircuit a => ArrowCircuit (StateArrow s a) where+	delay x = lift (delay x)++instance ArrowError ex a => ArrowError ex (StateArrow s a) where+	raise = lift raise+	handle (ST f) (ST h) = ST (handle f (arr swapsnd >>> h))+	tryInUnless (ST f) (ST s) (ST h) =+		ST (tryInUnless f (arr new_state >>> s) (arr swapsnd >>> h))+		where	new_state ((b,_),(c,s')) = ((b,c),s')+	newError (ST f) = ST (newError f &&& arr snd >>> arr h)+		where	h (Left ex, s) = (Left ex, s)+			h (Right (c, s'), _) = (Right c, s')++-- Note that in each case the error handler gets the original state.++instance ArrowReader r a => ArrowReader r (StateArrow s a) where+	readState = lift readState+	newReader (ST f) = ST (arr swapsnd >>> newReader f)++instance ArrowWriter w a => ArrowWriter w (StateArrow s a) where+	write = lift write+	newWriter (ST f) = ST (newWriter f >>> arr swapsnd)++-- liftings of standard classes++instance ArrowChoice a => ArrowChoice (StateArrow s a) where+	left (ST f) = ST (arr distr >>> left f >>> arr undistr)+		where	distr (Left y, s) = Left (y, s)+			distr (Right z, s) = Right (z, s)+			undistr (Left (y, s)) = (Left y, s)+			undistr (Right (z, s)) = (Right z, s)++instance ArrowApply a => ArrowApply (StateArrow s a) where+	app = ST (arr (\((ST f, x), s) -> (f, (x, s))) >>> app)++instance ArrowLoop a => ArrowLoop (StateArrow s a) where+	loop (ST f) = ST (loop (arr swapsnd >>> f >>> arr swapsnd))++instance ArrowPlus a => ArrowPlus (StateArrow s a) where+	ST f <+> ST g = ST (f <+> g)++-- promotions++instance ArrowAddReader r a a' =>+		ArrowAddReader r (StateArrow s a) (StateArrow s a') where+	liftReader (ST f) = ST (liftReader f)+	elimReader (ST f) = ST (arr swapsnd >>> elimReader f)++instance ArrowAddWriter w a a' =>+		ArrowAddWriter w (StateArrow s a) (StateArrow s a') where+	liftWriter (ST f) = ST (liftWriter f)+	elimWriter (ST f) = ST (elimWriter f >>> arr swapsnd)++instance ArrowAddError ex a a' =>+		ArrowAddError ex (StateArrow s a) (StateArrow s a') where+	liftError (ST f) = ST (liftError f)+	elimError (ST f) (ST h) = ST (elimError f (arr swapsnd >>> h))
+ Control/Arrow/Transformer/Static.hs view
@@ -0,0 +1,123 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Transformer.Static+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- Arrow transformer adding static information.++module Control.Arrow.Transformer.Static(+		StaticArrow, StaticMonadArrow, StaticArrowArrow,+		wrapA, unwrapA, wrapM, unwrapM,+	) where++import Control.Applicative+import Control.Arrow hiding (pure)+import Control.Arrow.Internals+import Control.Arrow.Operations+import Control.Arrow.Transformer+import Control.Monad++-- | An arrow type that augments the underlying arrow with static information.++newtype StaticArrow f a b c = SA (f (a b c))++instance (Arrow a, Applicative f) => ArrowTransformer (StaticArrow f) a where+	lift f = SA (pure f)++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.++instance (ArrowZero a, Applicative f) => ArrowZero (StaticArrow f a) where+	zeroArrow = lift zeroArrow++instance (ArrowCircuit a, Applicative f) => ArrowCircuit (StaticArrow f a) where+	delay x = lift (delay x)++instance (ArrowError ex a, Applicative f) => ArrowError ex (StaticArrow f a) where+	raise = lift raise+	handle (SA f) (SA h) = SA (handle <$> f <*> h)+	tryInUnless (SA f) (SA s) (SA h) = SA (tryInUnless <$> f <*> s <*> h)++instance (ArrowReader r a, Applicative f) => ArrowReader r (StaticArrow f a) where+	readState = lift readState+	newReader (SA f) = SA (newReader <$> f)++instance (ArrowState s a, Applicative f) => ArrowState s (StaticArrow f a) where+	fetch = lift fetch+	store = lift store++instance (ArrowWriter w a, Applicative f) => ArrowWriter w (StaticArrow f a) where+	write = lift write+	newWriter (SA f) = SA (newWriter <$> f)++-- Classes that are preserved.++instance (ArrowChoice a, Applicative f) => ArrowChoice (StaticArrow f a) where+	left (SA f) = SA (left <$> f)++-- ArrowApply is generally not preserved.++instance (ArrowLoop a, Applicative f) => ArrowLoop (StaticArrow f a) where+	loop (SA f) = SA (loop <$> f)++instance (ArrowPlus a, Applicative f) => ArrowPlus (StaticArrow f a) where+	SA f <+> SA g = SA ((<+>) <$> f <*> g)++-- promotions++instance (ArrowAddStream a a', Applicative f) =>+		ArrowAddStream (StaticArrow f a) (StaticArrow f a') where+	liftStream (SA f) = SA (liftStream <$> f)+	elimStream (SA f) = SA (elimStream <$> f)++instance (ArrowAddState s a a', Applicative f) =>+		ArrowAddState s (StaticArrow f a) (StaticArrow f a') where+	liftState (SA f) = SA (liftState <$> f)+	elimState (SA f) = SA (elimState <$> f)++instance (ArrowAddReader r a a', Applicative f) =>+		ArrowAddReader r (StaticArrow f a) (StaticArrow f a') where+	liftReader (SA f) = SA (liftReader <$> f)+	elimReader (SA f) = SA (elimReader <$> f)++instance (ArrowAddWriter w a a', Applicative f) =>+		ArrowAddWriter w (StaticArrow f a) (StaticArrow f a') where+	liftWriter (SA f) = SA (liftWriter <$> f)+	elimWriter (SA f) = SA (elimWriter <$> f)++instance (ArrowAddError ex a a', Applicative f) =>+		ArrowAddError ex (StaticArrow f a) (StaticArrow f a') where+	liftError (SA f) = SA (liftError <$> f)+	elimError (SA f) (SA h) = SA (elimError <$> f <*> h)++-- | A special case.++type StaticArrowArrow a s = StaticArrow (WrappedArrow a s)++wrapA :: (Arrow a, Arrow a') => a s (a' b c) -> StaticArrowArrow a s a' b c+wrapA x = SA (WrapArrow x)++unwrapA :: (Arrow a, Arrow a') => StaticArrowArrow a s a' b c -> a s (a' b c)+unwrapA (SA (WrapArrow x)) = x++-- | A special case is monads applied to the whole arrow, in contrast to+-- 'Kleisli' arrows, in which the monad is applied to the output.++type StaticMonadArrow m = StaticArrow (WrappedMonad m)++wrapM :: (Monad m, Arrow a) => m (a b c) -> StaticMonadArrow m a b c+wrapM x = SA (WrapMonad x)++unwrapM :: (Monad m, Arrow a) => StaticMonadArrow m a b c -> m (a b c)+unwrapM (SA (WrapMonad x)) = x
+ Control/Arrow/Transformer/Stream.hs view
@@ -0,0 +1,133 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Transformer.Stream+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- Arrow transformer lifting an arrow to streams.++module Control.Arrow.Transformer.Stream(+		StreamArrow,+		runStream,+		StreamMap,+		StreamMapST, runStreamST,+		ArrowAddStream(..),+	) where++import Control.Monad.ST++import Control.Arrow+import Control.Arrow.Internals+import Control.Arrow.Operations+import Control.Arrow.Transformer+import Data.Stream++-- | 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 Arrow a => Arrow (StreamArrow a) where+	arr f = Str (arr (fmap f))+	Str f >>> Str g = Str (f >>> g)+	first (Str f) =+		Str (arr unzipStream >>> first f >>> arr (uncurry zipStream))++genmap :: Arrow a => a b c -> a (Stream b) (Stream c)+genmap f = arr (\xs -> (shd xs, stl xs)) >>>+		f *** genmap f >>> arr (uncurry Cons)++-- Caution: genmap is only a functor if *** for the base arrow is.+-- (For Kleisli arrows, that would mean a commutative monad.)+-- The same goes for the equivalent lift: it can be used to lift arrows,+-- but won't preserve composition unless *** does.++instance Arrow a => ArrowTransformer (StreamArrow) a where+	lift f = Str (genmap f)++-- The following promotions follow directly from the arrow transformer.++instance ArrowZero a => ArrowZero (StreamArrow a) where+	zeroArrow = lift zeroArrow++instance ArrowState s a => ArrowState s (StreamArrow a) where+	fetch = lift fetch+	store = lift store++instance ArrowWriter w a => ArrowWriter w (StreamArrow a) where+	write = lift write+	newWriter (Str f) = Str (newWriter f >>> arr strength)+		where	strength :: Functor w' => (w' a',b) -> w' (a',b)+			strength (v, y) = fmap (\x -> (x, y)) v++-- liftings of standard classes++instance Arrow a => ArrowChoice (StreamArrow a) where+	left (Str f) = Str ((arr getLeft >>> f) &&& arr id >>> arr replace)+		where	getLeft (Cons (Left x) xs) = Cons x (getLeft xs)+			getLeft (Cons (Right _) xs) = getLeft xs+			replace (~(Cons x xs), Cons (Left _) ys) =+				Cons (Left x) (replace (xs, ys))+			replace (xs, Cons (Right y) ys) =+				Cons (Right y) (replace (xs, ys))++instance ArrowLoop a => ArrowLoop (StreamArrow a) where+	loop (Str f) =+		Str (loop (arr (uncurry zipStream) >>> f >>> arr unzipStream))++instance ArrowPlus a => ArrowPlus (StreamArrow a) where+	Str f <+> Str g = Str (f <+> g)++-- I don't know of any other useful promotions.+-- (elimWriter can be promoted, but doesn't seem useful.)++-- Circuits++instance ArrowLoop a => ArrowCircuit (StreamArrow a) where+	delay x = Str (arr (Cons x))++-- | Run a stream processor on a stream of inputs, obtaining a stream+-- of outputs.+--+-- Typical usage in arrow notation:+--+-- >	proc p -> do+-- >		...+-- >		ys <- (|runStream (\x -> ...)|) xs+--+-- Here @xs@ refers to the input stream and @x@ to individual+-- elements of that stream.  @ys@ is bound to the output stream.++runStream :: ArrowLoop a => StreamArrow a (e,b) c -> a (e,Stream b) (Stream c)+runStream (Str f) = arr (\(e, xs) -> fmap (\x -> (e, x)) xs) >>> f++instance ArrowLoop a => ArrowAddStream (StreamArrow a) a where+	liftStream = lift+	elimStream = runStream++-- | Mappings of streams+type StreamMap = StreamArrow (->)++-- | In-place state updates.+--+-- /Note/: this is an arrow type, and 'lift' can be used to promote arrows+-- from @'Kleisli' ('ST' s)@: the resulting arrow updates the state for+-- each stream element in turn, and as long as the final state in not+-- required all is well.  However, 'lift' does not preserve composition,+-- because this monad isn't commutative.  In particular, a composition+-- of 'lift's of state transformers will not work, as the second will+-- require the final state of the first.++type StreamMapST s = StreamArrow (Kleisli (ST s))++-- | Encapsulate a local state.++runStreamST :: (forall s. StreamMapST s e c) -> StreamMap e c+runStreamST cf = Str $ \ input -> runST (let Str (Kleisli f) = cf in f input)
+ Control/Arrow/Transformer/Writer.hs view
@@ -0,0 +1,133 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Arrow.Transformer.Writer+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  non-portable (multi-parameter type classes)+--+-- Arrow transformer that adds accumulation of output.++module Control.Arrow.Transformer.Writer(+		WriterArrow,+		runWriter,+		ArrowAddWriter(..),+	) where++import Control.Arrow+import Control.Arrow.Internals+import Control.Arrow.Operations+import Control.Arrow.Transformer+import Data.Monoid++-- | An arrow type that augments an existing arrow with accumulating+-- output.  The 'ArrowWriter' class contains the relevant operations.++newtype WriterArrow w a b c = WriterArrow (a b (c, w))++-- | Encapsulation of a writer computation, providing the accumulated output.+--+-- Typical usage in arrow notation:+--+-- >	proc p -> do+-- >		...+-- >		(result, output) <- (|runWriter cmd|)++runWriter :: (Arrow a, Monoid w) => WriterArrow w a e b -> a e (b,w)+runWriter (WriterArrow f) = f++rstrength :: ((a, w), b) -> ((a, b), w)+rstrength ((a, w), b) = ((a, b), w)++unit :: Monoid w => a -> (a, w)+unit a = (a, mempty)++join :: Monoid w => ((a, w), w) -> (a, w)+join ((a, w2), w1) = (a, w1 `mappend` w2)++-- arrow transformer++instance (Arrow a, Monoid w) => ArrowTransformer (WriterArrow w) a where+	lift f = WriterArrow (f >>> arr unit)++-- liftings of standard classes++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+	left (WriterArrow f) = WriterArrow (left f >>> arr lift_monoid)+		where	lift_monoid (Left (x, w)) = (Left x, w)+			lift_monoid (Right y) = unit (Right y)++instance (ArrowApply a, Monoid w) => ArrowApply (WriterArrow w a) where+	app = WriterArrow (arr (\(WriterArrow f, x) -> (f, x)) >>> app)++instance (ArrowZero a, Monoid w) => ArrowZero (WriterArrow w a) where+	zeroArrow = WriterArrow zeroArrow++instance (ArrowPlus a, Monoid w) => ArrowPlus (WriterArrow w a) where+	WriterArrow f <+> WriterArrow g = WriterArrow (f <+> g)++instance (ArrowLoop a, Monoid w) => ArrowLoop (WriterArrow w a) where+	loop (WriterArrow f) = WriterArrow (loop (f >>> arr swapenv))+		where	swapenv ~(~(x, y), w) = ((x, w), y)++-- new instances++instance (Arrow a, Monoid w) => ArrowWriter w (WriterArrow w a) where+	write = WriterArrow (arr (\x -> ((), x)))+	newWriter (WriterArrow f) =+		WriterArrow (f >>> arr (\(x, w) -> ((x, w), w)))++instance (Arrow a, Monoid w) => ArrowAddWriter w (WriterArrow w a) a where+	liftWriter = lift+	elimWriter = runWriter++-- liftings of other classes++instance (ArrowCircuit a, Monoid w) => ArrowCircuit (WriterArrow w a) where+	delay x = lift (delay x)++instance (ArrowError ex a, Monoid w) => ArrowError ex (WriterArrow w a) where+	raise = lift raise+	handle (WriterArrow f) (WriterArrow h) = WriterArrow (handle f h)+	tryInUnless (WriterArrow f) (WriterArrow s) (WriterArrow h) =+		WriterArrow (tryInUnless f s' h)+		where	s' = arr lstrength >>> first s >>> arr join+			lstrength (x, (y, w)) = ((x, y), w)+	newError (WriterArrow f) = WriterArrow (newError f >>> arr h)+		where	h (Left ex) = unit (Left ex)+			h (Right (c, w)) = (Right c, w)++instance (ArrowReader r a, Monoid w) => ArrowReader r (WriterArrow w a) where+	readState = lift readState+	newReader (WriterArrow f) = WriterArrow (newReader f)++instance (ArrowState s a, Monoid w) => ArrowState s (WriterArrow w a) where+	fetch = lift fetch+	store = lift store++-- promotions of encapsulation operators++instance (ArrowAddError ex a a', Monoid w) =>+		ArrowAddError ex (WriterArrow w a) (WriterArrow w a') where+	liftError (WriterArrow f) = WriterArrow (liftError f)+	elimError (WriterArrow f) (WriterArrow h) = WriterArrow (elimError f h)++instance (ArrowAddReader r a a', Monoid w) =>+		ArrowAddReader r (WriterArrow w a) (WriterArrow w a') where+	liftReader (WriterArrow f) = WriterArrow (liftReader f)+	elimReader (WriterArrow f) = WriterArrow (elimReader f)++instance (ArrowAddState s a a', Monoid w) =>+		ArrowAddState s (WriterArrow w a) (WriterArrow w a') where+	liftState (WriterArrow f) = WriterArrow (liftState f)+	elimState (WriterArrow f) = WriterArrow (elimState f >>> arr rstrength)
+ Data/Stream.hs view
@@ -0,0 +1,42 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Stream+-- Copyright   :  (c) Ross Paterson 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  portable+--+-- Infinite sequences.++module Data.Stream where++-- | An infinite sequence.+data Stream a = Cons {+		shd :: a,	-- ^ head of the stream+		stl :: Stream a -- ^ tail of the stream+	}++instance Functor Stream where+	fmap f xs = Cons (f (shd xs)) (fmap f (stl xs))++instance Monad Stream where+	return x = let return_x = Cons x return_x in return_x+	xs >>= f = Cons (shd (f (shd xs))) (stl xs >>= f)++-- | Lazy zip of a pair of streams.+zipStream :: Stream a -> Stream b -> Stream (a, b)+zipStream xs ys = Cons (shd xs, shd ys) (zipStream (stl xs) (stl ys))++-- | Lazy unzip of a pair of streams.+unzipStream :: Stream (a, b) -> (Stream a, Stream b)+unzipStream xys = (fmap fst xys, fmap snd xys)++-- | An infinite sequence obtained by padding the list with 'undefined'.+listToStream :: [a] -> Stream a+listToStream = foldr Cons (error "listToStream")++-- | The infinite list corresponding to a stream.+streamToList :: Stream a -> [a]+streamToList xs = shd xs : streamToList (stl xs)
+ LICENSE view
@@ -0,0 +1,31 @@+The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ arrows.cabal view
@@ -0,0 +1,28 @@+Name:		arrows+Version:	0.2+Build-Depends:	base >= 2.0+License:	BSD3+license-file:	LICENSE+Author:		Ross Paterson <ross@soi.city.ac.uk>+Maintainer:	Ross Paterson <ross@soi.city.ac.uk>+Homepage:	http://www.haskell.org/arrows/+Synopsis:	Arrow classes and transformers+Description:+	Several classes that extend the Arrow class, and some transformers+	that implement or lift these classes.+Exposed-Modules:+	Control.Arrow.Operations,+	Control.Arrow.Transformer.Automaton,+	Control.Arrow.Transformer.CoState,+	Control.Arrow.Transformer.Error,+	Control.Arrow.Transformer.State,+	Control.Arrow.Transformer.Static,+	Control.Arrow.Transformer.Stream,+	Control.Arrow.Transformer.Writer,+	Control.Arrow.Transformer.Reader,+	Control.Arrow.Transformer.All,+	Control.Arrow.Transformer,+	Data.Stream+Other-Modules:+        Control.Arrow.Internals+Extensions: MultiParamTypeClasses, UndecidableInstances