TypeCompose 0.5 → 0.5.1

raw patch · 4 files changed

+62/−7 lines, 4 filesdep ~base

Dependency ranges changed: base

Files

• CHANGES +4/−0
• TypeCompose.cabal +1/−1
• src/Control/Compose.hs +43/−4
• src/Data/Bijection.hs +14/−2

@@ -1,5 +1,9 @@ % TypeCompose changes +== Version 0.5.1 ==++* Tweaked to work with ghc before and after 6.9+ == Version 0.5 ==  * Backed out DistribM.  Now that I've read "Composing Monads", I know

@@ -1,5 +1,5 @@ Name:                TypeCompose-Version:             0.5+Version:             0.5.1 Synopsis: 	     Type composition classes & instances Category:            Composition, Control Description:

@@ -1,6 +1,7 @@ {-# LANGUAGE Rank2Types, FlexibleInstances, MultiParamTypeClasses            , FlexibleContexts, UndecidableInstances, TypeSynonymInstances            , TypeOperators, GeneralizedNewtypeDeriving, StandaloneDeriving+           , CPP   #-} -- For ghc 6.6 compatibility -- {-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}@@ -61,7 +62,16 @@  import Control.Applicative -- import Control.Monad (liftM,join)-import Control.Arrow hiding (pure)+#if __GLASGOW_HASKELL__ >= 609+import Control.Category+import Prelude hiding ((.), id)+#endif++import Control.Arrow+#if __GLASGOW_HASKELL__ < 610+                      hiding (pure)+#endif+ import Data.Monoid  -- import Test.QuickCheck -- for Endo@@ -260,9 +270,18 @@ -- "StaticArrow" in [1]. newtype OO f (~>) a b = OO { unOO :: f (a ~> b) } ++#if __GLASGOW_HASKELL__ >= 609+instance (Applicative f, Category (~>)) => Category (OO f (~>)) where+  id          = OO (pure id)+  OO g . OO h = OO (liftA2 (.) g h)+#endif+ instance (Applicative f, Arrow (~>)) => Arrow (OO f (~>)) where-  arr           = OO . pure . arr+#if __GLASGOW_HASKELL__ < 609   OO g >>> OO h = OO (liftA2 (>>>) g h)+#endif+  arr           = OO . pure . arr   first (OO g)  = OO (liftA first g)  -- For instance, /\ a b. f (a -> m b) =~ OO f Kleisli m@@ -347,9 +366,19 @@   f ***% g = firstFun f >>> secondFun g   f &&&% g = arrFun (\b -> (b,b)) >>> f ***% g ++#if __GLASGOW_HASKELL__ >= 609+instance FunAble h => Category (FunA h) where+  id  = FunA (arrFun id)+  (.) = inFunA2 (.)+#endif++ instance FunAble h => Arrow (FunA h) where   arr p  = FunA    (arrFun p)+#if __GLASGOW_HASKELL__ < 609   (>>>)  = inFunA2 (>>>)+#endif   first  = inFunA  firstFun   second = inFunA  secondFun   (***)  = inFunA2 (***%)@@ -595,9 +624,19 @@          -> ((f ::*:: g) a b -> (f' ::*:: g') a' b' -> (f'' ::*:: g'') a'' b'') inProdd2 h (Prodd p) = inProdd (h p) ++#if __GLASGOW_HASKELL__ >= 609+instance (Category f, Category f') => Category (f ::*:: f') where+  id  = Prodd (id,id)+  (.) = inProdd2 ((.) ***# (.))+#endif++ instance (Arrow f, Arrow f') => Arrow (f ::*:: f') where-  arr    = Prodd .  (arr    &&&  arr   )-  (>>>)  = inProdd2 ((>>>)  ***# (>>>) )+  arr    = Prodd . (arr &&&  arr)+#if __GLASGOW_HASKELL__ < 609+  (>>>)  = inProdd2 ((>>>) ***# (>>>))+#endif   first  = inProdd  (first  ***  first )   second = inProdd  (second ***  second)   (***)  = inProdd2 ((***)  ***# (***) )

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeOperators, CPP #-} -- For ghc 6.6 compatibility -- {-# OPTIONS -fglasgow-exts #-} @@ -25,6 +25,10 @@   , inBi   ) where +#if __GLASGOW_HASKELL__ >= 609+import Control.Category+import Prelude hiding ((.), id)+#endif import Control.Arrow  @@ -47,9 +51,17 @@ inverse :: Bijection (~>) a b -> Bijection (~>) b a inverse (Bi ab ba) = Bi ba ab +#if __GLASGOW_HASKELL__ >= 609+instance Category (~>) => Category (Bijection (~>)) where+  id = Bi id id+  Bi bc cb . Bi ab ba = Bi (bc . ab) (ba . cb)+#endif+ instance Arrow (~>) => Arrow (Bijection (~>)) where-  arr = error "No arr for (:<->:)."+#if __GLASGOW_HASKELL__ < 609   Bi ab ba >>> Bi bc cb = Bi (ab >>> bc) (cb >>> ba)+#endif+  arr = error "No arr for (:<->:)."   first  (Bi ab ba) = Bi (first  ab) (first  ba)   second (Bi ab ba) = Bi (second ab) (second ba)   Bi ab ba *** Bi cd dc = Bi (ab *** cd) (ba *** dc)