packages feed

category-extras 0.2 → 0.44.1

raw patch · 82 files changed

+2929/−1425 lines, 82 filesdep +arraysetup-changednew-uploader

Dependencies added: array

Files

− Control/Comonad.hs 
@@ -1,149 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Control.Comonad--- Copyright   :  2004 Dave Menendez--- License     :  BSD3--- --- Maintainer  :  dan.doel@gmail.com--- Stability   :  experimental--- Portability :  portable------ This module declares the 'Comonad' class, with instances for--- 'Identity' and @((,) a)@, and defines the 'CoKleisli' arrow.--------------------------------------------------------------------------------module Control.Comonad-  (-  -- * The Comonad class-    Comonad(..)-  , (=>>)-  , (.>>)-  , liftW-  -  -- * The coKleisli arrow-  , CoKleisli(..)-  -  -- * The product comonad-  , local-  -  -- * Additional functions-  , sequenceW-  , mapW-  , parallelW-  , unfoldW-  )where--import Control.Arrow-import Control.Functor()--import Control.Monad.Identity--infixl 1 =>>, .>>--{-|-There are two ways to define a comonad:--I. Provide definitions for 'fmap', 'extract', and 'duplicate'-satisfying these laws:--> extract . duplicate      == id-> fmap extract . duplicate == id-> duplicate . duplicate    == fmap duplicate . duplicate--II. Provide definitions for 'extract' and 'extend'-satisfying these laws:--> extend extract      == id-> extract . extend f  == f-> extend f . extend g == extend (f . extend g)--('fmap' cannot be defaulted, but a comonad which defines-'extend' may simply set 'fmap' equal to 'liftW'.)--A comonad providing definitions for 'extend' /and/ 'duplicate',-must also satisfy these laws:--> extend f  == fmap f . duplicate-> duplicate == extend id-> fmap f    == extend (f . duplicate)--(The first two are the defaults for 'extend' and 'duplicate',-and the third is the definition of 'liftW'.)--}--class Functor w => Comonad w where-  extract   :: w a -> a-  duplicate :: w a -> w (w a)-  extend    :: (w a -> b) -> (w a -> w b)-  -  extend f  = fmap f . duplicate-  duplicate = extend id---- | 'fmap' defined in terms of 'extend'-liftW :: Comonad w => (a -> b) -> (w a -> w b)-liftW f = extend (f . extract)---- | 'extend' with the arguments swapped. Dual to '>>=' for monads.-(=>>) :: Comonad w => w a -> (w a -> b) -> w b-(=>>) = flip extend---- | Injects a value into the comonad.-(.>>) :: Comonad w => w a -> b -> w b-w .>> b = extend (\_ -> b) w-------instance Comonad Identity where-  extract (Identity x) = x-  duplicate y   = Identity y-  extend c w    = Identity (c w)--instance Comonad ((,) a) where-  extract   (_,x) = x-  duplicate (c,x) = (c,(c,x))---- | Calls a comonadic function in a modified context-local :: (c -> c') -> ((c',a) -> a) -> ((c,a) -> a)-local g f (c,x) = f (g c, x)------newtype CoKleisli w a b = CoKleisli { unCoKleisli :: w a -> b }--instance Functor (CoKleisli w a) where-  fmap f (CoKleisli g) = CoKleisli (f . g)--instance (Comonad w) => Arrow (CoKleisli w) where-  arr f = CoKleisli (f . extract)--  CoKleisli a >>> CoKleisli b-        = CoKleisli (b . fmap a . duplicate)-  -  CoKleisli a &&& CoKleisli b-        = CoKleisli (a &&& b)-  -  CoKleisli a *** CoKleisli b-        = CoKleisli (a . fmap fst &&& b . fmap snd)-  -  first a  = a *** arr id-  second a = arr id *** a------mapW :: Comonad w => (w a -> b) -> w [a] -> [b]-mapW f w | null (extract w) = []-         | otherwise        = f (fmap head w) : mapW f (fmap tail w)--parallelW :: Comonad w => w [a] -> [w a]-parallelW w | null (extract w) = []-            | otherwise        = fmap head w : parallelW (fmap tail w)--unfoldW :: Comonad w => (w b -> (a,b)) -> w b -> [a]-unfoldW f w = fst (f w) : unfoldW f (w =>> snd . f)---- | Converts a list of comonadic functions into a single function--- returning a list of values-sequenceW :: Comonad w => [w a -> b] -> w a -> [b]-sequenceW []     _ = []-sequenceW (f:fs) w = f w : sequenceW fs w
− Control/Comonad/Cofree.hs 
@@ -1,74 +0,0 @@-{-# LANGUAGE Rank2Types #-}---------------------------------------------------------------------------------- |--- Module      :  Control.Monad.Free--- Copyright   :  2004 Dave Menendez--- License     :  BSD3--- --- Maintainer  :  dan.doel@gmail.com--- Stability   :  experimental--- Portability :  portable------ An implementation of the cofree comonad of a functor, used in--- histomorphisms and chronomorphisms in Control.Recursion. The--- cofree comonad can also be seen as a stream parameterized by a--- functor that controls its branching factor.-----------------------------------------------------------------------------------module Control.Comonad.Cofree-  ( Cofree(..)-  , headCofree-  , tailCofree-  , anaCofree-  , cofreeToList-  , distribCofree-  ) where--import Control.Arrow ((&&&),(***),(>>>), second)-import Control.Comonad--{-|-The cofree comonad of a functor @h@ (also known as an H-branching stream).-Various comonads are a special instance of the cofree comonad:--* @Cofree Identity@ is an infinite stream--* @Cofree Maybe@ is a non-empty stream--* @Cofree []@ is a rose tree--formally:--> Cofree H A = nu X. A * HX--}-data Cofree h a = Cofree { unCofree :: (a, h (Cofree h a)) }---- | anamorphism for building a cofree comonad from a seed-anaCofree :: Functor h => (a -> b) -> (a -> h a) -> a -> Cofree h b-anaCofree g1 g2 = g1 &&& fmap (anaCofree g1 g2) . g2 >>> Cofree--headCofree :: Cofree h a -> a-headCofree = fst . unCofree--tailCofree :: Cofree h a -> h (Cofree h a)-tailCofree = snd . unCofree--instance Functor h => Functor (Cofree h) where-  fmap g = unCofree >>> g *** fmap (fmap g) >>> Cofree--instance Functor h => Comonad (Cofree h) where-  extract   = headCofree-  duplicate = anaCofree id tailCofree---- | Converts a value of the cofree comonad over Maybe into a non-empty list.-cofreeToList :: Cofree Maybe a -> [a]-cofreeToList = unCofree >>> second (maybe [] cofreeToList) >>> uncurry (:) ---- | Lifts a distributive law of @f@ over @h@ to a distributive law--- of @f@ over @Cofree h@.-distribCofree :: (Functor h, Functor f) =>-                 (forall a. f (h a) -> h (f a))-                   -> (forall a. f (Cofree h a) -> Cofree h (f a))-distribCofree d = anaCofree (fmap headCofree) (d . fmap tailCofree)
− Control/Comonad/Context.hs 
@@ -1,70 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Control.Comonad.Context--- Copyright   :  2004 Dave Menendez--- License     :  BSD3--- --- Maintainer  :  dan.doel@gmail.com--- Stability   :  experimental--- Portability :  portable------ Defines the state-in-context comonad, which is dual to the state monad.--- Each operation in the context comonad runs in a context determined--- by /later/ operations. (Observe, for example, 'experiment', which runs--- the preceeding operations multiple times in different contexts and--- returns a list of results.)-----------------------------------------------------------------------------------module Control.Comonad.Context-  ( Context(..)-  , get-  , modify-  , experiment-  , liftCtx-  ) where--import Control.Comonad--data Context c a = Context (c -> a) c--instance Functor (Context c) where-  fmap g (Context f c) = Context (g . f) c--instance Comonad (Context c) where-  extract   (Context f c) = f c-  duplicate (Context f c) = Context (Context f) c---- | Returns the context-get :: Context c a -> c-get (Context _ c) = c---- | Returns the result of the preceeding operations running in--- a modified context-modify :: (c -> c) -> Context c a -> a-modify m (Context f c) = f (m c)---- | Returns a list of results created by running prior operations--- in modified contexts created by the list of context-modifiers.-experiment :: [c -> c] -> Context c a -> [a]-experiment ms (Context f c) = map (\m -> f (m c)) ms--{-|-Lifts an operation into the context comonad. Syntactic sugar-for @fmap@ when chaining comonad operations.--@-  liftCtx         == extract . fmap f-  w =>> liftCtx f == fmap f w-@--}-liftCtx :: (a -> b) -> Context c a -> b-liftCtx g (Context f c) = g (f c)--{--inContext :: ((c -> a) -> c -> b) -> Context c a -> b-inContext op (Context f c) = op f c--get      = inContext (\f c -> c)-modify m = inContext (\f c -> f (m c))--}
− Control/Functor.hs 
@@ -1,113 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Control.Functor--- Copyright   :  2004 Dave Menendez--- License     :  BSD3--- --- Maintainer  :  dan.doel@gmail.com--- Stability   :  experimental--- Portability :  portable------ Functor composition, standard functors, and more.-----------------------------------------------------------------------------------module Control.Functor-  (-  -- * Unary functors-  -- ** Composition-    O(..)-  , lComp-  , rComp-  -- ** Basic Instances-  -- *** Unit-  , Unit(..)-  -  -- *** Const-  , Const(..)-  -  -- * Binary functors-  , Bifunctor(..)-  -  -- * Trinary functors-  , Trifunctor(..)-  ) where--infixr 2 `O`--{-|-Functor composition.--(Note: Some compilers will let you write @f \`O\` g@ rather than @O f g@;-we'll be doing so here for readability.)--Functor composition is associative, so @f \`O\` (g \`O\` h)@ and @(f \`O\` g) \`O\` h@-are equivalent. The functions 'lComp' and 'rComp' convert between the two.-(Operationally, they are equivalent to @id@. Their only purpose is to affect-the type system.)--}-newtype (O f g) a = Comp { deComp :: f (g a) }--instance (Functor f, Functor g) => Functor (O f g) where-  fmap f = Comp . fmap (fmap f) . deComp--lComp :: (Functor f) => (O f (O g h)) a -> (O (O f g) h) a-lComp = Comp . Comp . fmap deComp . deComp--rComp :: (Functor f) => (O (O f g) h) a -> (O f (O g h)) a-rComp = Comp . fmap Comp . deComp . deComp--{-|-The unit functor.--(Note: this is not the same as @()@. In fact, 'Unit' is the-fixpoint of @()@.)--}-data Unit a = Unit deriving (Show)--instance Functor Unit where-  fmap _ _    = Unit--instance Monad Unit where-  return _    = Unit-  _ >>= _     = Unit--{-|-Constant functors. Essentially the same as 'Unit', except that they also-carry a value.--}-data Const t a = Const { unConst :: t } deriving (Show)--instance Functor (Const t) where-  fmap _ (Const t) = Const t--{-| -A type constructor which takes two arguments and an associated map function.--Informally, @Bifunctor f@ implies @Functor (f a)@ with @fmap = bimap id@.--}-class Bifunctor f where-  bimap :: (a -> c) -> (b -> d) -> (f a b -> f c d)--instance Bifunctor (,) where-  bimap f g (x,y) = (f x, g y)--instance Bifunctor Either where-  bimap f _ (Left x)  = Left (f x)-  bimap _ g (Right x) = Right (g x)--{--instance (Trifunctor f) => Bifunctor (f a) where-  bimap = trimap id--}-{-|-A type constructor which takes three arguments and an associated map function.--Informally, @Trifunctor f@ implies @Bifunctor (f a)@ with @bimap = trimap id@.--}--class Trifunctor f where-  trimap :: (a -> a') -> (b -> b') -> (c -> c') -> (f a b c -> f a' b' c')--instance Trifunctor (,,) where-  trimap f g h (x,y,z) = (f x, g y, h z)
− Control/Functor/Adjunction.hs 
@@ -1,51 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Control.Functor.Adjunction--- Copyright   :  2004 Dave Menendez--- License     :  BSD3--- --- Maintainer  :  dan.doel@gmail.com--- Stability   :  experimental--- Portability :  non-portable (fundeps)-----------------------------------------------------------------------------------module Control.Functor.Adjunction where--import Control.Functor-import Control.Comonad--{-|-Minimal definitions:--1. @leftAdjunct@ and @rightAdjunct@--2. @unit@ and @counit@--Given functors @f@ and @g@, @Adjunction f g@ implies @Monad (g `'O'` f)@ and-@'Comonad' (f `'O'` g)@.---}-class (Functor f, Functor g) => Adjunction f g | f -> g, g -> f where-    leftAdjunct  :: (f a -> b) -> a -> g b-    rightAdjunct :: (a -> g b) -> f a -> b--    unit   :: a -> g (f a)-    counit :: f (g a) -> a--    unit           = leftAdjunct id-    counit         = rightAdjunct id-    leftAdjunct f  = fmap f . unit-    rightAdjunct g = counit . fmap g--instance (Adjunction f g) => Monad (O g f) where-  return  = Comp . unit-  m >>= k = Comp . fmap (rightAdjunct (deComp . k)) . deComp $ m--instance (Adjunction f g) => Comonad (O f g) where-  extract  = counit . deComp-  extend f = Comp . fmap (leftAdjunct (f . Comp)) . deComp-  -instance Adjunction ((,) a) ((->) a) where-  unit t = \x -> (x,t)-  counit (x,f) = f x
− Control/Functor/Transform.hs 
@@ -1,54 +0,0 @@-{-# LANGUAGE Rank2Types, TypeOperators #-}---------------------------------------------------------------------------------- |--- Module      :  Control.Functor.Transform--- Copyright   :  2004 Dave Menendez--- License     :  BSD3--- --- Maintainer  :  dan.doel@gmail.com--- Stability   :  experimental--- Portability :  non-portable (rank-2 polymorphism, infix type constructors)------ Description--------------------------------------------------------------------------------module Control.Functor.Transform-  ( module Control.Functor-  , (:>)-  , funcTrans-  , transFunc-  , (.>)-  ) where--import Control.Functor--{--Let F,G: C -> D be functors. Then t: F -> G is a natural transformation from-F to G iff:-	1. forall a in Ob(C). t[a] in D[F(a),G(a)]-	2. forall f in C[a,b]. t[b] . F(f) = G(f) . t[a]--Thus, a transformation t must satisfy:-	t . fmap f = fmap f . t-for any f--}--infix 1 :>--type f :> g = forall a. f a -> g a--{--maybeToList :: Maybe :> []-listToMaybe :: [] :> Maybe--}--transFunc :: (Functor k) => f :> g -> k `O` f :> k `O` g-transFunc t = Comp . fmap t . deComp--funcTrans :: f :> g -> f `O` h :> g `O` h-funcTrans t = Comp . t . deComp---(.>) :: (Functor k) => h :> k -> f :> g -> h `O` f :> k `O` g-s .> t = Comp . fmap t . s . deComp
− Control/Monad/Free.hs 
@@ -1,58 +0,0 @@-{-# LANGUAGE Rank2Types #-}---------------------------------------------------------------------------------- |--- Module      :  Control.Monad.Free--- Copyright   :  2008 Dan Doel, Edward Kmett--- License     :  BSD3--- --- Maintainer  :  dan.doel@gmail.com--- Stability   :  experimental--- Portability :  non-portable (rank-2 types)------ An implementation of the free monad of a functor, used in (at the least)--- futumorphisms and chronomorphisms in Control.Recursion-----------------------------------------------------------------------------------module Control.Monad.Free -       ( Free()-       , inFree-       , cataFree-       , distribFree-       ) where--import Control.Arrow ((|||), (+++), (>>>))-import Control.Applicative-import Control.Monad---- | The free monad of a functor 'f', formally,------ > Free F A = mu X. A + FX-newtype Free f a = Free { unFree :: Either a (f (Free f a)) }--instance (Functor f) => Functor (Free f) where-  fmap f = unFree >>> f +++ fmap (fmap f) >>> Free---instance (Functor f) => Applicative (Free f) where-  pure = return-  (<*>) = ap--instance (Functor f) => Monad (Free f) where-  return = Free . Left-  (Free e) >>= f = either f (inFree . fmap (>>= f)) e---- | The catamorphism for the free monad-cataFree :: Functor f => (a -> b) -> (f b -> b) -> Free f a -> b-cataFree f g = unFree >>> f ||| g . fmap (cataFree f g)--inFree :: f (Free f a) -> Free f a-inFree = Free . Right---- | Lifts a distributive law of @h@ over @f@ to a distributive--- law of @Free h@ over @f@-distribFree :: (Functor f, Functor h) =>-               (forall a. h (f a) -> f (h a))-                 -> (forall a. Free h (f a) -> f (Free h a))-distribFree d = cataFree (fmap return) (fmap inFree . d)
− Control/Recursion.hs 
@@ -1,527 +0,0 @@-{-# LANGUAGE -    Rank2Types-  , MultiParamTypeClasses-  , FunctionalDependencies-  , FlexibleInstances-  #-}---------------------------------------------------------------------------------- |--- Module      :  Control.Recursion--- Copyright   :  2004 Dave Menendez--- License     :  BSD3--- --- Maintainer  :  dan.doel@gmail.com--- Stability   :  experimental--- Portability :  non-portable (rank-2 polymorphism, fundeps)------ Provides implementations of /catamorphisms/ ('fold'), --- /anamorphisms/ ('unfold'), and /hylomorphisms/ ('refold'),--- along with many generalizations implementing various --- forms of iteration and coiteration.------ Also provided is a type class for transforming a functor--- to its fixpoint type and back ('Fixpoint'), along with--- standard functors for natural numbers and lists ('ConsPair'),--- and a fixpoint type for arbitrary functors ('Fix').------ Several combinators herein ((g_)futu, (g_)chrono, refoldWith, ...)--- are due to substantial help by Edward Kmett.-----------------------------------------------------------------------------------module Control.Recursion-  (-  -- * Folding-    fold-  , para-  , zygo-  , histo-  , g_histo-  , foldWith-  -  -- * Unfolding-  , unfold-  , apo-  , g_apo-  , unfoldWith-  , futu-  , g_futu-    -  -- * Transforming-  , refold-  , refoldWith-  , chrono-  , g_chrono--  -- * Dynamic Programming-  , dyna-  , g_dyna-  , codyna-  , g_codyna-    -  -- * Functor fixpoints-  , Fixpoint(..)-  , Fix(..)-  , ConsPair(..)-  , cons-  -  ) where-------import Control.Arrow-import Control.Functor-import Control.Monad.Identity-import Control.Monad.Free-import Control.Comonad-import Control.Comonad.Cofree--class Functor f => Fixpoint f t | t -> f where-  inF  :: f t -> t-  -- ^ formally, @in[f]: f -> mu f@--  outF :: t -> f t-  -- ^ formally, @in^-1[f]: mu f -> f@---- | Creates a fixpoint for any functor.-newtype Fix f = In (f (Fix f))--instance Functor f => Fixpoint f (Fix f) where-  inF         = In-  outF (In f) = f--instance Fixpoint Unit () where-  inF Unit = ()-  outF ()  = Unit--instance Fixpoint Maybe Int where-  inF Nothing        = 0-  inF (Just n)       = n + 1-  -  outF n | n > 0     = Just (n - 1)-         | otherwise = Nothing--instance Fixpoint Maybe Integer where-  inF Nothing        = 0-  inF (Just n)       = n + 1-  -  outF n | n > 0     = Just (n - 1)-         | otherwise = Nothing---- | Fixpoint of lists-data ConsPair a b = Nil | Pair a b deriving (Eq, Show)--instance Functor (ConsPair a) where-  fmap _ Nil        = Nil-  fmap f (Pair a b) = Pair a (f b)--instance Fixpoint (ConsPair a) [a] where-  inF Nil        = []-  inF (Pair a b) = a : b-  -  outF []        = Nil-  outF (x:xs)    = Pair x xs----- | Deconstructor for 'ConsPair'-cons :: c -> (a -> b -> c) -> (ConsPair a b -> c)-cons d _ Nil        = d-cons _ f (Pair a b) = f a b--{-|-A generalized @map@, known formally as a /hylomorphism/ and written [| f, g |].--@-	refold f g == 'fold' f . 'unfold' g-@--}-refold :: Functor f => (f b -> b) -> (a -> f a) -> a -> b-refold f g = f . fmap (refold f g) . g--{-|-A generalized @foldr@, known formally as a /catmorphism/ and written (| f |).--@-	fold f == 'refold' f 'outF'-	fold f == 'foldWith' ('Identity' . fmap 'runIdentity') (f . fmap 'runIdentity')-@--}-fold :: Fixpoint f t => (f a -> a) -> t -> a-fold f = refold f outF--{-|-A generalized @unfoldr@, known formally as an /anamorphism/ and written [( f )].--@-	unfold f == 'refold' 'inF' f-	unfold f == 'unfoldWith' (fmap 'Identity' . 'unIdentity') (fmap 'Identity' . f)-@--}-unfold :: Fixpoint f t => (a -> f a) -> a -> t-unfold f = refold inF f--{-|-A variant of 'fold' where the function /f/ also receives the result of the-inner recursive calls. Formally known as a /paramorphism/ and written \<| f |\>.-Dual to 'apo'.--@-	para   == 'zygo' 'inF'-	para f == 'refold' f (fmap (id &&& id) . 'outF')-	para f == f . fmap (id &&& para f) . 'outF'-@--Example: Computing the factorials.--> fact :: Integer -> Integer-> fact = para g->   where->     g Nothing      = 1->     g (Just (n,f)) = f * (n + 1)--* For the base case 0!, @g@ is passed @Nothing@. (Note that @'inF' Nothing == 0@.)--* For subsequent cases (/n/+1)!, @g@ is passed /n/ and /n/!.-(Note that @'inF' (Just n) == n + 1@.)--Point-free version: @fact = para $ maybe 1 (uncurry (*) . first (+1))@.--Example: @dropWhile@--> dropWhile :: (a -> Bool) -> [a] -> [a]-> dropWhile p = para f->   where->     f Nil         = []->     f (Pair x xs) = if p x then snd xs else x : fst xs--Point-free version:--> dropWhile p = para $ cons [] (\x xs -> if p x then snd xs else x : fst xs)--}-para :: Fixpoint f t => (f (t,a) -> a) -> t -> a-para = zygo inF---{-|-Implements course-of-value recursion. At each step, the function-receives an F-branching stream ('Cofree') containing the previous-values. Formally known as a /histomorphism/ and written {| f |}.--@-	histo == 'g_histo' id-@--Example: Computing Fibonacci numbers.--> fibo :: Integer -> Integer-> fibo = histo next->   where->     next :: Maybe (Cofree Maybe Integer) -> Integer->     next Nothing                             = 0->     next (Just (Consf _ Nothing))            = 1->     next (Just (Consf m (Just (Consf n _)))) = m + n--* For the base case F(0), @next@ is passed @Nothing@ and returns 0.-(Note that @'inF' Nothing == 0@)--* For F(1), @next@ is passed a one-element stream, and returns 1.--* For subsequent cases F(/n/), @next@ is passed a the stream-[F(/n/-1), F(/n/-2), ..., F(0)] and returns F(/n/-1)+F(/n/-2).---}--histo :: Fixpoint f t => (f (Cofree f a) -> a) -> t -> a-histo = g_histo id---------{-|-A generalization of 'para' implementing \"semi-mutual\" recursion.-Known formally as a /zygomorphism/ and written \<| f |\>^g, where /g/ is an-auxiliary function. Dual to 'g_apo'.--@-	zygo g == 'foldWith' (g . fmap fst &&& fmap snd)-@--}-zygo :: Fixpoint f t => (f b -> b) -> (f (b,a) -> a) -> t -> a-zygo g f = snd . fold (g . fmap fst &&& f)---{-|-Generalizes 'histo' to cases where the recursion functor and the-stream functor are distinct. Known as a /g-histomorphism/.--@-	g_histo g == 'foldWith' ('anaCofree' (fmap 'headCofree') (g . fmap 'tailCofree'))-@--}-g_histo :: (Functor h, Fixpoint f t)-       => (forall b. f (h b) -> h (f b))  --  distributive law for /h/ and /f/-       -> (f (Cofree h a) -> a) -> t -> a-g_histo = foldWith . distribCofree---{-|-Generalizes 'fold', 'zygo', and 'g_histo'. Formally known as a /g-catamorphism/-and written (| f |)^(w,k), where /w/ is a 'Comonad' and /k/ is a distributive law between-/n/ and the functor /f/.--The behavior of @foldWith@ is determined by the comonad /w/.--* 'Identity' recovers 'fold'--* @((,) a)@ recovers 'zygo' (and 'para')--* 'Cofree' recovers 'g_histo' (and 'histo')---}-foldWith :: (Fixpoint f t, Comonad w)-         => (forall b. f (w b) -> w (f b))  --  distributive law for /f/ and /w/-         -> (f (w a) -> a) -> t -> a-foldWith k f = extract . fold (fmap f . k . fmap duplicate)--------{-| /apomorphisms/, dual to 'para'--@-	apo   == 'g_apo' 'outF'- 	apo f == 'inF' . fmap (id ||| apo f) . f-@--Example: Appending a list to another list--> append :: [a] -> [a] -> [a]-> append = curry (apo f)->   where->     f :: ([a],[a]) -> ConsPair a (Either [a] ([a],[a]))->     f ([], [])   = Nil->     f ([], y:ys) = Pair y (Left ys)->     f (x:xs, ys) = Pair x (Right (xs,ys))---}-apo :: Fixpoint f t => (a -> f (Either t a)) -> a -> t-apo = g_apo outF--{-|-Generalized apomorphisms, dual to 'zygo'--@-	g_apo g == 'unfoldWith' (fmap Left . g ||| fmap Right)-@--}-g_apo :: Fixpoint f t => (b -> f b) -> (a -> f (Either b a)) -> a -> t-g_apo g f = unfold (fmap Left . g ||| f) . Right---{-|-Generalized anamorphisms parameterized by a monad, dual to 'foldWith'-- * @Identity@ recovers 'unfold'-- * @(Either a)@ recovers 'g_apo' (and 'apo')--}-unfoldWith :: (Fixpoint f t, Monad m)-           => (forall b. m (f b) -> f (m b)) -> (a -> f (m a)) -> a -> t-unfoldWith k f = unfold (fmap join . k . liftM f) . return---{-|-Generalized hylomorphisms parameterized by both a monad and a comonad.-This one combinator subsumes most-if-not-all the other combinators in-this library.-- * @w = Identity@ yields 'unfoldWith'-- * @m = Identity@ yields 'foldWith'-- * @Free m@ and @Cofree w@ yields 'g_chrono', and therefore 'g_histo' and 'g_futu'--@e@ and @g@ are additional functors related to @f@ by natural transformations-that have been fused into the distributive laws.--}-refoldWith :: (Comonad w, Functor f, Monad m) =>-              (forall c. f (w c) -> w (g c)) ->-              (forall c. m (e c) -> f (m c)) ->-              (g (w b) -> b) ->-              (a -> e (m a)) ->-              a -> b-refoldWith w m f g = extract . refoldWith' w m f g . return---- | The kernel of the generalized hylomorphism.-refoldWith' :: (Comonad w, Functor f, Monad m) =>-               (forall c. f (w c) -> w (g c)) ->-               (forall c. m (e c) -> f (m c)) ->-               (g (w b) -> b) ->-               (a -> e (m a)) ->-               (m a -> w b)-refoldWith' w m f g = liftW f . w . fmap (duplicate . refoldWith' w m f g . join) . m . liftM g--{-|-Futumorphism: course of argument coiteration--@-        futu == 'chrono' ('inF' . fmap 'headCofree')-        futu == 'g_futu' id-@--Example, translated from /Primitive (Co)Recursion and Course-of-Value-(Co)Iteration, Categorically/ -(<http://citeseer.ist.psu.edu/uustalu99primitive.html>):--> phi (x:y:zs) = Pair y . inFree . Pair x $ return zs--> exch = futu phi--> l = exch [1..] -- [2,1,4,3,6,5,8,7,10,9..]--}-futu :: (Fixpoint f t) => (a -> f (Free f a)) -> a -> t-futu = g_futu id--{-|-Generalized futumorphism--@-        g_futu m == 'g_chrono' (const 'Unit') m ('inF' . fmap 'headCofree')-        g_futu m == 'unfoldWith' ('distribFree' m)-@--}-g_futu :: (Functor h, Fixpoint f t) =>-          (forall b. h (f b) -> f (h b)) ->-          (a -> f (Free h a)) ->-          a -> t-g_futu = unfoldWith . distribFree---- | a chronomorphism, coined by Edward Kmett, subsumes both histo--- and futumorphisms.-chrono :: Functor f =>-          (f (Cofree f b) -> b) ->-          (a -> f (Free f a)) ->-          a -> b-chrono = g_chrono id id--{-|-Generalized chronomorphism. The recursion functor is separated from-the Free and Cofree functors, and related by distributive laws.--@-        g_chrono w m == 'refoldWith' ('distribCofree' w) ('distribFree' m)-@--}-g_chrono :: (Functor f, Functor m, Functor w) =>-            (forall c. f (w c) -> w (f c)) ->-            (forall c. m (f c) -> f (m c)) ->-            (f (Cofree w b) -> b) ->-            (a -> f (Free m a)) ->-            a -> b-g_chrono w m = refoldWith (distribCofree w) (distribFree m)--{-|-Dynamorphisms: a hylomorphism like combinator that captures dynamic-programming.--@-        dyna f g == 'g_dyna' id (fmap Identity . runIdentity) f (fmap Identity . g)-        dyna f g == 'chrono' f (fmap return . g)-@--Example, translated from /Recursion Schemes for Dynamic Programming/-(<http://citeseer.ist.psu.edu/748315.html>) section 4.2:--> data Poly a = Term | Single a | Double a a--> instance Functor Poly where->   fmap _ Term = Term->   fmap f (Single a) = Single (f a)->   fmap f (Double a b) = Double (f a) (f b)--> psi 0 = Term-> psi n->   | odd n  = Single (n-1)->   | even n = Double (n-1) (n `div` 2)--> phi Term = 1-> phi (Single n) = n-> phi (Double m n) = m + n--> bp1 = refold phi psi -- hylo version; ineffcient--> zeta 0 = Nil-> zeta n = Pair n (n-1)--> epsilon = headCofree--> theta = tailCofree--> pie x = let (Pair m y) = theta x in y--> pieN 0 x = x-> pieN n x = pieN (n-1) (pie x)--> sigma Nil = Term-> sigma (Pair n x)->   | odd n  = Single (epsilon x)->   | even n = Double (epsilon x) (epsilon (pieN (n`div`2 - 1) x))--> bp2 = dyna (phi . sigma) zeta -- dynamically programmed---}-dyna :: (Functor f) =>-        (f (Cofree f b) -> b) ->-        (a -> f a) ->-        a -> b-dyna f g = extract . dyna' f g---- | Kernel of the dynamorphism-dyna' :: (Functor f) =>-         (f (Cofree f b) -> b) ->-         (a -> f a) ->-         a -> Cofree f b-dyna' f g = refold (f &&& id >>> Cofree) g--{-|-Generalized dynamorphism--@-        g_dyna w == 'refoldWith' ('distribCofree' w)-@--}-g_dyna :: (Functor f, Functor h, Monad m) =>-          (forall c. f (h c) -> h (f c)) ->-          (forall c. m (e c) -> f (m c)) ->-          (f (Cofree h b) -> b) ->-          (a -> e (m a)) ->-          a -> b-g_dyna = refoldWith . distribCofree--{- Generalized dynamorphism kernel-g_dyna' :: (Functor f, Functor h, Monad m) =>-           (forall c. f (h c) -> h (f c)) ->-           (forall c. m (e c) -> f (m c)) ->-           (f (Cofree h b) -> b) ->-           (a -> e (m a)) ->-           m a -> Cofree h b-g_dyna' = refoldWith' . distribCofree--}--{-|-The dual of dynamorphisms.--}-codyna :: (Functor f) =>-          (f b -> b) ->-          (a -> f (Free f a)) ->-          a -> b-codyna f g = chrono (f . fmap extract) g--{-|-Generalized codynamorphisms.--}-g_codyna :: (Functor f, Functor h, Comonad w) =>-            (forall c. f (w c) -> w (g c)) ->-            (forall c. h (f c) -> f (h c)) ->-            (g (w b) -> b) ->-            (a -> f (Free h a)) ->-            a -> b-g_codyna w = refoldWith w . distribFree
− Data/InfiniteSeq.hs 
@@ -1,48 +0,0 @@-module Data.InfiniteSeq-  ( Seq-  , Nat-  , head-  , tail-  , cons-  , elemAt-  , drop-  , toStream-  , toList-  ) where--import Prelude hiding (head, tail, drop)-import Control.Comonad-import Data.Stream (Stream, mkStream)--type Nat = Int-type Seq a = Nat -> a---- instance Functor ((->) w) where---   fmap f = (f .)--instance Comonad ((->) Nat) where-  extract   s = s 0-  duplicate s = \i -> drop i s--head :: Seq a -> a-head s   = s 0--tail :: Seq a -> Seq a-tail s   = \i -> s (i + 1)--cons :: a -> Seq a -> Seq a-cons x s = \i -> if i == 0 then x else s (i - 1)--elemAt :: Nat -> Seq a -> a-elemAt i s = s i--drop :: Nat -> Seq a -> Seq a-drop n s = \i -> s (i+n)--toStream :: Seq a -> Stream a-toStream s = mkStream s head tail--toList :: Seq a -> [a]-toList s   = map s [0..]--
− Data/InfiniteTree.hs 
@@ -1,129 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}--module Data.InfiniteTree-  ( Tree-  , mkTree-  , root-  , left-  , right-  , branchF-  , surreals-  , showTree-  , showTreeWide-  , showTree'-  , showWide-  , rotateR-  , rotateL-  ) where--import Control.Arrow ((&&&))-import Control.Comonad--data Tree a = forall b. T b (b -> a) (b -> b) (b -> b)--mkTree :: seed -> (seed -> a) -> (seed -> seed) -> (seed -> seed) -> Tree a-mkTree seed v l r = T seed v l r--root :: Tree a -> a-root (T s v _ _) = v s--left :: Tree a -> Tree a-left (T s v l r) = T (l s) v l r--right :: Tree a -> Tree a-right (T s v l r) = T (r s) v l r--instance Functor Tree where-  fmap f (T s v l r) = T s (f . v) l r--instance Comonad Tree where-  extract = root-  extend f (T s v l r) = T s (\s' -> f (T s' v l r)) l r--branchF :: Functor f => f (Tree a) -> Tree (f a)-branchF f = mkTree f (fmap root) (fmap left) (fmap right)--surreals :: Fractional a => Tree a-surreals = mkTree (Nothing, Nothing) avg (fst &&& Just . avg) (Just . avg &&& snd)-  where-    avg (Nothing, Nothing) = 0-    avg (Just x,  Nothing) = x + 1-    avg (Nothing, Just y)  = y - 1-    avg (Just x,  Just y)  = (x + y) / 2-    -{--infix 1 &&&-f &&& g = \x -> (f x, g x)--}--showTree :: Show a => Int -> Tree a -> String-showTree = showTreeWide True--showTreeWide :: Show a => Bool -> Int -> Tree a -> String-showTreeWide wide d t = showTree' wide [] [] t d ""--showTree' :: Show a => Bool -> [String] -> [String] -> Tree a -> Int -> ShowS-showTree' _    _     _     _ 0 = id-showTree' _    lbars _     t 1-  = showBars lbars . shows (root t) . showString "...\n"-showTree' wide lbars rbars t d-  = showTree' wide (withBar rbars) (withEmpty rbars) (right t) (d - 1) .-    showWide wide rbars .-    showBars lbars . shows (root t) . showChar '\n' .-    showWide wide lbars .-    showTree' wide (withEmpty lbars) (withBar lbars) (left t) (d - 1)--showWide :: Bool -> [String] -> ShowS-showWide wide bars-  | wide      = showString (concat (reverse bars)) . showString "|\n"-  | otherwise = id--showBars :: [String] -> ShowS-showBars []   = id-showBars bars = showString (concat (reverse (tail bars))) . showString node--node :: String-node           = "+--"--withBar, withEmpty :: [String] -> [String]-withBar   bars = "|  " :bars-withEmpty bars = "   " :bars--data Rot = Zero | One | Two | Three---rotateL :: Tree a -> Tree a-rotateL t' = mkTree (t',Two) n l r-  where-    n (t,Two)  = root (right t)-    n (t,One)  = root t-    n (t,Zero) = root t-    n (_,Three) = error "rotateL n Three"-    -    l (t,Two)  = (t, One)-    l (t,One)  = (left t, Zero)-    l (t,Zero) = (left t, Zero)-    l (_,Three) = error "rotateL l Three"-    -    r (t,Two)  = (right (right t), Zero)-    r (t,One)  = (left (right t), Zero)-    r (t,Zero) = (right t, Zero)-    r (_,Three) = error "rotateL r Three"--rotateR :: Tree a -> Tree a-rotateR t' = mkTree (t',Two) n l r-  where-    n (t,Two)  = root (left t)-    n (t,One)  = root t-    n (t,Zero) = root t-    n (_,Three) = error "rotateR n Three"-    -    l (t,Two)  = (left (left t), Zero)-    l (t,One)  = (right (left t), Zero)-    l (t,Zero) = (left t, Zero)-    l (_,Three) = error "rotateR l Three"-    -    r (t,Two)  = (t, One)-    r (t,One)  = (right t, Zero)-    r (t,Zero) = (right t, Zero)-    r (_,Three) = error "rotateR r Three"
− Data/Stream.hs 
@@ -1,89 +0,0 @@-{-# LANGUAGE Rank2Types, ExistentialQuantification #-}--module Data.Stream-  ( Stream-  , mkStream-  , head-  , tail-  , cons-  , elemAt-  , toSeq-  , toList-  , mapStreamSt-  , fibs-  ) where--import Prelude hiding (head, tail, drop)-import Control.Comonad-import Control.Arrow ((&&&))--data Stream a = forall b.  S b (b -> a) (b -> b)--mkStream :: b -> (b -> a) -> (b -> b) -> Stream a-mkStream x f g = S x f g--instance Functor Stream where-  fmap = liftW--instance Comonad Stream where-  extract (S s f _)  = f s-  extend h (S s f g) = S s (\s' -> h (S s' f g)) g--head :: Stream a -> a-head (S x f _) = f x--tail :: Stream a -> Stream a-tail (S x f g) = S (g x) f g--cons :: a -> Stream a -> Stream a-cons x s = mkStream (x,s) fst ((head &&& tail) . snd)--elemAt :: Integral i => i -> Stream a -> a-elemAt n = head . drop n--drop :: Integral i => i -> Stream a -> Stream a-drop 0 = id-drop n = drop (n - 1) . tail--toSeq :: Stream a -> Int -> a-toSeq = flip elemAt--toList :: Stream a -> [a]-toList = map head . iterate tail--mapStreamSt :: (a -> s -> b) -> (a -> s -> s) -> s -> Stream a -> Stream b-mapStreamSt f1 f2 s0 xs-  = mkStream (xs,s0) -             (\(x,s) -> f1 (head x) s)-             (\(x,s) -> (tail x, f2 (head x) s))--fibs :: Stream Integer-fibs = mkStream (1,1) fst (\(i,j) -> (j,i+j))--{----------- A stream can be pulled from any comonad--parallelW :: Comonad w => w (Stream a) -> Stream (w a)-parallelW w = mkStream w (fmap head) (fmap tail)---- in fact, from any functor-parallelF :: (Functor f) => f (Stream a) -> Stream (f a)-parallelF f = mkStream f (fmap head) (fmap tail)------------ What good are these?--mapW :: Comonad w => (w a -> b) -> w (Stream a) -> Stream b-mapW f = fmap f . parallelW--unfold :: (b -> (a,b)) -> b -> Stream a-unfold f i = mkStream i (fst . f) (snd . f)--unfoldW :: Comonad w => (w b -> (a,b)) -> w b -> Stream a-unfoldW f w = mkStream w (fst . f) (=>> snd . f)--mkStreamW :: Comonad w => w b -> (w b -> a) -> (w b -> b) -> Stream a-mkStreamW w f g = mkStream w f (=>> g)--}
LICENSE view
@@ -1,27 +1,27 @@-Copyright (c) David Menendez 2004-+Copyright (c) 2008, Edward Kmett+Copyright (c) 2007, Iavor Diatchki+Copyright (c) 2004-2008, Dave Menendez All rights reserved. -Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-1. Redistributions of source code must retain the above copyright-   notice, this list of conditions and the following disclaimer.-2. 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.-3. Neither the name of the author nor the names of his contributors-   may be used to endorse or promote products derived from this software-   without specific prior written permission.+Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: -THIS SOFTWARE IS PROVIDED BY 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 AUTHORS OR 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.+    * 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 the name of Edward Kmett nor the names of its other contributors +      may be used to endorse or promote products derived from this software +      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT OWNER OR 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.lhs view
@@ -1,4 +1,3 @@ #!/usr/bin/env runhaskell- > import Distribution.Simple-> main = defaultMain+> main = defaultMainWithHooks simpleUserHooks
category-extras.cabal view
@@ -1,39 +1,106 @@-Name:			category-extras-Version:		0.2-Description:		A collection of modules implementing various ideas from-			category theory. Notable bits include: comonads, adjunctions,-			functor fixedpoints and various recursion operaters ala-			/Functional Programming with Bananas, Lenses, Envelopes-			and Barbed Wire/.-Synopsis:		Various modules and constructs inspired by category theory.-Category:		Control, Data-License:		BSD3-License-File:		LICENSE-Copyright:		Copyright (c) 2004--2008 Dave Menendez-Author:			Dave Menendez-Maintainer:		dan.doel@gmail.com-Homepage:		http://code.haskell.org/~dolio/category-extras+name:			category-extras+category:		Control, Monads, Comonads+version:		0.44.1+license:		BSD3+license-file:		LICENSE+build-depends:		base -any, mtl -any, array -any+author:			Edward A. Kmett, Dave Menendez+maintainer:		ekmett@gmail.com+stability:		experimental+homepage:		http://comonad.com/reader/+synopsis:		Various modules and constructs inspired by category theory.+build-type: 		Simple+copyright:		Copyright (C) 2008 Edward A. Kmett+			Copyright (C) 2004--2008 Dave Menendez+			Copyright (C) 2007 Iavor Diatchki+description: 		A vastly expanded collection of modules implementing various +			ideas from category theory. Notable bits include: comonads, +			adjunctions, functor fixedpoints and various recursion +			operaters ala /Functional Programming with Bananas, Lenses, +			Envelopes and Barbed Wire/.  -Stability:		Experimental-Tested-With:		GHC-Build-Depends:		base, mtl-Build-Type:		Simple+extensions:		+	CPP, +	EmptyDataDecls, +	FlexibleContexts,+	FlexibleInstances,+	FunctionalDependencies, +	MultiParamTypeClasses, +	TypeOperators,+	UndecidableInstances,+	ExistentialQuantification,+	Rank2Types -Exposed-Modules:	Control.Comonad-			Control.Comonad.Context-			Control.Comonad.Cofree-			Control.Functor-			Control.Functor.Adjunction-			Control.Functor.Transform-			Control.Recursion-			Control.Monad.Free-			Data.InfiniteSeq-			Data.InfiniteTree-			Data.Stream-Extensions:		Rank2Types,-			MultiParamTypeClasses,-			FunctionalDependencies,-			TypeOperators,-			FlexibleInstances,-			ExistentialQuantification-GHC-Options:		-O2 -Wall++exposed-modules:+	Control.Arrow.BiKleisli,+	Control.Arrow.CoKleisli,+	Control.Bifunctor,+	Control.Bifunctor.Associative,+	Control.Bifunctor.Braided,+	Control.Bifunctor.Composition,+	Control.Bifunctor.Either,+	Control.Bifunctor.Fix,+	Control.Bifunctor.HigherOrder,+	Control.Bifunctor.Monoidal,+	Control.Bifunctor.Pair,+	Control.Comonad,+	Control.Comonad.Cofree,+	Control.Comonad.Composition,+	Control.Comonad.Context,+	Control.Comonad.Context.Class,+	Control.Comonad.Identity,+	Control.Comonad.Indexed,+	Control.Comonad.HigherOrder,+	Control.Comonad.Parameterized,+	Control.Comonad.Parameterized.Class,+	Control.Comonad.Pointer,+	Control.Comonad.Reader,+	Control.Comonad.Reader.Class,+	Control.Comonad.Supply+	Control.Functor.Adjunction,+	Control.Functor.Algebra,+	Control.Functor.Bifunctor,+	Control.Functor.Composition+	Control.Functor.Composition.Class+	Control.Functor.Contravariant,+	Control.Functor.Constant,+	Control.Functor.Derivative,+	Control.Functor.Extras,+	Control.Functor.Exponential,+	Control.Functor.Fix,+	Control.Functor.Full,+	Control.Functor.HigherOrder,+	Control.Functor.Indexed,+	Control.Functor.KanExtension,+	Control.Functor.Strong,+	Control.Functor.Pointed,+	Control.Functor.Pointed.Composition,+	Control.Functor.Representable,+	Control.Functor.Zip,+	Control.Functor.Zap,+	Control.Monad.Composition,+	Control.Monad.Free,+	Control.Monad.HigherOrder,+	Control.Monad.Indexed,+	Control.Monad.Indexed.State,+	Control.Monad.Indexed.Cont,+	Control.Monad.Parameterized,+	Control.Monad.Parameterized.Class,+	Control.Monad.Hyper,+	Control.Monad.Either,+	Control.Morphism.Hylo,+	Control.Morphism.Cata,+	Control.Morphism.Ana,+	Control.Morphism.Meta,+	Control.Morphism.Futu,+	Control.Morphism.Chrono,+	Control.Morphism.Para,+	Control.Morphism.Dyna,+	Control.Morphism.Apo,+	Control.Morphism.Zygo,+	Control.Morphism.Histo,+	Data.Void++ghc-options:		-O2 -funbox-strict-fields +hs-source-dirs:		src
+ src/Control/Arrow/BiKleisli.hs view
@@ -0,0 +1,40 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Arrow.BiKleisli+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD3+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: portable+--+-------------------------------------------------------------------------------------------++module Control.Arrow.BiKleisli where++#if __GLASGOW_HASKELL__ >= 609 +import Prelude hiding (id,(.))+import Control.Category+#endif+import Control.Monad (liftM)+import Control.Comonad+import Control.Arrow+import Control.Functor.Extras++newtype BiKleisli w m a b = BiKleisli { runBiKleisli :: w a -> m b } ++instance Monad m => Functor (BiKleisli w m a) where+	fmap f (BiKleisli g) = BiKleisli (liftM f . g)++instance (Comonad w, Monad m, Distributes w m) => Arrow (BiKleisli w m) where+	arr f = BiKleisli (return . f . extract)+	first (BiKleisli f) = BiKleisli $ \x -> do+		u <- f (fmap fst x)+		return (u, extract (fmap snd x))+#if __GLASGOW_HASKELL__ < 609+	BiKleisli g >>> BiKleisli f = BiKleisli ((>>= f) . dist . extend g)+#else +instance (Comonad w, Monad m, Distributes w m) => Category (BiKleisli w m) where+	BiKleisli f . BiKleisli g = BiKleisli ((>>=f) . dist . extend g)+	id = BiKleisli (return . extract)+#endif
+ src/Control/Arrow/CoKleisli.hs view
@@ -0,0 +1,39 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Arrow.CoKleisli+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD3+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: portable+--+-------------------------------------------------------------------------------------------+module Control.Arrow.CoKleisli where++#if __GLASGOW_HASKELL__ >= 609 +import Prelude hiding (id,(.))+import Control.Category+#endif+import Control.Comonad+import Control.Arrow++newtype CoKleisli w a b = CoKleisli { runCoKleisli :: w a -> b } ++instance Functor (CoKleisli w a) where+	fmap f (CoKleisli g) = CoKleisli (f . g)++instance Comonad w => Arrow (CoKleisli w) where+	arr f = CoKleisli (f . extract)+	CoKleisli a &&& CoKleisli b = CoKleisli (a &&& b)+	CoKleisli a *** CoKleisli b = CoKleisli (a . fmap fst &&& b . fmap snd)+	first a = a *** CoKleisli extract+	second a = CoKleisli extract *** a+#if __GLASGOW_HASKELL__ >= 609+instance Comonad w => Category (CoKleisli w) where+	id = CoKleisli extract+	CoKleisli b . CoKleisli a = CoKleisli (b . fmap a . duplicate)+#else+	CoKleisli a >>> CoKleisli b = CoKleisli (b . fmap a . duplicate)+#endif+
+ src/Control/Bifunctor.hs view
@@ -0,0 +1,19 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Bifunctor+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD3+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-------------------------------------------------------------------------------------------+module Control.Bifunctor where++class Bifunctor f where+	bimap :: (a -> c) -> (b -> d) -> f a b -> f c d+	first :: (a -> c) -> f a b -> f c b+	first f = bimap f id+	second :: (b -> d) -> f a b -> f a d+	second = bimap id
+ src/Control/Bifunctor/Associative.hs view
@@ -0,0 +1,39 @@+-- {-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Bifunctor.Associative+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (class-associated types)+--+-- NB: this contradicts another common meaning for an 'Associative' 'Category', which is one +-- where the pentagonal condition does not hold, but for which there is an identity.+--+-------------------------------------------------------------------------------------------+module Control.Bifunctor.Associative where++import Control.Bifunctor++{- | A category with an associative bifunctor satisfying Mac Lane\'s pentagonal coherence identity law:++> bimap id associate . associate . bimap associate id = associate . associate+-}+class Bifunctor p => Associative p where+	associate :: p (p a b) c -> p a (p b c)++{- | A category with a coassociative bifunctor satisyfing the dual of Mac Lane's pentagonal coherence identity law:++> bimap coassociate id . coassociate . bimap id coassociate = coassociate . coassociate+-}+class Bifunctor s => Coassociative s where+	coassociate :: s a (s b c) -> s (s a b) c++{-# RULES+"copentagonal coherence" bimap coassociate id . coassociate . bimap id coassociate = coassociate . coassociate+"pentagonal coherence" bimap id associate . associate . bimap associate id = associate . associate+ #-}++
+ src/Control/Bifunctor/Braided.hs view
@@ -0,0 +1,45 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Bifunctor.Braided+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: portable+--+-------------------------------------------------------------------------------------------+module Control.Bifunctor.Braided where++import Control.Bifunctor+import Control.Bifunctor.Associative++{- | A braided (co)(monoidal or associative) category can commute the arguments of its bi-endofunctor. Obeys the laws:++> idr . braid = idl +> idl . braid = idr +> braid . coidr = coidl +> braid . coidl = coidr +> associate . braid . associate = second braid . associate . first braid +> coassociate . braid . coassociate = first braid . coassociate . second braid ++-}++class Bifunctor p => Braided p where+	braid :: p a b -> p b a++{- |+If we have a symmetric (co)'Monoidal' category, you get the additional law:++> swap . swap = id+ -}+class Braided p => Symmetric p++swap :: Symmetric p => p a b -> p b a+swap = braid++{-# RULES+"swap/swap" swap . swap = id+"braid/associate/braid"         bimap id braid . associate . bimap braid id = associate . braid . associate+"braid/coassociate/braid"       bimap braid id . coassociate . bimap id braid = coassociate . braid . coassociate+ #-}
+ src/Control/Bifunctor/Composition.hs view
@@ -0,0 +1,141 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Bifunctor.Composition+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD3+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: portable+--+-------------------------------------------------------------------------------------------++module Control.Bifunctor.Composition where+++import Control.Comonad+import Control.Bifunctor+import Control.Bifunctor.Associative+import Control.Bifunctor.Braided+import Control.Bifunctor.Monoidal+import Control.Functor.Pointed+import Control.Functor.Exponential+import Control.Functor.Contravariant++newtype ArrowB f g a b = ArrowB { runArrowB :: f a b -> g a b }++++newtype ConstB t a b = ConstB { runConstB :: t } ++instance Bifunctor (ConstB t) where+	bimap f g = ConstB . runConstB+instance Functor (ConstB t a) where+	fmap f = ConstB . runConstB++++newtype FstB a b = FstB { runFstB :: a } ++instance Bifunctor FstB where+	bimap f g = FstB . f . runFstB ++instance Associative FstB where+	associate = FstB . runFstB . runFstB++instance Functor (FstB a) where+        fmap f (FstB a) = FstB a++instance ContravariantFunctor (FstB a) where+        contramap f (FstB a) = FstB a++instance ExpFunctor (FstB a) where+        xmap f g (FstB a) = FstB a+++newtype SndB a b = SndB { runSndB :: b } ++instance Bifunctor SndB where+	bimap f g = SndB . g . runSndB ++-- instance Coassociative SndB where+--	coassociate = SndB . SndB . runSndB++-- as a functor its a family of identity functors with a type-level parameter (a)+instance Functor (SndB a) where+	fmap = bimap id++-- bifunctor composition++newtype CompB p f g a b = CompB { runCompB :: p (f a b) (g a b) }++instance (Bifunctor p, Bifunctor f, Bifunctor g) => Bifunctor (CompB p f g) where+	bimap f g = CompB . bimap (bimap f g) (bimap f g) . runCompB++liftCompB :: Bifunctor p => (f a b -> f c d) -> (g a b -> g c d) -> CompB p f g a b -> CompB p f g c d +liftCompB f g = CompB . bimap f g . runCompB++instance (Bifunctor p, Braided f, Braided g) => Braided (CompB p f g) where+	braid = liftCompB braid braid++instance (Bifunctor p, Symmetric f, Symmetric g) => Symmetric (CompB p f g) ++instance (Bifunctor p, Bifunctor f, Bifunctor g) => Functor (CompB p f g a) where+	fmap = bimap id++++++newtype SwapB p a b = SwapB { runSwapB :: p b a } ++liftSwapB :: Bifunctor p => (p a b -> p c d) -> SwapB p b a -> SwapB p d c+liftSwapB f = SwapB . f . runSwapB++instance Bifunctor p => Bifunctor (SwapB p) where+	bimap f g = liftSwapB (bimap g f)++instance Braided p => Braided (SwapB p) where+	braid = liftSwapB braid++instance Symmetric p => Symmetric (SwapB p)++instance Bifunctor p => Functor (SwapB p a) where+	fmap = bimap id+++++-- a functor composed around a bifunctor++newtype FunctorB f p a b = FunctorB { runFunctorB :: f (p a b) } ++liftFunctorB :: Functor f => (p a b -> p c d) -> FunctorB f p a b -> FunctorB f p c d+liftFunctorB f = FunctorB . fmap f . runFunctorB++instance (Functor f, Bifunctor p) => Bifunctor (FunctorB f p) where+	bimap f g = liftFunctorB (bimap f g)++instance (Functor f, Braided p) => Braided (FunctorB f p) where+	braid = liftFunctorB braid++instance (Functor f, Symmetric p) => Symmetric (FunctorB f p) ++instance (Functor f, Bifunctor p) => Functor (FunctorB f p a) where+	fmap = bimap id+++-- a bifunctor wrapping a pair of functors with different values++newtype BiffB p f g a b = BiffB { runBiffB :: p (f a) (g b) } ++instance (Functor f, Bifunctor p, Functor g) => Bifunctor (BiffB p f g) where+	bimap f g = BiffB . bimap (fmap f) (fmap g) . runBiffB++instance (Functor f, Braided p) => Braided (BiffB p f f) where+	braid = BiffB . braid . runBiffB++instance (Functor f, Symmetric p) => Symmetric (BiffB p f f) ++instance (Functor f, Bifunctor p, Functor g) => Functor (BiffB p f g a) where+	fmap f = bimap id f
+ src/Control/Bifunctor/Either.hs view
@@ -0,0 +1,39 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Bifunctor.Either+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Bifunctor.Either where++import Control.Bifunctor+import Control.Bifunctor.Associative+import Control.Bifunctor.Monoidal+import Control.Bifunctor.Braided+import Data.Void+import Control.Arrow ((***), (+++))++instance Bifunctor Either where+	bimap = (+++)++instance Associative Either where+	associate (Left (Left a)) = Left a+	associate (Left (Right b)) = Right (Left b)+	associate (Right c) = Right (Right c)++instance Coassociative Either where+	coassociate (Left a) = Left (Left a)+	coassociate (Right (Left b)) = Left (Right b)+	coassociate (Right (Right c)) = Right c++instance Braided Either where+	braid (Left a) = Right a+	braid (Right b) = Left b++instance Symmetric Either
+ src/Control/Bifunctor/Fix.hs view
@@ -0,0 +1,19 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Bifunctor.Fix+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: portable+--+-------------------------------------------------------------------------------------------+module Control.Bifunctor.Fix where++import Control.Bifunctor++newtype FixB s a = InB { outB :: s a (FixB s a) }++instance Bifunctor s => Functor (FixB s) where+        fmap f = InB . bimap f (fmap f) . outB
+ src/Control/Bifunctor/HigherOrder.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Bifunctor.HigherOrder+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Bifunctor.HigherOrder where++import Control.Bifunctor+import Control.Functor.Extras++{-+type BiNatural p q = forall a b. p a b -> q a b++class HBifunctor p where+        fbimap :: Bifunctor q => (a -> b) -> (c -> d) -> p q a c -> p q b d+	hbimap :: BiNatural g h -> BiNatural (p g) (p h)++newtype MuHB p a b = InHB { outHB :: p (MuHB p) a b }+type NuHB p a b = MuHB p a b+-}
+ src/Control/Bifunctor/Monoidal.hs view
@@ -0,0 +1,72 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Bifunctor.Monoidal+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (class-associated types)+--+-- A 'Monoidal' category is a category with an associated biendofunctor that has an identity,+-- which satisfies Mac Lane''s pentagonal and triangular coherence conditions+-- Technically we usually say that category is 'monoidal', but since+-- most interesting categories in our world have multiple candidate bifunctors that you can +-- use to enrich their structure, we choose here to think of the bifunctor as being +-- monoidal. This lets us reuse the same Bifunctor over different categories without +-- painful type annotations.+-------------------------------------------------------------------------------------------+module Control.Bifunctor.Monoidal where++import Control.Bifunctor+import Control.Bifunctor.Associative+import Control.Bifunctor.Braided++-- | Denotes that we have some reasonable notion of 'Identity' for a particular 'Bifunctor' in this 'Category'. This+-- notion is currently used by both 'Monoidal' and 'Comonoidal'+class Bifunctor p => HasIdentity p i | p -> i ++{- | A monoidal category. 'idl' and 'idr' are traditionally denoted lambda and rho+ the triangle identity holds:++> bimap idr id = bimap id idl . associate +> bimap id idl = bimap idr id . associate+-}++class (Associative p, HasIdentity p i) => Monoidal p i | p -> i where+	idl :: p i a -> a+	idr :: p a i -> a++{- | A comonoidal category satisfies the dual form of the triangle identities++> bimap idr id = coassociate . bimap id idl+> bimap id idl = coassociate . bimap idr id++This type class is also (ab)used for the inverse operations needed for a strict (co)monoidal category.+A strict (co)monoidal category is one that is both 'Monoidal' and 'Comonoidal' and satisfies the following laws:++> idr . coidr = id +> idl . coidl = id +> coidl . idl = id +> coidr . idr = id ++-}+class (Coassociative p, HasIdentity p i) => Comonoidal p i | p -> i where+	coidl :: a -> p i a+	coidr :: a -> p a i++{-# RULES+-- "bimap id idl/associate" 		bimap id idl . associate = bimap idr id+-- "bimap idr id/associate" 		bimap idr id . associate = bimap id idl+-- "coassociate/bimap id idl"  		coassociate . bimap id idl = bimap idr id+-- "coassociate/bimap idr id"  		coassociate . bimap idr id = bimap id idl+"idr/coidr" 			idr . coidr = id+"idl/coidl"			idl . coidl = id+"coidl/idl"			coidl . idl = id+"coidr/idr"			coidr . idr = id+"idr/braid"                     idr . braid = idl+"idl/braid"                     idl . braid = idr+"braid/coidr"                   braid . coidr = coidl+"braid/coidl"                   braid . coidl = coidr+ #-}+
+ src/Control/Bifunctor/Pair.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Bifunctor.Pair+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Bifunctor.Pair where++import Control.Bifunctor+import Control.Bifunctor.Associative+import Control.Bifunctor.Monoidal+import Control.Bifunctor.Braided+import Data.Void+import Control.Arrow ((***), (+++))++instance Bifunctor (,) where+        bimap = (***)++instance Associative (,) where+	associate ((a,b),c) = (a,(b,c))++instance Coassociative (,) where+	coassociate (a,(b,c)) = ((a,b),c)++instance HasIdentity (,) Void++instance Monoidal (,) Void where+	idl = snd+	idr = fst++instance Braided (,) where+	braid ~(a,b) = (b,a)++instance Symmetric (,)+
+ src/Control/Comonad.hs view
@@ -0,0 +1,91 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad+-- Copyright   :  (C) 2008 Edward Kmett+--		  (C) 2004 Dave Menendez+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- This module declares the 'Comonad' class+----------------------------------------------------------------------------+module Control.Comonad where++import Control.Monad+import Control.Arrow ((|||), (&&&), (+++), (***))++infixl 1 =>>, .>>++{-|+There are two ways to define a comonad:++I. Provide definitions for 'fmap', 'extract', and 'duplicate'+satisfying these laws:++> extract . duplicate      == id+> fmap extract . duplicate == id+> duplicate . duplicate    == fmap duplicate . duplicate++II. Provide definitions for 'extract' and 'extend'+satisfying these laws:++> extend extract      == id+> extract . extend f  == f+> extend f . extend g == extend (f . extend g)++('fmap' cannot be defaulted, but a comonad which defines+'extend' may simply set 'fmap' equal to 'liftW'.)++A comonad providing definitions for 'extend' /and/ 'duplicate',+must also satisfy these laws:++> extend f  == fmap f . duplicate+> duplicate == extend id+> fmap f    == extend (f . duplicate)++(The first two are the defaults for 'extend' and 'duplicate',+and the third is the definition of 'liftW'.)+-}++class Functor w => Comonad w where+        duplicate :: w a -> w (w a)+        extend :: (w a -> b) -> w a -> w b+        extract :: w a -> a+        extend f = fmap f . duplicate+        duplicate = extend id++liftW :: Comonad w => (a -> b) -> w a -> w b+liftW f = extend (f . extract)++-- | 'extend' with the arguments swapped. Dual to '>>=' for monads.+(=>>) :: Comonad w => w a -> (w a -> b) -> w b+(=>>) = flip extend++-- | Injects a value into the comonad.+(.>>) :: Comonad w => w a -> b -> w b+w .>> b = extend (\_ -> b) w++-- | Transform a function into a comonadic action+liftCtx :: Comonad w => (a -> b) -> w a -> b+liftCtx f = extract . fmap f++mapW :: Comonad w => (w a -> b) -> w [a] -> [b]+mapW f w | null (extract w) = []+         | otherwise        = f (fmap head w) : mapW f (fmap tail w)++parallelW :: Comonad w => w [a] -> [w a]+parallelW w | null (extract w) = []+            | otherwise        = fmap head w : parallelW (fmap tail w)++unfoldW :: Comonad w => (w b -> (a,b)) -> w b -> [a]+unfoldW f w = fst (f w) : unfoldW f (w =>> snd . f)++-- | Converts a list of comonadic functions into a single function+-- returning a list of values+sequenceW :: Comonad w => [w a -> b] -> w a -> [b]+sequenceW []     _ = []+sequenceW (f:fs) w = f w : sequenceW fs w+
+ src/Control/Comonad/Cofree.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Cofree+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  rank-2 types +--+----------------------------------------------------------------------------+module Control.Comonad.Cofree where++import Control.Arrow ((&&&))+import Control.Bifunctor+import Control.Bifunctor.Fix+import Control.Bifunctor.Composition+import Control.Bifunctor.Pair+import Control.Comonad+import Control.Comonad.Parameterized+import Control.Comonad.Parameterized.Class+import Control.Functor.Extras+import Control.Monad.Identity+import Control.Monad.Parameterized+import Control.Monad.Parameterized.Class++type CofreeB f a b = BiffB (,) Identity f a b+type Cofree f a = FixB (BiffB (,) Identity f) a++instance Functor f => PComonad (BiffB (,) Identity f) where+	pextract = runIdentity . fst . runBiffB+	pextend f = BiffB . (Identity . f &&& snd . runBiffB)++instance FunctorPlus f => PMonad (BiffB (,) Identity f) where+	preturn a = BiffB (Identity a,fzero)+	pbind k (BiffB ~(Identity a,as)) = BiffB (ib, fplus as bs) where BiffB (ib,bs) = k a ++outCofree :: Cofree f a -> f (Cofree f a)+outCofree = snd . runBiffB . outB++runCofree :: Cofree f a -> (a, f (Cofree f a))+runCofree = first runIdentity . runBiffB . outB++anaCofree :: Functor f => (a -> c) -> (a -> f a) -> a -> Cofree f c+anaCofree h t = InB . BiffB . (Identity . h &&& fmap (anaCofree h t) . t)++cofree :: a -> f (Cofree f a) -> Cofree f a +cofree a as = InB $ BiffB (Identity a,as)+
+ src/Control/Comonad/Composition.hs view
@@ -0,0 +1,40 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Comonad.Composition+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-- composing a comonad with a copointed endofunctor yields a comonad given a distributive law+-------------------------------------------------------------------------------------------++module Control.Comonad.Composition where++import Control.Comonad+import Control.Functor.Composition+import Control.Functor.Composition.Class+import Control.Functor.Extras+import Control.Functor.Pointed+import Control.Functor.Pointed.Composition++-- postDuplicate :: (Comonad w, PostUnfold w f) => w (f a) -> w (f (w (f a)))+-- postDuplicate = fmap postUnfold . duplicate++instance (Comonad w, Copointed f, PostUnfold w f) => Comonad (PostCompF w f) where+	extract = copoint . extract . decompose+	duplicate = compose . liftW (fmap compose . postUnfold) . duplicate . decompose++-- preDuplicate :: (Comonad w, Functor f, PreUnfold f w) => f (w a) -> f (w (f (w a)))+-- preDuplicate = preUnfold . fmap duplicate++instance (Copointed f, Comonad w, PreUnfold f w) => Comonad (PreCompF f w) where+	extract = extract . copoint .  decompose+	duplicate = compose . fmap (liftW compose) . preUnfold . fmap (duplicate) . decompose++instance (Comonad f, Comonad g, Distributes f g) => Comonad (DistCompF f g) where+	extract = extract . extract . decompose+	duplicate = compose . fmap (fmap compose . dist) . duplicate . fmap duplicate . decompose+--	join = compose . fmap join . join . fmap dist . fmap (fmap decompose) . decompose
+ src/Control/Comonad/Context.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Context+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- The state-in-context comonad and comonad transformer+----------------------------------------------------------------------------+module Control.Comonad.Context where++import Control.Arrow ((&&&), first)+import Control.Comonad+import Control.Comonad.Context.Class+++data Context s a = Context (s -> a) s++runContext f s = (a b, b) where+	Context a b = f (Context id s)++instance ComonadContext s (Context s) where+	getC (Context f s) = s+	modifyC m (Context f c) = f (m c)+	+instance Functor (Context s) where+	fmap f (Context f' s) = Context (f . f') s++instance Comonad (Context s) where+	extract   (Context f a) = f a+	duplicate (Context f a) = Context (Context f) a+++++newtype ContextT s w a = ContextT { runContextT :: (w s -> a, w s) }++instance Comonad w => ComonadContext s (ContextT s w) where+	getC = extract . snd . runContextT +	modifyC m (ContextT (f,c)) = f (fmap m c)++instance Functor (ContextT b f) where+        fmap f = ContextT . first (f .) . runContextT++instance Comonad w => Comonad (ContextT b w) where+        extract = uncurry id . runContextT+        duplicate (ContextT (f,ws)) = ContextT (ContextT . (,) f, ws)
+ src/Control/Comonad/Context/Class.hs view
@@ -0,0 +1,25 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Context.Class+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Comonad.Context.Class where++import Control.Comonad++class Comonad w => ComonadContext s w | w -> s where+	getC :: w a -> s+	modifyC :: (s -> s) -> w a -> a ++putC :: ComonadContext s w => s -> w a -> a+putC = modifyC . const ++experiment :: (ComonadContext s w, Functor f) => f (s -> s) -> w a -> f a+experiment ms a = fmap (flip modifyC a) ms
+ src/Control/Comonad/HigherOrder.hs view
@@ -0,0 +1,20 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.HigherOrder+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+-- extending Neil Ghani and Patrician Johann's HFunctor to higher order comonads+----------------------------------------------------------------------------+module Control.Comonad.HigherOrder where++import Control.Functor.Extras+import Control.Functor.HigherOrder++class HFunctor w => HComonad w where+	hextract :: Functor f => Natural (w f) f+	hextend  :: (Functor f, Functor g) => Natural (w f) g -> Natural (w f) (w g)
+ src/Control/Comonad/Identity.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Identity+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Comonad.Identity where++import Control.Monad.Identity+import Control.Comonad++instance Comonad Identity where+        extract = runIdentity+        extend f x = Identity (f x)+        duplicate = Identity
+ src/Control/Comonad/Indexed.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Indexed+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable +--+----------------------------------------------------------------------------+module Control.Comonad.Indexed where++import Control.Comonad+import Control.Arrow+import Control.Functor.Extras+import Control.Functor.HigherOrder+import Control.Functor.Indexed+import Control.Monad++class IxFunctor w => IxComonad w where+	iextract :: w i i a -> a+	iextend :: (w j k a -> b) -> w i k a -> w i j b++iduplicate :: IxComonad w => w i k a -> w i j (w j k a)+iduplicate = iextend id++instance Comonad w => IxComonad (LiftIx w) where+	iextract = extract . lowerIx +	iextend f = LiftIx . extend (f . LiftIx) . lowerIx
+ src/Control/Comonad/Parameterized.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Parameterized+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Comonad.Parameterized where++import Control.Bifunctor+import Control.Bifunctor.Fix+import Control.Comonad+import Control.Comonad.Parameterized.Class+import Control.Morphism.Ana++copaugment :: PComonad f => ((FixB f a -> f b (FixB f a)) -> FixB f b) -> (FixB f a -> b) -> FixB f b+copaugment g k = g (pextend (k . InB) . outB)++instance PComonad f => Comonad (FixB f) where+        extract = pextract . outB+        extend k w = copaugment (flip biana w) k
+ src/Control/Comonad/Parameterized/Class.hs view
@@ -0,0 +1,40 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Parameterized.Class+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Comonad.Parameterized.Class where++import Control.Arrow ((|||), (+++))+import Control.Monad+import Control.Bifunctor++class Bifunctor f => PComonad f where+	pextract :: f a c -> a+	pextend :: (f b c -> a) -> f b c -> f a c++{- Parameterized comonad laws:++> pextend pextract = id+> pextract . pextend g = g+> pextend (g . pextend j) = pextend g . pextend j+> pextract . second g = pextract +> second g . pextend (j . second g) = pextend j . second g ++-}++#ifndef __HADDOCK__+{-# RULES+"pextend pextract" 		pextend pextract = id+"pextract . pextend g" 		forall g. pextract . pextend g = g+"pextract . bimap id g" 	forall g. pextract . bimap id g = pextract+"bimap _ _ . pextract" 		forall j g. bimap id g . pextend (j . bimap id g) = pextend j . bimap id g+ #-}+#endif
+ src/Control/Comonad/Pointer.hs view
@@ -0,0 +1,37 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Pointer+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-- SIGFPE (Dan Piponi)'s Pointer Comonad+----------------------------------------------------------------------------+module Control.Comonad.Pointer where++import Control.Functor.Extras+import Control.Arrow ((&&&), first)+import Data.Array+import Data.Foldable+import Control.Monad+import Control.Comonad++data Pointer i a = Pointer { index :: i, array :: Array i a } deriving (Show,Read)++instance Ix i => Functor (Pointer i) where+	fmap f (Pointer i a) = Pointer i (fmap f a)++instance Ix i => Comonad (Pointer i) where+	extract (Pointer i a) = a ! i+	extend f (Pointer i a) = Pointer i . listArray bds $ fmap (f . flip Pointer a) (range bds) where+		bds = bounds a++distPointer :: (Monad m, Ix i) => Dist (Pointer i) m +distPointer (Pointer i ma) = do+	let bds = bounds ma+	a <- sequence (elems ma)+	return $ Pointer i (listArray bds a)
+ src/Control/Comonad/Reader.hs view
@@ -0,0 +1,67 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Reader+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Comonad.Reader where++import Control.Bifunctor+import Control.Bifunctor.Pair+import Control.Monad.Instances -- for Functor ((,)e)+import Control.Comonad.Reader.Class+import Control.Comonad+import Control.Arrow ((&&&))++data ReaderC r a = ReaderC r a +runReaderC (ReaderC r a) = (r,a)++instance ComonadReader r (ReaderC r) where+	askC (ReaderC r _) = r++instance Functor (ReaderC r) where+	fmap f = uncurry ReaderC . second f . runReaderC++instance Comonad (ReaderC r) where+	extract (ReaderC _ a) = a+	duplicate (ReaderC e a) = ReaderC e (ReaderC e a)++instance Bifunctor ReaderC where+	bimap f g = uncurry ReaderC . bimap f g . runReaderC+++newtype ReaderCT w r a = ReaderCT { runReaderCT :: w (r, a) }++instance Comonad w => ComonadReader r (ReaderCT w r) where+	askC = fst . extract . runReaderCT++instance Functor f => Functor (ReaderCT f b) where+        fmap f = ReaderCT . fmap (fmap f) . runReaderCT++instance Comonad w => Comonad (ReaderCT w b) where+        extract = snd . extract . runReaderCT+        duplicate = ReaderCT . liftW (fst . extract &&& ReaderCT) . duplicate . runReaderCT++instance Functor f => Bifunctor (ReaderCT f) where+	bimap f g = ReaderCT . fmap (bimap f g) . runReaderCT+++instance Comonad ((,)e) where+        extract = snd+        duplicate ~(e,a) = (e,(e,a))++instance ComonadReader e ((,)e) where+        askC = fst++-- instance Functor ((,)e) where+--        fmap f = second f ++-- instance Bifunctor (,) where+--        bimap f g = uncurry ReaderC . bimap f g . runReaderC+
+ src/Control/Comonad/Reader/Class.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Reader.Class+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Comonad.Reader.Class where++import Control.Comonad++class Comonad w => ComonadReader r w | w -> r where+	askC :: w a -> r
+ src/Control/Comonad/Supply.hs view
@@ -0,0 +1,147 @@+--------------------------------------------------------------------+-- |+-- Module    : Control.Comonad.Supply+-- Copyright : (c) Edward Kmett 2008+--             (c) Iavor S. Diatchki, 2007+-- License   : BSD3+--+-- Maintainer: Edward Kmett <ekmett@gmail.com>+-- Stability : provisional+-- Portability: portable+--+-- The technique for generating new values is based on the paper+-- ''On Generating Unique Names''+-- by Lennart Augustsson, Mikael Rittri, and Dan Synek.+-- +-- Integrated from value-supply-0.1+--+-- TODO: a SupplyT Comonad Transformer+--------------------------------------------------------------------++module Control.Comonad.Supply+  (++  -- * Creating supplies+  Supply+  , newSupply+  , newEnumSupply+  , newNumSupply++  -- * Obtaining values from supplies+  , supplyValue++  -- * Generating new supplies from old+  , supplyLeft+  , supplyRight+  , modifySupply+  , split+  , split2+  , split3+  , split4+  ) where++import Control.Comonad+-- Using 'MVar's might be a bit heavy but it ensures that+-- multiple threads that share a supply will get distinct names.+import Control.Concurrent.MVar+import Control.Functor.Extras+import System.IO.Unsafe(unsafePerformIO)++-- Basics ----------------------------------------------------------------------++-- | A type that can be used to generate values on demand.+-- A supply may be turned into two different supplies by using+-- the functions 'supplyLeft' and 'supplyRight'.+data Supply a = Node+  { -- | Get the value of a supply.  This function, together with+    -- 'modifySupply' forms a comonad on 'Supply'.+    supplyValue :: a++  -- | Generate a new supply.  This supply is different from the one+  -- generated with 'supplyRight'.+  , supplyLeft  :: Supply a++  -- | Generate a new supply. This supply is different from the one+  -- generated with 'supplyLeft'.+  , supplyRight :: Supply a+  }++instance Functor Supply where+  fmap f s = modifySupply s (f . supplyValue)++-- | Creates a new supply of values.+-- The arguments specify how to generate values:+-- the first argument is an initial value, the+-- second specifies how to generate a new value from an existing one.+newSupply    :: a -> (a -> a) -> IO (Supply a)+newSupply x f = fmap (gen True) (newMVar (iterate f x))++  -- The extra argument to ``gen'' is passed because without+  -- it Hugs spots that the recursive calls are the same but does+  -- not know that unsafePerformIO is unsafe.+  where gen _ r = Node { supplyValue  = unsafePerformIO (genSym r),+                         supplyLeft   = gen False r,+                         supplyRight  = gen True r }++        genSym       :: MVar [a] -> IO a+        genSym r      = do a : as <- takeMVar r+                           putMVar r as+                           return a++-- | Generate a new supply by systematically applying a function+-- to an existing supply.  This function, together with 'supplyValue'+-- form a comonad on 'Supply'.+modifySupply :: Supply a -> (Supply a -> b) -> Supply b+modifySupply = flip extend++-- (Supply, supplyValue, modifySupply) form a comonad:+{-+law1 s      = [ modifySupply s supplyValue, s ]+law2 s f    = [ supplyValue (modifySupply s f), f s ]+law3 s f g  = [ (s `modifySupply` f) `modifySupply` g+              ,  s `modifySupply` \s1 -> g (s1 `modifySupply` f)+              ]+-}+++-- Derived functions -----------------------------------------------------------++-- | A supply of values that are in the 'Enum' class.+-- The initial value is @toEnum 0@, new values are generates with 'succ'.+newEnumSupply  :: (Enum a) => IO (Supply a)+newEnumSupply   = newSupply (toEnum 0) succ++-- | A supply of values that are in the 'Num' class.+-- The initial value is 0, new values are generated by adding 1.+newNumSupply   :: (Num a) => IO (Supply a)+newNumSupply    = newSupply 0 (1+)++-- | Generate an infinite list of supplies by using 'supplyLeft' and+-- 'supplyRight' repeatedly.+split          :: Supply a -> [Supply a]+split s         = supplyLeft s : split (supplyRight s)++-- | Split a supply into two different supplies.+-- The resulting supplies are different from the input supply.+split2         :: Supply a -> (Supply a, Supply a)+split2 s        = (supplyLeft s, supplyRight s)++-- | Split a supply into three different supplies.+split3         :: Supply a -> (Supply a, Supply a, Supply a)+split3 s        = let s1 : s2 : s3 : _ = split s+                  in (s1,s2,s3)++-- | Split a supply into four different supplies.+split4         :: Supply a -> (Supply a, Supply a, Supply a, Supply a)+split4 s        = let s1 : s2 : s3 : s4 : _ = split s+                  in (s1,s2,s3,s4)++instance Comonad Supply where+    extract = supplyValue+    extend f s = Node { supplyValue = f s+                      , supplyLeft  = modifySupply (supplyLeft s) f+                      , supplyRight = modifySupply (supplyRight s) f+                      }++instance FunctorSplit Supply where+    fsplit = split2
+ src/Control/Functor/Adjunction.hs view
@@ -0,0 +1,61 @@+{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Adjunction+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-------------------------------------------------------------------------------------------++module Control.Functor.Adjunction where++import Control.Comonad+import Control.Functor.Composition+import Control.Functor.Composition.Class+import Control.Functor.Exponential+import Control.Functor.Full+import Control.Functor.Pointed+import Control.Monad++-- | An 'Adjunction' formed by the 'Functor' f and 'Functor' g. ++-- Minimal definition:++-- 1. @leftAdjunct@ and @rightAdjunct@ ++-- 2. @unit@ and @counit@++class (Functor f, Functor g) => Adjunction f g where+	unit   :: a -> g (f a)+	counit :: f (g a) -> a+	leftAdjunct  :: (f a -> b) -> a -> g b+	rightAdjunct :: (a -> g b) -> f a -> b++	unit = leftAdjunct id+	counit = rightAdjunct id+	leftAdjunct f = fmap f . unit+	rightAdjunct f = counit . fmap f+++++-- adjunction-oriented composition+newtype ACompF f g a = ACompF (CompF f g a) deriving (Functor, ExpFunctor, Full, Composition)++instance Adjunction f g => Pointed (ACompF g f) where+        point = compose . unit++instance Adjunction f g => Copointed (ACompF f g) where+        copoint = counit . decompose++instance Adjunction f g => Monad (ACompF g f) where+        return = point+        m >>= f = compose . fmap (rightAdjunct (decompose . f)) $ decompose m++instance Adjunction f g => Comonad (ACompF f g) where+        extract = copoint+        extend f = compose . fmap (leftAdjunct (f . compose)) . decompose
+ src/Control/Functor/Algebra.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Functor.Algebra+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Functor.Algebra where++import Control.Comonad++type Alg f a = f a -> a+type CoAlg f a = a -> f a+type AlgW f w a = f (w a) -> a+type CoAlgM f m a = a -> f (m a)++liftAlg :: (Functor f, Comonad w) => Alg f a -> AlgW f w a+liftAlg f = f . fmap extract++liftCoAlg :: (Functor f, Monad m) => CoAlg f a -> CoAlgM f m a+liftCoAlg f = fmap return . f+
+ src/Control/Functor/Bifunctor.hs view
@@ -0,0 +1,65 @@+{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Bifunctor+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-- transform a pair of functors with a bifunctor deriving a new functor.+-- this subsumes functor product and functor coproduct+-------------------------------------------------------------------------------------------++module Control.Functor.Bifunctor where++import Control.Bifunctor+import Control.Bifunctor.Pair+import Control.Bifunctor.Either+import Control.Functor.Contravariant+import Control.Functor.Exponential+import Control.Functor.Full+import Control.Functor.Pointed+import Control.Arrow ((***),(&&&),(|||),(+++))++-- * Bifunctor functor transformer++newtype BifunctorF p f g a = BifunctorF { runBifunctorF :: p (f a) (g a) }++instance (Bifunctor p, Functor f ,Functor g) => Functor (BifunctorF p f g) where+        fmap f = BifunctorF . bimap (fmap f) (fmap f) . runBifunctorF++instance (Bifunctor p, ContravariantFunctor f ,ContravariantFunctor g) => ContravariantFunctor (BifunctorF p f g) where+        contramap f = BifunctorF . bimap (contramap f) (contramap f) . runBifunctorF++instance (Bifunctor p, ExpFunctor f ,ExpFunctor g) => ExpFunctor (BifunctorF p f g) where+        xmap f g = BifunctorF . bimap (xmap f g) (xmap f g) . runBifunctorF++++#ifndef __HADDOCK__+type (f :*: g) a = BifunctorF (,) f g a+#endif+++runProductF :: BifunctorF (,) f g a -> (f a, g a)+runProductF = runBifunctorF++instance (Pointed f, Pointed g) => Pointed (BifunctorF (,) f g) where+        point = BifunctorF . (point &&& point)++instance (Faithful f, Faithful g) => Faithful (BifunctorF (,) f g)++#ifndef __HADDOCK__+type (f :+: g) a = BifunctorF Either f g a+#endif+++runCoproductF :: BifunctorF Either f g a -> Either (f a) (g a)+runCoproductF = runBifunctorF++instance (Copointed f, Copointed g) => Copointed (BifunctorF Either f g) where+        copoint = (copoint ||| copoint) . runBifunctorF+
+ src/Control/Functor/Composition.hs view
@@ -0,0 +1,45 @@+{-# OPTIONS -fglasgow-exts #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Composition+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (class-associated types)+--+-- Generalized functor composeosition.+-------------------------------------------------------------------------------------------++module Control.Functor.Composition where++import Control.Functor.Composition.Class+import Control.Functor.Exponential+import Control.Functor.Full++newtype CompF f g a = CompF { runCompF :: f (g a) }++instance Composition CompF where+	compose = CompF+	decompose = runCompF++#ifndef __HADDOCK__+type (f :.: g) a = CompF f g a+#endif++-- common functor composition traits+instance (Functor f, Functor g) => Functor (CompF f g) where+	fmap f = compose . fmap (fmap f) . decompose++instance (ExpFunctor f, ExpFunctor g) => ExpFunctor (CompF f g) where+        xmap f g = compose . xmap (xmap f g) (xmap g f) . decompose++instance (Full f, Full g) => Full (CompF f g) where+        premap f = premap . premap $ decompose . f . compose++associateComp :: (Functor f, Composition c) => (c (c f g) h) a -> (c f (c g h)) a+associateComp = compose . fmap compose . decompose . decompose++coassociateComp :: (Functor f, Composition c) => (c f (c g h)) a -> (c (c f g) h) a+coassociateComp = compose . compose . fmap decompose . decompose
+ src/Control/Functor/Composition/Class.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS -fglasgow-exts #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Composition.Class+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (class-associated types)+--+-------------------------------------------------------------------------------------------++module Control.Functor.Composition.Class where++class Composition c where+    decompose  :: c f g x -> f (g x)+    compose    :: f (g x) -> c f g x++
+ src/Control/Functor/Constant.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Constant+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-------------------------------------------------------------------------------------------++module Control.Functor.Constant where++import Control.Functor.Exponential+import Control.Functor.Contravariant+import Data.Void++-- this is also the 'Fst' bifunctor++newtype ConstantF a b = ConstantF a++instance Functor (ConstantF a) where+	fmap f (ConstantF a) = ConstantF a++instance ContravariantFunctor (ConstantF a) where+	contramap f (ConstantF a) = ConstantF a++instance ExpFunctor (ConstantF a) where+	xmap f g (ConstantF a) = ConstantF a++type VoidF a = ConstantF Void a
+ src/Control/Functor/Contravariant.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS -fglasgow-exts #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Contravariant+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (class-associated types)+--+-------------------------------------------------------------------------------------------++module Control.Functor.Contravariant where++class ContravariantFunctor f where+	contramap :: (a -> b)  -> f b -> f a++newtype ContraF a b = ContraF { runContraF :: b -> a }++instance ContravariantFunctor (ContraF a) where+        contramap g (ContraF f) = ContraF (f . g)
+ src/Control/Functor/Derivative.hs view
@@ -0,0 +1,13 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Functor.Derivative+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Functor.Derivative where+
+ src/Control/Functor/Exponential.hs view
@@ -0,0 +1,19 @@+{-# OPTIONS -fglasgow-exts #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Exponential+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (class-associated types)+--+-- Exponential functors, see <http://comonad.com/reader/2008/rotten-bananas/>+-------------------------------------------------------------------------------------------++module Control.Functor.Exponential where++class ExpFunctor f where+	xmap :: (a -> b) -> (b -> a) -> f a -> f b+
+ src/Control/Functor/Extras.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Functor.Extras+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Functor.Extras where++type Dist f g = forall a. f (g a) -> g (f a)+type Natural f g = forall a. f a -> g a++class PostFold m f where+        postFold :: f (m (f a)) -> m (f a)++class PostUnfold w f where+        postUnfold :: w (f a) -> f (w (f a))++class PreFold f m where+        preFold :: f (m (f a)) -> f (m a)++class PreUnfold f w where+        preUnfold :: f (w a) -> f (w (f a))++class Distributes f g where+        dist :: f (g a) -> g (f a)++++class Functor f => FunctorZero f where+	fzero :: f a++-- monoid+class FunctorZero f => FunctorPlus f where+	fplus :: f a -> f a -> f a++class Functor f => FunctorSplit f where+	fsplit :: f a -> (f a, f a)
+ src/Control/Functor/Fix.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Functor.Fix+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Functor.Fix where++import Control.Monad+import Control.Comonad+import Control.Functor.Algebra++newtype Fix f = InF { outF :: f (Fix f) }++outM :: (Functor f, Monad m) => CoAlgM f m (Fix f)+outM = liftCoAlg outF++inW :: (Functor f, Comonad w) => AlgW f w (Fix f)+inW = liftAlg InF+
+ src/Control/Functor/Full.hs view
@@ -0,0 +1,51 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Full+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (class-associated types)+--+-------------------------------------------------------------------------------------------++module Control.Functor.Full where+++{- |+	A 'Full' 'Functor' @F : C -> D@ provides for every pair of objects @c@, @c'@ in @C@+	and every morphism @g : F c -> F c'l@ in @D@, a morphism @g' : c -> c'@ in @C@. In short+	map has a right-inverse under composition.++> fmap . premap = id+-}++class Functor f => Full f where+	premap :: (f a -> f b) -> a -> b+	+{-# RULES+	"fmap/premap" 	map . premap = id+ #-}++class Functor f => Faithful f++{- | ++For every pair of objects @a@ and @b@ in @C@ a 'Full' 'Faithful' 'Functor' @F : C -> D@ maps every morphism +@f : a -> b@ onto a distinct morphism @f : T a -> T b@ (since it is faithful) and every morphism from +@g : T a -> T b@ can be obtained from some @f@. (It maps Hom-sets bijectively, or in short @fmap@ has both+a left and right inverse under composition.++> unmap . fmap = id+-}++unmap :: (Full f, Faithful f) => (f a -> f b) -> a -> b+unmap = premap++{-# RULES+	"unmap/fmap"	unmap . fmap = id+ #-}+++
+ src/Control/Functor/HigherOrder.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Functor.HigherOrder+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+-- Neil Ghani and Particia Johann''s higher order functors from+-- <http://crab.rutgers.edu/~pjohann/tlca07-rev.pdf>+----------------------------------------------------------------------------+module Control.Functor.HigherOrder where++import Control.Functor.Extras++type AlgH f g = Natural (f g) g+type CoAlgH f g = Natural g (f g)++class HFunctor f where+	ffmap :: Functor g => (a -> b) -> f g a -> f g b+	hfmap :: Natural g h -> Natural (f g) (f h)++newtype FixH f a = InH { outH :: f (FixH f) a }
+ src/Control/Functor/Indexed.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Functor.Indexed+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Functor.Indexed where++import Control.Comonad+import Control.Arrow+import Control.Functor.Extras+import Control.Functor.HigherOrder+import Control.Monad++class IxFunctor f where+	imap :: (a -> b) -> f j k a -> f j k b++newtype LiftIx m i j a = LiftIx { lowerIx :: m a }++instance Functor f => IxFunctor (LiftIx f) where+        imap f = LiftIx . fmap f . lowerIx++newtype LowerIx m i a = LowerIx { liftIx :: m i i a } ++instance IxFunctor f => Functor (LowerIx f i) where+	fmap f = LowerIx . imap f . liftIx
+ src/Control/Functor/KanExtension.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Functor.KanExtension+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Functor.KanExtension where++import Control.Functor.Composition.Class+import Control.Functor.Extras++-- Right Kan Extension+newtype Ran g h a = Ran { runRan :: forall b. (a -> g b) -> h b }++toRan :: (Composition c, Functor k) => Natural (c k g) h -> Natural k (Ran g h)+toRan s t = Ran (s . compose . flip fmap t)++fromRan :: Composition c => Natural k (Ran g h) -> Natural (c k g) h+fromRan s = flip runRan id . s . decompose++-- Left Kan Extension+data Lan g h a = forall b. Lan (g b -> a) (h b)++toLan :: (Composition c, Functor f) => Natural h (c f g) -> Natural (Lan g h) f+toLan s (Lan f v) = fmap f . decompose $ s v++fromLan :: Composition c => Natural (Lan g h) f -> Natural h (c f g)+fromLan s t = compose . s $ Lan id t
+ src/Control/Functor/Pointed.hs view
@@ -0,0 +1,27 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Pointed+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-------------------------------------------------------------------------------------------++module Control.Functor.Pointed where++-- return+class Functor f => Pointed f where+        point :: a -> f a++-- extract+class Functor f => Copointed f where+        copoint :: f a -> a++{-# RULES+"copoint/point" copoint . point = id+"point/copoint" point . copoint = id+ #-}+
+ src/Control/Functor/Pointed/Composition.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS -fglasgow-exts #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Pointed.Composition+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-------------------------------------------------------------------------------------------++module Control.Functor.Pointed.Composition where++import Control.Functor.Pointed+import Control.Functor.Composition.Class+import Control.Functor.Composition+import Control.Functor.Exponential+import Control.Functor.Full++newtype PointedCompF f g a = PointedCompF (CompF f g a) deriving (Functor, ExpFunctor, Full, Composition)++instance (Pointed f, Pointed g) => Pointed (PointedCompF f g) where+        point = compose . point . point++instance (Copointed f, Copointed g) => Copointed (PointedCompF f g) where+        copoint = copoint . copoint . decompose++newtype PostCompF mw f a = PostCompF (PointedCompF mw f a) deriving (Functor, ExpFunctor, Full, Composition, Pointed, Copointed)+newtype PreCompF f mw a  = PreCompF (PointedCompF f mw a) deriving (Functor, ExpFunctor, Full, Composition, Pointed, Copointed)+newtype DistCompF f g a  = DistCompF (PointedCompF f g a) deriving (Functor, ExpFunctor, Full, Composition, Pointed, Copointed)+
+ src/Control/Functor/Representable.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS -fglasgow-exts #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Representable+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (class-associated types)+--+-------------------------------------------------------------------------------------------++module Control.Functor.Representable where++class Functor f => Representable f x where+	rep :: (x -> a) -> f a+	unrep :: f a -> (x -> a)++{-# RULES+"rep/unrep" rep . unrep = id+"unrep/rep" unrep . rep = id+ #-}++data EitherF a b c = EitherF (a -> c) (b -> c)++instance Functor (EitherF a b) where+        fmap f (EitherF l r) = EitherF (f . l) (f . r)++instance Representable (EitherF a b) (Either a b) where+        rep f = EitherF (f . Left) (f . Right)+        unrep (EitherF l r) = either l r+
+ src/Control/Functor/Strong.hs view
@@ -0,0 +1,24 @@+{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Strong+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-------------------------------------------------------------------------------------------++module Control.Functor.Strong where++import Prelude hiding (sequence)+import Data.Traversable+import Control.Monad.Either++strength :: Functor f => f a -> b -> f (a,b)+strength fa b = fmap (\a -> (a,b)) fa++costrength :: Traversable f => f (Either a b) -> Either a (f b)+costrength = sequence
+ src/Control/Functor/Zap.hs view
@@ -0,0 +1,64 @@+{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Zap+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-- Dual Functors+-------------------------------------------------------------------------------------------++module Control.Functor.Zap where++import Control.Bifunctor+import Control.Bifunctor.Composition+import Control.Comonad.Cofree+import Control.Monad.Either+import Control.Monad.Free+import Control.Monad.Identity+import Data.Traversable++{- | Minimum definition: zapWith -}++class Zap f g | f -> g, g -> f where+	zapWith :: (a -> b -> c) -> f a -> g b -> c+	zap :: f (a -> b) -> g a -> b+	zap = zapWith id++(>$<) :: Zap f g => f (a -> b) -> g a -> b+(>$<) = zap++instance Zap Identity Identity where+	zapWith f (Identity a) (Identity b) = f a b++{- | Minimum definition: bizapWith -}++class BiZap p q | p -> q, q -> p where+	bizapWith :: (a -> c -> e) -> (b -> d -> e) -> p a b -> q c d -> e++	bizap :: p (a -> c) (b -> c) -> q a b -> c+	bizap = bizapWith id id++(>>$<<) :: BiZap p q => p (a -> c) (b -> c) -> q a b -> c+(>>$<<) = bizap++instance BiZap (,) Either where+	bizapWith l _ (f,_) (Left a) = l f a+	bizapWith _ r (_,g) (Right b) = r g b ++instance BiZap Either (,) where+	bizapWith l _ (Left f) (a,_) = l f a+	bizapWith _ r (Right g) (_,b) = r g b++-- instance (Functor f, Functor g, Zap f g) => BiZap (CofreeB f) (FreeB g) where+--	bizapWith l r (CofreeB fs) (FreeB as) = bizapWith l (zapWith r) fs as++-- instance (Functor f, Functor g, Zap f g) => BiZap (FreeB f) (CofreeB g) where+--	bizapWith l r (FreeB fs) (CofreeB as) = bizapWith l (zapWith r) fs as++instance (BiZap p q, Zap f g, Zap i j) => BiZap (BiffB p f i) (BiffB q g j) where+	bizapWith l r fs as = bizapWith (zapWith l) (zapWith r) (runBiffB fs) (runBiffB as)
+ src/Control/Functor/Zip.hs view
@@ -0,0 +1,99 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Functor.Zip+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: portable+--+-------------------------------------------------------------------------------------------++module Control.Functor.Zip where++import Control.Arrow ((&&&))+import Control.Bifunctor+import Control.Bifunctor.Composition+import Control.Bifunctor.Pair -- Bifunctor (,)+import Control.Bifunctor.Fix+import Control.Comonad.Cofree+import Control.Monad.Free+import Control.Monad.Identity+import Data.Monoid++unfzip :: Functor f => f (a, b) -> (f a, f b)+unfzip = fmap fst &&& fmap snd++unbizip :: Bifunctor p => p (a, c) (b, d) -> (p a b, p c d)+unbizip = bimap fst fst &&& bimap snd snd++{- | Minimum definition:++1. fzipWith++2. fzip++-}++class Functor f => Zip f where+	fzip :: f a -> f b -> f (a, b)+	fzip = fzipWith (,)+	fzipWith :: (a -> b -> c) -> f a -> f b -> f c+	fzipWith f as bs = fmap (uncurry f) (fzip as bs)++{- | Minimum definition: ++1. bizipWith++2. bizip++-}++class Bifunctor p => Bizip p where+	bizip :: p a c -> p b d -> p (a,b) (c,d)+	bizip = bizipWith (,) (,)+	bizipWith :: (a -> b -> e) -> (c -> d -> f) -> p a c -> p b d -> p e f +	bizipWith f g as bs = bimap (uncurry f) (uncurry g) (bizip as bs)++instance Zip Identity where+	fzipWith f (Identity a) (Identity b) = Identity (f a b)++instance Zip [] where+	fzip = zip+	fzipWith = zipWith++instance Zip Maybe where+	fzipWith f (Just a) (Just b) = Just (f a b)+	fzipWith f _ _ = Nothing++instance Monoid a => Zip ((,)a) where+	fzipWith f (a, c) (b, d) = (mappend a b, f c d)++instance Bizip (,) where +	bizipWith f g (a,b) (c,d) = (f a c, g b d)++-- comes for free with BiffB+-- instance Zip f => Bizip (CofreeB f) where+--	bizipWith f g (CofreeB as) (CofreeB bs) = CofreeB $ bizipWith f (fzipWith g) as bs++instance (Bizip p, Zip f, Zip g) => Bizip (BiffB p f g) where+	bizipWith f g as bs = BiffB $ bizipWith (fzipWith f) (fzipWith g) (runBiffB as) (runBiffB bs)++instance (Zip f, Bizip p) => Bizip (FunctorB f p) where+	bizipWith f g as bs = FunctorB $ fzipWith (bizipWith f g) (runFunctorB as) (runFunctorB bs)++instance Bizip p => Zip (FixB p) where+	fzipWith f as bs = InB $ bizipWith f (fzipWith f) (outB as) (outB bs)++instance Monoid a => Zip (Either a) where+	fzipWith f (Left a) (Left b) = Left (mappend a b)+	fzipWith f (Right a) (Left b) = Left b+	fzipWith f (Left a) (Right b) = Left a+	fzipWith f (Right a) (Right b) = Right (f a b)+++{- -- fails because Either cannot be made an instance of Bizip!+instance Zip f => Bizip (FreeB f) where+	bizipWith f g (FreeB as) (FreeB bs) = FreeB $ bizipWith f (fzipWith g) as bs+-}
+ src/Control/Monad/Composition.hs view
@@ -0,0 +1,42 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Monad.Composition+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-------------------------------------------------------------------------------------------++module Control.Monad.Composition where++import Control.Monad+-- import Control.Functor.Composition+import Control.Functor.Composition.Class+import Control.Functor.Extras+import Control.Functor.Pointed+import Control.Functor.Pointed.Composition++postJoin :: (Monad m, PostFold m f) => m (f (m (f a))) -> m (f a)+postJoin = join . liftM postFold++instance (Monad m, Pointed f, PostFold m f) => Monad (PostCompF m f) where+        return = compose . return . point+	m >>= k = undefined -- TODO: dualize the comonad version++preJoin :: (Monad m, Functor f, PreFold f m) => f (m (f (m a))) -> f (m a)+preJoin = fmap join . preFold++instance (Pointed f, Monad m, PreFold f m) => Monad (PreCompF f m) where+	return = compose . point . return+	m >>= k = undefined+++instance (Monad m, Monad n, Distributes m n) => Monad (DistCompF m n) where+	return = compose . return . return+	m >>= k = undefined+++
+ src/Control/Monad/Either.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Either+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Incompatible with Control.Monad.Error, but removes the Error restriction+-- that prevents a natural encoding of Apomorphisms. This module is +-- therefore incompatible with Control.Monad.Error+----------------------------------------------------------------------------+module Control.Monad.Either where++import Data.Either+import Control.Monad++newtype EitherT a m b = EitherT { runEitherT :: m (Either a b) }++instance Functor (Either e) where+	fmap _ (Left a) = Left a+	fmap f (Right a) = Right (f a)++instance Monad (Either e) where+        return = Right+        Right m >>= k = k m+        Left e  >>= _ = Left e++instance Functor f => Functor (EitherT b f) where+        fmap f = EitherT . fmap (fmap f) . runEitherT++instance Monad m => Monad (EitherT b m) where+        return = EitherT . return . return+        m >>= k  = EitherT $ do+                a <- runEitherT m+                case a of+                    Left  l -> return (Left l)+                    Right r -> runEitherT (k r)
+ src/Control/Monad/Free.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Free+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Monad.Free where++import Control.Arrow ((|||), (+++))+import Control.Bifunctor+import Control.Bifunctor.Either+import Control.Bifunctor.Fix+import Control.Bifunctor.Composition+import Control.Functor.Extras+import Control.Functor.Exponential+import Control.Functor.Contravariant+import Control.Monad+import Control.Monad.Identity+import Control.Monad.Parameterized+import Control.Monad.Parameterized.Class+import Control.Comonad.Parameterized+import Control.Comonad.Parameterized.Class++instance Functor f => PMonad (BiffB Either Identity f) where+        preturn = BiffB . Left . Identity+        pbind k = (k . runIdentity ||| BiffB . Right) . runBiffB++type FreeB f a b = BiffB Either Identity f a b+type Free f a = FixB (BiffB Either Identity f) a++inFree :: f (Free f a) -> Free f a+inFree = InB . BiffB . Right++runFree :: Free f a -> Either a (f (Free f a))+runFree = first runIdentity . runBiffB . outB++cataFree :: Functor f => (c -> a) -> (f a -> a) -> Free f c -> a+cataFree l r = (l . runIdentity ||| r . fmap (cataFree l r)) . runBiffB . outB++free :: Either a (f (Free f a)) -> Free f a+free = InB . BiffB . first Identity
+ src/Control/Monad/HigherOrder.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.HigherOrder+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Monad.HigherOrder where++import Control.Functor.Extras+import Control.Functor.HigherOrder++class HFunctor m => HMonad m where+	hreturn :: Functor f => Natural f (m f)+	hbind   :: (Functor f, Functor g) => Natural f (m g) -> Natural (m f) (m g)+	--hbind k = hjoin . hfmap k++hjoin :: (HMonad m, Functor (m g), Functor g) => Natural (m (m g)) (m g)+hjoin = hbind id++(>>**=) :: (HMonad m, Functor f, Functor g) => m f a -> Natural f (m g) -> m g a+m >>**= k = hbind k m
+ src/Control/Monad/Hyper.hs view
@@ -0,0 +1,37 @@+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Monad.Hyper+-- Copyright 	: 2008 Edward Kmett+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: non-portable (functional-dependencies)+--+-- Based on the construction of hyperfunctions as parameterized monads in +-- <http://crab.rutgers.edu/~pjohann/f14-ghani.pdf>+-------------------------------------------------------------------------------------------++module Control.Monad.Hyper where++import Control.Bifunctor+import Control.Bifunctor.Fix+import Control.Monad.Parameterized.Class+import Control.Functor.Contravariant+import Control.Monad.Instances++newtype HyperB h a b = HyperB { runHyperB :: h b -> a } ++instance ContravariantFunctor h => Bifunctor (HyperB h) where+	bimap f g h = HyperB (f . runHyperB h . contramap g)++instance ContravariantFunctor h => PMonad (HyperB h) where+	preturn = HyperB . const+	pbind k (HyperB h) = HyperB (k . h >>= runHyperB) -- the bind is in the (->)e monad++-- | A generic recursive hyperfunction-like combinator+type Hyper h a = FixB (HyperB h)++-- | Traditional Hyper functions+type Hyp e a = Hyper (ContraF e) a+
+ src/Control/Monad/Indexed.hs view
@@ -0,0 +1,39 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Indexed+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Monad.Indexed where++import Control.Comonad+import Control.Arrow+import Control.Functor.Extras+import Control.Functor.HigherOrder+import Control.Functor.Indexed+import Control.Monad++class IxFunctor m => IxMonad m where+	ireturn :: a -> m i i a+	ibind :: (a -> m j k b) -> m i j a -> m i k b++ijoin :: IxMonad m => m i j (m j k a) -> m i k a +ijoin = ibind id++infixl 1 >>>=++(>>>=) :: IxMonad m => m i j a -> (a -> m j k b) -> m i k b+m >>>= k = ibind k m ++instance (Functor m, Monad m) => IxMonad (LiftIx m) where+	ireturn = LiftIx . return+	ibind f m = LiftIx (lowerIx m >>= lowerIx . f)++instance (IxMonad m) => Monad (LowerIx m i) where+	return = LowerIx . ireturn+	m >>= f = LowerIx (liftIx m >>>= liftIx . f)
+ src/Control/Monad/Indexed/Cont.hs view
@@ -0,0 +1,53 @@+{-# OPTIONS -fglasgow-exts #-}+-------------------------------------------------------------------------------------------+-- |+-- Module	: Control.Monad.Indexed.Cont+-- Copyright 	: 2008 Edward Kmett+--		  2008 Dan Doel+-- License	: BSD+--+-- Maintainer	: Edward Kmett <ekmett@gmail.com>+-- Stability	: experimental+-- Portability	: portable+--+-------------------------------------------------------------------------------------------++module Control.Monad.Indexed.Cont where++import Control.Monad.Identity+import Control.Functor.Indexed+import Control.Monad.Indexed+++newtype IxContT m r o a = IxContT { runIxContT :: (a -> m o) -> m r }++runIxContT_ :: Monad m => IxContT m r a a -> m r +runIxContT_ m = runIxContT m return++-- runIxContT :: Monad m => IxContT m r a a -> m r+-- runIxContT m = unIxContT m return++instance IxFunctor (IxContT m) where+	imap f m = IxContT $ \c -> runIxContT m (c . f)+++instance Monad m => IxMonad (IxContT m) where+	ireturn a = IxContT ($a)+	ibind f c = IxContT $ \k -> runIxContT c $ \a -> runIxContT (f a) k++class IxMonad m => IxContMonad m where+	reset :: m a o o -> m r r a+	shift :: ((a -> m i i o) -> m r j j) -> m r o a+++instance Monad m => IxContMonad (IxContT m) where+	reset e = IxContT $ \k -> runIxContT e return >>= k+	shift e = IxContT $ \k -> e (\a -> IxContT (\k' -> k a >>= k')) `runIxContT` return++newtype IxCont r o a = IxCont (IxContT Identity r o a) deriving (IxFunctor, IxMonad, IxContMonad)++runIxCont :: IxCont r o a -> (a -> o) -> r +runIxCont (IxCont k) f = runIdentity $ runIxContT k (return . f)++runIxCont_ :: IxCont r a a -> r+runIxCont_ m = runIxCont m id
+ src/Control/Monad/Indexed/State.hs view
@@ -0,0 +1,29 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Indexed.State+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Monad.Indexed.State where++import Control.Comonad+import Control.Arrow+import Control.Functor.Extras+import Control.Functor.HigherOrder+import Control.Functor.Indexed+import Control.Monad+import Control.Monad.Indexed++newtype IxState i j a = IxState { runIxState :: i -> (a, j) }++instance IxFunctor IxState where+	imap f (IxState m) = IxState (first f . m)++instance IxMonad IxState where+	ireturn = IxState . (,)+	ibind f (IxState m) = IxState $ \s1 -> let (a,s2) = m s1 in runIxState (f a) s2
+ src/Control/Monad/Parameterized.hs view
@@ -0,0 +1,28 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Paramterized+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Monad.Parameterized where++import Control.Arrow ((|||), (+++))+import Control.Monad+import Control.Bifunctor+import Control.Bifunctor.Fix+import Control.Monad.Parameterized.Class+import Control.Morphism.Cata++paugment :: PMonad f => (forall c. (f a c -> c) -> c) -> (a -> FixB f b) -> FixB f b+paugment g k = g (InB . pbind (outB . k))++instance PMonad f => Monad (FixB f) where+	return = InB . preturn+	m >>= k = paugment (flip bicata m) k+
+ src/Control/Monad/Parameterized/Class.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Paramterized.Class+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- The notation >>*= was selected to indicate the kind of the parameter+-- in this case a simple type as opposed to >>*->*= for higher order monads.+----------------------------------------------------------------------------+module Control.Monad.Parameterized.Class where++import Control.Arrow ((|||), (+++))+-- import Control.Functor.Exponential+-- import Control.Functor.Contravariant+import Control.Monad+import Control.Bifunctor+import Control.Bifunctor.Fix++{- | Minimum definition:++1. preturn & pbind+2. preturn & pjoin++-}+	+class Bifunctor f => PMonad f where+	preturn :: a -> f a c+	pbind :: (a -> f b c) -> f a c -> f b c+	pbind f = pjoin . bimap f id+	pjoin :: f (f a b) b -> f a b+	pjoin = pbind id++(>>*=) :: PMonad f => f a c -> (a -> f b c) -> f b c+(>>*=) = flip pbind++(=*<<) :: PMonad f => (a -> f b c) -> f a c -> f b c+(=*<<) = pbind++-- (>>*) :: PMonad f => f a c -> f b c -> f b c +m >>* n = m >>*= const n++-- bimapPMonad :: (PMonad f, Functor (f a)) => (a -> c) -> (b -> d) -> f a b -> f c d +-- bimapPMonad f g xs = second g xs >>*= preturn . f++{- Parameterized monad laws (from <http://crab.rutgers.edu/~pjohann/f14-ghani.pdf>)+> pbind preturn = id+> pbind g . preturn = g+> pbind (pbind g . j) = pbind g . pbind j+> pmap g . preturn = preturn+> pbind (pmap g . j) . pmap g = pmap g . pbind j +-}+
+ src/Control/Morphism/Ana.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Ana+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+-- +----------------------------------------------------------------------------+module Control.Morphism.Ana where++import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Functor.HigherOrder+import Control.Bifunctor+import Control.Bifunctor.Fix+import Control.Comonad ()+import Control.Monad.Identity+import Control.Comonad.Identity ()++-- | Anamorphisms are a generalized form of 'unfoldr'+ana :: Functor f => CoAlg f a -> a -> Fix f+ana g = InF . fmap (ana g) . g+-- ana g = g_ana distAna (liftCoAlg g)++-- | Generalized anamorphisms allow you to work with a monad given a distributive law+g_ana :: (Functor f, Monad m) => Dist m f -> CoAlgM f m a -> a -> Fix f+-- g_ana k g = g_hylo distCata k inW id g+g_ana k g = a . return where a = InF . fmap (a . join) . k . liftM g++-- | The distributive law for the identity monad+distAna :: Functor f => Dist Identity f+distAna = fmap Identity . runIdentity++biana :: Bifunctor f => CoAlg (f b) a -> a -> FixB f b+biana g = InB . bimap id (biana g) . g++g_biana :: (Bifunctor f, Monad m) => Dist m (f b) -> CoAlgM (f b) m a -> a -> FixB f b+g_biana k g = a . return where a = InB . bimap id (a . join) . k . liftM g++-- | A higher-order anamorphism for constructing higher order functors.+hana :: HFunctor f => CoAlgH f a -> Natural a (FixH f)+hana g = InH . hfmap (hana g) . g
+ src/Control/Morphism/Apo.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Apo+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+-- +-- Traditional operators, shown here to show how to roll your own+----------------------------------------------------------------------------+module Control.Morphism.Apo where+++import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Monad+import Control.Monad.Either+import Control.Morphism.Ana+import Control.Arrow ((|||))++-- * Unfold Sugar++apo :: Functor f => CoAlgM f (Apo f) a -> a -> Fix f+apo = g_apo outF++g_apo :: Functor f => CoAlg f b -> CoAlgM f (GApo b) a -> a -> Fix f+g_apo g = g_ana (distGApo g)++type Apo f a 		= Either (Fix f) a+type ApoT f m a 	= EitherT (Fix f) m a++type GApo b a 		= Either b a+type GApoT b m a 	= EitherT b m a ++-- * Distributive Law Combinators++distGApo :: Functor f => CoAlg f b -> Dist (Either b) f+distGApo f = fmap Left . f  ||| fmap Right++distGApoT :: (Functor f, Monad m) => CoAlgM f m b -> Dist m f -> Dist (EitherT b m) f+distGApoT g k = fmap (EitherT . join) . k  . liftM (fmap (liftM Left) . g ||| fmap (return . Right)) . runEitherT++distApoT :: (Functor f, Monad m) => Dist m f -> Dist (ApoT f m) f+distApoT = distGApoT (liftCoAlg outF)+
+ src/Control/Morphism/Cata.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Cata+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+-- +----------------------------------------------------------------------------+module Control.Morphism.Cata where++import Control.Bifunctor+import Control.Bifunctor.Fix+import Control.Comonad+import Control.Comonad.Identity+import Control.Functor.Algebra +import Control.Functor.HigherOrder+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Monad.Identity++cata :: Functor f => Alg f a -> Fix f -> a+-- cata f = g_cata distCata (liftAlg f)+cata f = f . fmap (cata f) . outF++g_cata :: (Functor f, Comonad w) => Dist f w -> AlgW f w a -> Fix f -> a+-- g_cata k f = g_hylo k distAna f id outM+g_cata k g = extract . c where c = liftW g . k . fmap (duplicate . c) . outF++distCata :: Functor f => Dist f Identity+distCata = Identity . fmap runIdentity++bicata :: Bifunctor f => Alg (f b) a -> FixB f b -> a+bicata f = f . bimap id (bicata f) . outB++g_bicata :: (Bifunctor f, Comonad w) => Dist (f b) w -> AlgW (f b) w a -> FixB f b -> a+g_bicata k g = extract . c where c = liftW g . k . bimap id (duplicate . c) . outB++hcata :: HFunctor f => AlgH f a -> Natural (FixH f) a+hcata f = f . hfmap (hcata f) . outH
+ src/Control/Morphism/Chrono.hs view
@@ -0,0 +1,30 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Chrono+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+-- +-- Chronomorphisms from <http://comonad.com/reader/2008/time-for-chronomorphisms/>+----------------------------------------------------------------------------+module Control.Morphism.Chrono where++import Control.Comonad.Cofree+import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Monad.Free+import Control.Morphism.Hylo+import Control.Morphism.Futu+import Control.Morphism.Histo++chrono :: (Functor f, Functor g) => AlgW g (Cofree g) b -> Natural f g -> CoAlgM f (Free f) a -> a -> b+chrono = g_hylo (distHisto id) (distFutu id)++g_chrono :: (Functor f, Functor g, Functor h, Functor j) => +	    Dist g h -> Dist j f -> AlgW g (Cofree h) b -> Natural f g -> CoAlgM f (Free j) a -> a -> b+g_chrono h f = g_hylo (distHisto h) (distFutu f)
+ src/Control/Morphism/Dyna.hs view
@@ -0,0 +1,25 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Dyna+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+-- +----------------------------------------------------------------------------+module Control.Morphism.Dyna where++import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Comonad+import Control.Comonad.Cofree+import Control.Morphism.Hylo+import Control.Morphism.Histo+import Control.Morphism.Ana++dyna :: (Functor f, Functor g) => AlgW g (Cofree g) b -> Natural f g -> CoAlg f a -> a -> b+dyna f e g = g_hylo (distHisto id) distAna f e (liftCoAlg g)
+ src/Control/Morphism/Futu.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Futu+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+-- +-- Traditional operators, shown here to show how to roll your own+----------------------------------------------------------------------------+module Control.Morphism.Futu where++import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Comonad ()+import Control.Monad.Free+import Control.Morphism.Ana++futu :: Functor f => CoAlgM f (Free f) a -> a -> Fix f+futu = g_ana (distFutu id)++g_futu :: (Functor f, Functor h) => Dist h f -> CoAlgM f (Free h) a -> a -> Fix f+g_futu k = g_ana (distFutu k)++distFutu :: (Functor f, Functor h) => Dist h f -> Dist (Free h) f+distFutu k = cataFree (fmap return) (fmap inFree . k)+
+ src/Control/Morphism/Histo.hs view
@@ -0,0 +1,30 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Histo +-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+-- +-- Traditional operators, shown here to show how to roll your own+----------------------------------------------------------------------------+module Control.Morphism.Histo where++import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Comonad+import Control.Comonad.Cofree+import Control.Morphism.Cata++histo :: Functor f => AlgW f (Cofree f) a -> Fix f -> a+histo = g_cata (distHisto id)++g_histo :: (Functor f, Functor h) => Dist f h -> AlgW f (Cofree h) a -> Fix f -> a+g_histo k = g_cata (distHisto k)++distHisto :: (Functor f, Functor h) => Dist f h -> Dist f (Cofree h)+distHisto k = anaCofree (fmap extract) (k . fmap outCofree)
+ src/Control/Morphism/Hylo.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Hylo+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+-- Generalized hylomorphisms +----------------------------------------------------------------------------+module Control.Morphism.Hylo where++import Control.Bifunctor+import Control.Bifunctor.HigherOrder+import Control.Comonad+import Control.Monad+import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Functor.HigherOrder++hylo :: Functor f => Alg g b -> Natural f g -> CoAlg f a -> a -> b+hylo f e g = f . e . fmap (hylo f e g). g ++g_hylo :: (Comonad w, Functor f, Monad m) =>+          Dist g w -> Dist m f -> AlgW g w b -> Natural f g -> CoAlgM f m a -> a -> b+g_hylo w m f e g = extract . h . return where h = liftW f . w . e . fmap (duplicate . h . join) . m . liftM g+++-- A more "Jeremy Gibbons"-style bifunctor-based version has the same expressive power ++bihylo :: (Bifunctor f, Bifunctor g) => Alg (g d) b -> Natural (f c) (g d) -> CoAlg (f c) a -> a -> b+bihylo f e g = f . e . bimap id (bihylo f e g). g ++g_bihylo :: (Comonad w, Bifunctor f, Monad m) =>+          Dist (g d) w -> Dist m (f c) -> AlgW (g d) w b -> Natural (f c) (g d) -> CoAlgM (f c) m a -> a -> b+g_bihylo w m f e g = extract . h . return where h = liftW f . w . e . bimap id (duplicate . h . join) . m . liftM g+++-- | higher order hylomorphisms for use in building up and tearing down higher order functors+hhylo :: HFunctor f => AlgH f b -> CoAlgH f a -> Natural a b+hhylo f g = f . hfmap (hhylo f g) . g+
+ src/Control/Morphism/Meta.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Meta+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+-- Generalized metamorphisms +----------------------------------------------------------------------------+module Control.Morphism.Meta where+++import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Comonad+import Control.Monad.Identity+import Control.Morphism.Ana+import Control.Morphism.Cata+++meta :: (Functor f, Functor g) => +	  CoAlg f b -> (a -> b) -> Alg g a -> Fix g -> Fix f+meta f e g = ana f . e . cata g++g_meta :: (Monad m, Functor f, Comonad w, Functor g) => +	  Dist m f -> Dist g w -> CoAlgM f m b -> (a -> b) -> AlgW g w a -> Fix g -> Fix f+g_meta m w f e g = g_ana m f . e . g_cata w g+
+ src/Control/Morphism/Para.hs view
@@ -0,0 +1,35 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Para+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+-- +----------------------------------------------------------------------------+module Control.Morphism.Para where++import Control.Comonad+import Control.Comonad.Reader+import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Morphism.Cata+import Control.Morphism.Zygo++-- * Refold Sugar++para :: Functor f => AlgW f (Para f) a -> Fix f -> a+para = zygo InF++g_para :: (Functor f, Comonad w) => Dist f w -> AlgW f (ParaT w f) a -> Fix f -> a+g_para f = g_cata (distParaT f)++type Para f a 		= (Fix f, a)+type ParaT w f a 	= ReaderCT w (Fix f) a++distParaT :: (Functor f, Comonad w) => Dist f w -> Dist f (ParaT w f)+distParaT = distZygoT (liftAlg InF)
+ src/Control/Morphism/Zygo.hs view
@@ -0,0 +1,39 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Morphism.Zygo +-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (rank-2 polymorphism)+--+----------------------------------------------------------------------------+module Control.Morphism.Zygo where++import Control.Arrow ((&&&))+import Control.Bifunctor.Pair+import Control.Comonad+import Control.Comonad.Reader+import Control.Functor.Algebra+import Control.Functor.Extras+import Control.Functor.Fix+import Control.Morphism.Cata++type Zygo b a = (b,a)++zygo :: Functor f => Alg f b -> AlgW f (Zygo b) a -> Fix f -> a+zygo f = g_cata (distZygo f)++g_zygo :: (Functor f, Comonad w) => AlgW f w b -> Dist f w -> AlgW f (ReaderCT w b) a -> Fix f -> a+g_zygo f w = g_cata (distZygoT f w)++-- * Distributive Law Combinators++distZygo :: Functor f => Alg f b -> Dist f (Zygo b)+distZygo g = g . fmap fst &&& fmap snd++distZygoT :: (Functor f, Comonad w) => AlgW f w b -> Dist f w -> Dist f (ReaderCT w b)+distZygoT g k = ReaderCT . liftW (g . fmap (liftW fst) &&& fmap (snd . extract)) . k . fmap (duplicate . runReaderCT)+
+ src/Data/Void.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Void+-- Copyright   :  (C) 2008 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (empty data declaration)+--+----------------------------------------------------------------------------+module Data.Void where++data Void++void :: Void -> a+void = undefined