packages feed

TypeCompose 0.9.6 → 0.9.7

raw patch · 6 files changed

+59/−56 lines, 6 filesdep ~base

Dependency ranges changed: base

Files

TypeCompose.cabal view
@@ -1,5 +1,5 @@ Name:                TypeCompose-Version:             0.9.6+Version:             0.9.7 Synopsis: 	     Type composition classes & instances Category:            Composition, Control Cabal-Version:       >= 1.6@@ -12,6 +12,7 @@   Copyright 2007-2012 by Conal Elliott; BSD3 license. Author:              Conal Elliott  Maintainer:          conal@conal.net+Homepage:            https://github.com/conal/TypeCompose Copyright:           (c) 2007-2012 by Conal Elliott License:             BSD3 License-File:        COPYING
src/Control/Compose.hs view
@@ -113,29 +113,29 @@  -- | Add pre-processing -- argument :: (a' -> a) -> ((a -> b) -> (a' -> b))-argument :: Category (-->) => (a' --> a) -> ((a --> b) -> (a' --> b))+argument :: Category cat => (a' `cat` a) -> ((a `cat` b) -> (a' `cat` b)) argument = flip (.)  -- | Add post-processing-result :: Category (-->) => (b --> b') -> ((a --> b) -> (a --> b'))+result :: Category cat => (b `cat` b') -> ((a `cat` b) -> (a `cat` b')) result = (.)  infixr 1 ~>, ~>* infixl 1 <~, *<~  -- | Add pre- and post processing-(~>) :: Category (-->) =>-        (a' --> a) -> (b --> b') -> ((a --> b) -> (a' --> b'))+(~>) :: Category cat =>+        (a' `cat` a) -> (b `cat` b') -> ((a `cat` b) -> (a' `cat` b')) -- (f ~> h) g = h . g . f f ~> h = result h . argument f -(<~) :: Category (-->) =>-        (b --> b') -> (a' --> a) -> ((a --> b) -> (a' --> b'))+(<~) :: Category cat =>+        (b `cat` b') -> (a' `cat` a) -> ((a `cat` b) -> (a' `cat` b')) (<~) = flip (~>)  -- If I add argument back to DeepArrow, we can get a different generalization: -- --- (~>) :: DeepArrow (-->) => (a' --> a) -> (b --> b') -> ((a -> b) --> (a' -> b'))+-- (~>) :: DeepArrow cat => (a' `cat` a) -> (b `cat` b') -> ((a -> b) `cat` (a' -> b'))  -- | Like '(~>)' but specialized to functors and functions. (~>*) :: (Functor p, Functor q) => @@ -404,16 +404,16 @@  -- | Composition of type constructors: unary with binary.  Called -- "StaticArrow" in [1].-newtype OO f (~>) a b = OO { unOO :: f (a ~> b) }+newtype OO f j a b = OO { unOO :: f (a `j` b) }   #if __GLASGOW_HASKELL__ >= 609-instance (Applicative f, Category (~>)) => Category (OO f (~>)) where+instance (Applicative f, Category cat) => Category (OO f cat) where   id          = OO (pure id)   OO g . OO h = OO (liftA2 (.) g h) #endif -instance (Applicative f, Arrow (~>)) => Arrow (OO f (~>)) where+instance (Applicative f, Arrow arr) => Arrow (OO f arr) where #if __GLASGOW_HASKELL__ < 609   OO g >>> OO h = OO (liftA2 (>>>) g h) #endif@@ -545,31 +545,31 @@ ----------------------------------------------------------}  -- | Flip type arguments-newtype Flip (~>) b a = Flip { unFlip :: a ~> b }+newtype Flip j b a = Flip { unFlip :: a `j` b }  -- | @newtype@ bijection-biFlip :: (a ~> b) :<->: Flip (~>) b a+biFlip :: (a `j` b) :<->: Flip j b a biFlip = Bi Flip unFlip  -- Apply unary function inside of a 'Flip' representation.-inFlip :: ((a~>b) -> (a' ~~> b')) -> (Flip (~>) b a -> Flip (~~>) b' a')+inFlip :: ((a `j` b) -> (a' `k` b')) -> (Flip j b a -> Flip k b' a') inFlip = unFlip ~> Flip  -- Apply binary function inside of a 'Flip' representation.-inFlip2 :: ((a~>b) -> (a' ~~> b') -> (a'' ~~~> b''))-        -> (Flip (~>) b a -> Flip (~~>) b' a' -> Flip (~~~>) b'' a'')+inFlip2 :: ((a `j` b) -> (a' `k` b') -> (a'' `l` b''))+        -> (Flip j b a -> Flip k b' a' -> Flip l b'' a'') inFlip2 f (Flip ar) = inFlip (f ar)  -- Apply ternary function inside of a 'Flip' representation.-inFlip3 :: ((a~>b) -> (a' ~~> b') -> (a'' ~~~> b'') -> (a''' ~~~~> b'''))-        -> (Flip (~>) b a -> Flip (~~>) b' a' -> Flip (~~~>) b'' a'' -> Flip (~~~~>) b''' a''')+inFlip3 :: ((a `j` b) -> (a' `k` b') -> (a'' `l` b'') -> (a''' `m` b'''))+        -> (Flip j b a -> Flip k b' a' -> Flip l b'' a'' -> Flip m b''' a''') inFlip3 f (Flip ar) = inFlip2 (f ar) -instance Arrow (~>) => ContraFunctor (Flip (~>) b) where+instance Arrow arr => ContraFunctor (Flip arr b) where   contraFmap h (Flip f) = Flip (arr h >>> f)  -- Useful for (~>) = (->).  Maybe others.-instance (Applicative ((~>) a), Monoid o) => Monoid (Flip (~>) o a) where+instance (Applicative (j a), Monoid o) => Monoid (Flip j o a) where   mempty  = Flip (pure mempty)   mappend = inFlip2 (liftA2 mappend) @@ -813,42 +813,44 @@  -- | Arrow-like type between type constructors (doesn't enforce @Arrow -- (~>)@ here).-newtype Arrw (~>) f g a = Arrw { unArrw :: f a ~> g a } -- deriving Monoid+newtype Arrw j f g a = Arrw { unArrw :: f a `j` g a } -- deriving Monoid  -- For ghc-6.6, use the "deriving" above, but for 6.8 use the "deriving" below. -deriving instance Monoid (f a ~> g a) => Monoid (Arrw (~>) f g a)+deriving instance Monoid (f a `j` g a) => Monoid (Arrw j f g a)  -- Replace with generalized bijection? --- toArrw :: Arrow (~>) => (f a ~> b) -> (c ~> g a) -> ((b ~> c) -> Arrw (~>) f g a)+-- toArrw :: Arrow j => (f a ~> b) -> (c ~> g a) -> ((b ~> c) -> Arrw j f g a) -- toArrw fromF toG h = Arrw (fromF >>> h >>> toG) --- fromArrw :: Arrow (~>) => (b ~> f a) -> (g a ~> c) -> (Arrw (~>) f g a -> (b ~> c))+-- fromArrw :: Arrow j => (b ~> f a) -> (g a ~> c) -> (Arrw j f g a -> (b ~> c)) -- fromArrw toF fromG (Arrw h') = toF >>> h' >>> fromG  -- | Apply unary function inside of @Arrw@ representation.-inArrw :: ((f a ~> g a) -> (f' a' ~> g' a'))-       -> ((Arrw (~>) f g) a -> (Arrw (~>) f' g') a')+inArrw :: ((f a `j` g a) -> (f' a' `j` g' a'))+       -> ((Arrw j f g) a -> (Arrw j f' g') a') inArrw = unArrw ~> Arrw --- | Apply binary function inside of @Arrw (~>) f g@ representation.-inArrw2 :: ((f a ~> g a) -> (f' a' ~> g' a') -> (f'' a'' ~> g'' a''))-        -> (Arrw (~>) f g a -> Arrw (~>) f' g' a' -> Arrw (~>) f'' g'' a'')+-- | Apply binary function inside of @Arrw j f g@ representation.+inArrw2 :: ((f a `j` g a) -> (f' a' `j` g' a') -> (f'' a'' `j` g'' a''))+        -> (Arrw j f g a -> Arrw j f' g' a' -> Arrw j f'' g'' a'') inArrw2 h (Arrw p) = inArrw (h p) --- | Apply ternary function inside of @Arrw (~>) f g@ representation.-inArrw3 :: ((f a ~> g a) -> (f' a' ~> g' a') -> (f'' a'' ~> g'' a'') -> (f''' a''' ~> g''' a'''))-        -> ((Arrw (~>) f g) a -> (Arrw (~>) f' g') a' -> (Arrw (~>) f'' g'') a'' -> (Arrw (~>) f''' g''') a''')+-- | Apply ternary function inside of @Arrw j f g@ representation.+inArrw3 ::+  ((f a `j` g a) -> (f' a' `j` g' a') ->+   (f'' a'' `j` g'' a'') -> (f''' a''' `j` g''' a'''))+  -> ((Arrw j f g) a -> (Arrw j f' g') a' -> (Arrw j f'' g'') a'' -> (Arrw j f''' g''') a''') inArrw3 h (Arrw p) = inArrw2 (h p)  -- Functor & ContraFunctor instances.  Beware use of 'arr', which is not -- available for some of my favorite arrows. -instance (Arrow (~>), ContraFunctor f, Functor g) => Functor (Arrw (~>) f g) where+instance (Arrow j, ContraFunctor f, Functor g) => Functor (Arrw j f g) where   fmap h = inArrw $ \ fga -> arr (contraFmap h) >>> fga >>> arr (fmap h) -instance (Arrow (~>), Functor f, ContraFunctor g) => ContraFunctor (Arrw (~>) f g) where+instance (Arrow j, Functor f, ContraFunctor g) => ContraFunctor (Arrw j f g) where   contraFmap h = inArrw $ \ fga -> arr (fmap h) >>> fga >>> arr (contraFmap h)  -- Restated,
src/Data/Bijection.hs view
@@ -33,7 +33,7 @@ infixr 2 --->  -- | A type of bijective arrows-data Bijection (~>) a b = Bi { biTo :: a ~> b, biFrom :: b ~> a }+data Bijection j a b = Bi { biTo :: a `j` b, biFrom :: b `j` a }  -- | Bijective functions type a :<->: b = Bijection (->) a b@@ -41,20 +41,20 @@ -- | Bijective identity arrow.  Warning: uses 'arr' on @(~>)@.  If you -- have no 'arr', but you have a @DeepArrow@, you can instead use @Bi idA -- idA@.-idb :: Arrow (~>) => Bijection (~>) a a+idb :: Arrow j => Bijection j a a idb = Bi idA idA where idA = arr id  -- | Inverse bijection-inverse :: Bijection (~>) a b -> Bijection (~>) b a+inverse :: Bijection j a b -> Bijection j b a inverse (Bi ab ba) = Bi ba ab  #if __GLASGOW_HASKELL__ >= 609-instance Category (~>) => Category (Bijection (~>)) where+instance Category j => Category (Bijection j) where   id = Bi id id   Bi bc cb . Bi ab ba = Bi (bc . ab) (ba . cb) #endif -instance Arrow (~>) => Arrow (Bijection (~>)) where+instance Arrow j => Arrow (Bijection j) where #if __GLASGOW_HASKELL__ < 609   Bi ab ba >>> Bi bc cb = Bi (ab >>> bc) (cb >>> ba) #endif@@ -75,8 +75,8 @@ bimap (Bi ab ba) = Bi (fmap ab) (fmap ba)  -- | Bijections on arrows.-(--->) :: Arrow (~>) => Bijection (~>) a b -> Bijection (~>) c d-       -> (a ~> c) :<->: (b ~> d)+(--->) :: Arrow j => Bijection j a b -> Bijection j c d+       -> (a `j` c) :<->: (b `j` d) Bi ab ba ---> Bi cd dc = Bi (\ ac -> ba>>>ac>>>cd) (\ bd -> ab>>>bd>>>dc)  -- TODO: Rewrite (--->) via (~>).  Currently would cause a module cycle@@ -85,5 +85,5 @@   -- | Apply a function in an alternative (monomorphic) representation.-inBi :: Arrow (~>) => Bijection (~>) a b -> (a ~> a) -> (b ~> b)+inBi :: Arrow j => Bijection j a b -> (a `j` a) -> (b `j` b) inBi (Bi to from) aa = from >>> aa >>> to
src/Data/Lambda.hs view
@@ -93,13 +93,13 @@  -- | 'lambda' with 'Arrw'.  /Warning/: definition uses 'arr', so only -- use if your arrow has a working 'arr'.-arLambda :: (Arrow (~>), Unlambda f f', Lambda g g')-      => LambdaTy (Arrw (~>) f g) (Arrw (~>) f' g')+arLambda :: (Arrow j, Unlambda f f', Lambda g g')+      => LambdaTy (Arrw j f g) (Arrw j f' g') arLambda = inArrw2 $ \ fga fgb ->   arr unlambda >>> fga***fgb >>> arr (uncurry lambda) -instance (Arrow (~>), Unlambda f f', Lambda g g')-    => Lambda (Arrw (~>) f g) (Arrw (~>) f' g')+instance (Arrow j, Unlambda f f', Lambda g g')+    => Lambda (Arrw j f g) (Arrw j f' g')   where lambda = arLambda
src/Data/Pair.hs view
@@ -95,8 +95,8 @@ -- Standard instance, e.g., (~>) = (->) -- This one requires UndecidableInstances.  Alternatively, specialize to -- (->) and other arrows as desired.-instance (Arrow (~>), Monoid_f (Flip (~>) o)) =>-  Pair (Flip (~>) o) where pair = copair+instance (Arrow j, Monoid_f (Flip j o)) =>+  Pair (Flip j o) where pair = copair  -- | Handy for 'Pair' instances apPair :: (Applicative h, Pair f) => PairTy (h :. f)@@ -108,12 +108,12 @@  -- | Pairing of 'Arrw' values.  /Warning/: definition uses 'arr', so only -- use if your arrow has a working 'arr'.-arPair :: (Arrow (~>), Unpair f, Pair g) => PairTy (Arrw (~>) f g)+arPair :: (Arrow j, Unpair f, Pair g) => PairTy (Arrw j f g) arPair = inArrw2 $ \ fga fgb ->   arr unpair >>> fga***fgb >>> arr (uncurry pair)  -- Standard instance-instance (Arrow (~>), Unpair f, Pair g) => Pair (Arrw (~>) f g)+instance (Arrow j, Unpair f, Pair g) => Pair (Arrw j f g)   where pair = arPair  instance (Pair f, Pair g) => Pair (f :*: g) where@@ -175,7 +175,7 @@   cosnds = inConst id  -- Standard instance for contravariant functors-instance Arrow (~>) => Copair (Flip (~>) o) where+instance Arrow j => Copair (Flip j o) where   { cofsts = contraFmap fst ; cosnds = contraFmap snd }  instance (Functor h, Copair f) => Copair (h :. f) where
src/Data/Zip.hs view
@@ -126,8 +126,8 @@ -- Standard instance, e.g., (~>) = (->) -- This one requires UndecidableInstances.  Alternatively, specialize to -- (->) and other arrows as desired.-instance (Arrow (~>), Monoid_f (Flip (~>) o)) =>-  Zip (Flip (~>) o) where zip = cozip+instance (Arrow j, Monoid_f (Flip j o)) =>+  Zip (Flip j o) where zip = cozip  -- | Handy for 'Zip' instances apZip :: (Applicative h, Zip f) => ZipTy (h :. f)@@ -139,12 +139,12 @@  -- | Ziping of 'Arrw' values.  /Warning/: definition uses 'arr', so only -- use if your arrow has a working 'arr'.-arZip :: (Arrow (~>), Unzip f, Zip g) => ZipTy (Arrw (~>) f g)+arZip :: (Arrow j, Unzip f, Zip g) => ZipTy (Arrw j f g) arZip = inArrw2 $ \ fga fgb ->   arr unzip >>> fga***fgb >>> arr (uncurry zip)  -- Standard instance-instance (Arrow (~>), Unzip f, Zip g) => Zip (Arrw (~>) f g)+instance (Arrow j, Unzip f, Zip g) => Zip (Arrw j f g)   where zip = arZip  instance (Zip f, Zip g) => Zip (f :*: g) where@@ -206,7 +206,7 @@   cosnds = inConst id  -- Standard instance for contravariant functors-instance Arrow (~>) => Cozip (Flip (~>) o) where+instance Arrow j => Cozip (Flip j o) where   { cofsts = contraFmap fst ; cosnds = contraFmap snd }  instance (Functor h, Cozip f) => Cozip (h :. f) where