packages feed

category-extras 0.50.1 → 0.50.3

raw patch · 26 files changed

+292/−106 lines, 26 files

Files

category-extras.cabal view
@@ -1,6 +1,6 @@ name:                   category-extras category:               Control, Monads, Comonads-version:                0.50.1+version:                0.50.3 license:                BSD3 cabal-version:          >= 1.2 license-file:           LICENSE@@ -76,6 +76,7 @@                 Control.Functor.Adjunction,                 Control.Functor.Adjunction.HigherOrder,                 Control.Functor.Algebra,+                Control.Functor.Algebra.Elgot,                 Control.Functor.Composition,                 Control.Functor.Combinators.Const,                 Control.Functor.Combinators.Lift,@@ -92,10 +93,11 @@                 Control.Functor.HigherOrder.Composition,                 Control.Functor.Indexed,                 Control.Functor.KanExtension,-                Control.Functor.Strong,+                Control.Functor.Limit,                 Control.Functor.Pointed,                 Control.Functor.Pointed.Composition,                 Control.Functor.Representable,+                Control.Functor.Strong,                 Control.Functor.Zip,                 Control.Functor.Zap,                 Control.Monad.Free,@@ -127,15 +129,13 @@         if flag(ArrowSubclassesCategory) {                 build-depends: ghc >= 6.9                 cpp-options: -D__ARROW_SUBCLASSES_CATEGORY__=1---              ghc-options: -D__ARROW_SUBCLASSES_CATEGORY__-		-- if you want docs you have to use the WRONG one to get it to work with haddock!         } else {                  build-depends: ghc < 6.9         } -         if flag(TypeFamilies) {                 extensions: TypeFamilies+                cpp-options: -D__TYPE_FAMILIES__=1         }          if flag(Optimize) {
src/Control/Comonad/Cofree.hs view
@@ -13,11 +13,16 @@ module Control.Comonad.Cofree  	( Cofree 	, outCofree, runCofree, anaCofree, cofree+	, CofreeLike(unwrap)+	, Expensive(..)+	, coimprove, worsen 	) where  import Control.Arrow ((&&&))+import Control.Comonad import Control.Functor.Fix import Control.Functor.Combinators.Biff+import Control.Functor.KanExtension import Control.Monad.Identity  type Cofree f = Fix (PCofree f)@@ -34,3 +39,19 @@ cofree :: a -> f (Cofree f a) -> Cofree f a  cofree a as = InB $ Biff (Identity a,as) +class (Functor f, Comonad w) => CofreeLike f w | w -> f where+        unwrap :: w a -> f (w a)++instance Functor f => CofreeLike f (Cofree f) where+        unwrap = outCofree ++instance CofreeLike f w => CofreeLike f (Lan w w) where+        unwrap (Lan f c) = fmap (Lan f) (unwrap c)++data Expensive f a = forall w. CofreeLike f w => Expensive { runExpensive :: w a }++coimprove :: Functor f => Cofree f a -> Expensive f a+coimprove m = Expensive (coabs m)++worsen :: Functor f => (forall w. CofreeLike f w => w a) -> Cofree f a+worsen m = corep m
src/Control/Comonad/HigherOrder.hs view
@@ -17,12 +17,12 @@ 	, hduplicate 	) where -import Control.Functor.Extras (Natural)+import Control.Functor.Extras import Control.Functor.HigherOrder  class HCopointed w => HComonad w where-	hextend  :: (Functor f, Functor g) => Natural (w f) g -> Natural (w f) (w g)+	hextend  :: (Functor f, Functor g) => (w f :~> g) -> w f :~> w g  -hduplicate :: (HComonad w, Functor (w g), Functor g) => w g a -> w (w g) a+hduplicate :: (HComonad w, Functor (w g), Functor g) => w g :~> w (w g) hduplicate = hextend id
src/Control/Functor/Adjunction/HigherOrder.hs view
@@ -18,10 +18,10 @@ import Control.Functor.Extras  class (HFunctor f, HFunctor g) => HAdjunction f g where-        hunit   :: Natural a (g (f a))-        hcounit :: Natural (f (g b)) b-        hleftAdjunct  :: Natural (f a) b -> Natural a (g b)-        hrightAdjunct :: Natural a (g b) -> Natural (f a) b+        hunit   :: a :~> g (f a)+        hcounit :: f (g b) :~> b+        hleftAdjunct  :: (f a :~> b) -> a :~> g b+        hrightAdjunct :: (a :~> g b) -> f a :~> b          hunit = hleftAdjunct id         hcounit = hrightAdjunct id
src/Control/Functor/Algebra.hs view
@@ -8,19 +8,66 @@ -- Stability   :  experimental -- Portability :  non-portable (rank-2 polymorphism) --+-- Algebras, Coalgebras, Bialgebras, and Dialgebras and their (co)monadic+-- variants -----------------------------------------------------------------------------module Control.Functor.Algebra where+module Control.Functor.Algebra +	( Dialgebra, GDialgebra+	, Bialgebra, GBialgebra+	, Algebra, GAlgebra+	, Coalgebra, GCoalgebra+	, liftAlgebra+	, liftCoalgebra+	, liftDialgebra+	, fromCoalgebra+	, fromAlgebra+	, fromBialgebra+	) where  import Control.Comonad+import Control.Monad.Identity+import Control.Functor+import Control.Functor.Extras+import Control.Functor.Combinators.Lift -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)+-- | F,G-dialgebras generalize algebras and coalgebraas+type Dialgebra f g a = f a -> g a -liftAlg :: (Functor f, Comonad w) => Alg f a -> AlgW f w a-liftAlg f = f . fmap extract+type GDialgebra f g w m a = f (w a) -> g (m a) -liftCoAlg :: (Functor f, Monad m) => CoAlg f a -> CoAlgM f m a-liftCoAlg f = fmap return . f+-- | F-G-bialgebras are representable by @DiAlg (f :+: Identity) (Identity :+: g) a@+-- and so add no expressive power, but are a lot more convenient.+type Bialgebra f g a = (Algebra f a, Coalgebra g a)+type GBialgebra f g w m a = (GAlgebra f w a, GCoalgebra g m a) +-- | F-Algebras+type Algebra f a = f a -> a++-- | F-Coalgebras+type Coalgebra f a = a -> f a++-- | F-W-Comonadic Algebras for a given comonad W+type GAlgebra f w a = f (w a) -> a++-- | F-M-Monadic Coalgebras for a given monad M+type GCoalgebra f m a = a -> f (m a)++-- | Turn an F-algebra into a F-W-algebra by throwing away the comonad+liftAlgebra :: (Functor f, Comonad w) => Algebra f :~> GAlgebra f w +liftAlgebra phi = phi . fmap extract++-- | Turn a F-coalgebra into a F-M-coalgebra by returning into a monad+liftCoalgebra :: (Functor f, Monad m) => Coalgebra f :~> GCoalgebra f m+liftCoalgebra psi = fmap return . psi++liftDialgebra :: (Functor g, Functor f, Comonad w, Monad m) => Dialgebra f g :~> GDialgebra f g w m +liftDialgebra phi = fmap return . phi . fmap extract++fromAlgebra :: Algebra f :~> Dialgebra f Identity+fromAlgebra phi = Identity . phi++fromCoalgebra :: Coalgebra f :~> Dialgebra Identity f+fromCoalgebra psi = psi . runIdentity++fromBialgebra :: Bialgebra f g :~> Dialgebra (f :*: Identity) (Identity :*: g) +fromBialgebra (phi,psi) = Lift . bimap (Identity . phi) (psi . runIdentity) . runLift
+ src/Control/Functor/Algebra/Elgot.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Functor.Algebra.Elgot+-- 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)+--+-- Elgot algebras, and their obvious dual, based on:+-- <http://www.iti.cs.tu-bs.de/~milius/research/elgot_lmcs.pdf>+--+-- Elgot algebras given you a shortcircuitable hylomorphism where you+-- can directly return a sub-answer to the catamorphism.+----------------------------------------------------------------------------+module Control.Functor.Algebra.Elgot+	( elgot+	, coelgot+--	, g_elgot+--	, g_coelgot+	) where++import Control.Arrow ((|||),(&&&))+import Control.Functor.Algebra+-- import Control.Functor.Extras+-- import Control.Comonad+-- import Control.Monad++elgot :: Functor f => Algebra f a -> (b -> Either a (f b)) -> b -> a+elgot phi psi = h where h = (id ||| phi . fmap h) . psi++coelgot :: Functor f => ((a, f b) -> b) -> Coalgebra f a -> a -> b+coelgot phi psi = h where h = phi . (id &&& fmap h . psi)++-- ideally this would have b -> Either a (f b)+-- g_elgot :: (Comonad w, Functor f) => Dist f w -> GAlgebra f w a -> (b -> Either (w a) (f b)) -> b -> a+-- g_elgot k phi psi = extract . h where +-- 	h = (id ||| liftW phi . k . fmap (duplicate . h)) . psi++-- g_coelgot :: (Monad m, Functor f) => Dist m f -> ((m a, f b) -> b) -> GCoalgebra f m a -> a -> b+-- g_coelgot k phi psi = h . return where+--	h = phi . (id &&& fmap (h . join) . k . liftM psi)
src/Control/Functor/Composition.hs view
@@ -30,9 +30,9 @@ import Control.Category.Hask import Control.Category.Braided -class Composition c where-	decompose  :: c f g x -> f (g x)-	compose    :: f (g x) -> c f g x+class Composition o where+	decompose  :: (f `o` g) x -> f (g x)+	compose    :: f (g x) -> (f `o` g) x  newtype CompF f g a = CompF { runCompF :: f (g a) }
src/Control/Functor/Extras.hs view
@@ -12,8 +12,12 @@ ---------------------------------------------------------------------------- module Control.Functor.Extras where +infixr 0 :~>, :~~> -- to match ->+ type Dist f g = forall a. f (g a) -> g (f a)-type Natural f g = forall a. f a -> g a+-- A natural transformation between functors f and g.+type f :~> g = forall a. f a -> g a+type f :~~> g = forall a b. f a b -> g a b  class PostFold m f where         postFold :: f (m (f a)) -> m (f a)
src/Control/Functor/Fix.hs view
@@ -31,11 +31,11 @@  newtype FixF f = InF { outF :: f (FixF f) } -outM :: (Functor f, Monad m) => CoAlgM f m (FixF f)-outM = liftCoAlg outF+outM :: (Functor f, Monad m) => GCoalgebra f m (FixF f)+outM = liftCoalgebra outF -inW :: (Functor f, Comonad w) => AlgW f w (FixF f)-inW = liftAlg InF+inW :: (Functor f, Comonad w) => GAlgebra f w (FixF f)+inW = liftAlgebra InF  -- * Fixpoint of a bifunctor
src/Control/Functor/HigherOrder.hs view
@@ -16,8 +16,8 @@ 	( HFunctor(..) 	, HPointed(..) 	, HCopointed(..)-	, AlgH-	, CoAlgH+	, HAlgebra+	, HCoalgebra 	, FixH(..) 	, LowerH(..) 	) where@@ -25,12 +25,12 @@ import Control.Functor.Pointed import Control.Functor.Extras -type AlgH f g = Natural (f g) g-type CoAlgH f g = Natural g (f g)+type HAlgebra f g = f g :~> g+type HCoalgebra f g = 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)+	hfmap :: (g :~> h) -> f g :~> f h  newtype FixH f a = InH { outH :: f (FixH f) a }
src/Control/Functor/HigherOrder/Composition.hs view
@@ -15,18 +15,18 @@ module Control.Functor.HigherOrder.Composition 	( CompH(..) 	, HComposition(..)-	, hassociateComp-	, hcoassociateComp+	, hassociateComposition+	, hcoassociateComposition 	) where  import Control.Functor.HigherOrder  class HComposition -	(c :: ((* -> *) -> * -> *) -> +	(o :: ((* -> *) -> * -> *) ->  	      ((* -> *) -> * -> *) ->  	      ((* -> *) -> * -> *)) where-	hcompose :: f (g x) a ->  c f g x a-	hdecompose :: c f g x a -> f (g x) a+	hcompose :: f (g h) a ->  (f `o` g) h a+	hdecompose :: (f `o` g) h a -> f (g h) a  newtype CompH  	(f :: ((* -> *) -> * -> *))@@ -44,8 +44,8 @@ instance (HFunctor f, HFunctor g, Functor h) => Functor (CompH f g h) where 	fmap = ffmap -hassociateComp :: (HFunctor f, HComposition c) => c (c f g) h a b -> c f (c g h) a b-hassociateComp = hcompose . hfmap hcompose . hdecompose . hdecompose+hassociateComposition :: (HFunctor f, HComposition o) => ((f `o` g) `o` h) a b -> (f `o` (g `o` h)) a b+hassociateComposition = hcompose . hfmap hcompose . hdecompose . hdecompose -hcoassociateComp :: (HFunctor f, HComposition c) => c f (c g h) a b -> c (c f g) h a b-hcoassociateComp = hcompose . hcompose . hfmap hdecompose . hdecompose+hcoassociateComposition :: (HFunctor f, HComposition o) => (f `o` (g `o` h)) a b -> ((f `o` g) `o` h) a b+hcoassociateComposition = hcompose . hcompose . hfmap hdecompose . hdecompose
src/Control/Functor/KanExtension.hs view
@@ -10,17 +10,19 @@ -- -- Left and right Kan extensions, expressed as higher order functors ----- Some reference for the Ran monad/Lan comonad below would be nice, as I --- constructed them from first principles, but haven't seen them in --- literature.+-- Included is the 'monad generated by a functor' @Ran f f@+-- and the comonad cogenerated by a functor @Lan f f@. ---------------------------------------------------------------------------- module Control.Functor.KanExtension  	( Ran(..) 	, toRan, fromRan 	, Lan(..) 	, toLan, fromLan+	, rep, abs+	, corep, coabs 	) where +import Prelude hiding (abs) import Control.Functor.Composition import Control.Functor.Extras import Control.Functor.Pointed ()@@ -31,10 +33,10 @@ -- | 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 :: (Composition o, Functor k) => (k `o` g :~> h) -> 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 :: Composition o => (k :~> Ran g h) -> (k `o` g) :~> h fromRan s = flip runRan id . s . decompose  instance HFunctor (Ran g) where@@ -51,13 +53,20 @@ 	return = point 	m >>= k = Ran (\c -> runRan m (\a -> runRan (k a) c)) +-- | See <http://wwwtcs.inf.tu-dresden.de/%7Evoigt/mpc08.pdf>+rep :: Monad m => m a -> Ran m m a+rep m = Ran (m >>=)++abs :: Monad m => Ran m m a -> m a +abs a = runRan a return+ -- | 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 :: (Composition o, Functor f) => (h :~> (f `o` g)) -> 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 :: Composition o => (Lan g h :~> f) -> h :~> (f `o` g) fromLan s = compose . s . Lan id  instance Functor g => HFunctor (Lan g) where@@ -65,10 +74,17 @@ 	hfmap f (Lan g h) = Lan g (f h)  instance Functor (Lan f g) where-	fmap f (Lan g h) = Lan (f . g) h +	fmap f (Lan g h) = Lan (f . g) h  instance Copointed (Lan f f) where 	extract (Lan f a) = f a  instance Comonad (Lan f f) where 	duplicate (Lan f ws) = Lan (Lan f) ws++coabs :: Comonad w => w a -> Lan w w a+coabs = Lan extract ++corep :: Comonad w => Lan w w a -> w a +corep (Lan f c) = extend f c+
+ src/Control/Functor/Limit.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Functor.Limit+-- 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/existentials in Ran/Lan)+--+----------------------------------------------------------------------------+module Control.Functor.Limit+	( Lim+	, Colim+	, module Control.Functor.KanExtension+	, Void+	, Const+	) where++import Prelude hiding (abs)+import Control.Applicative (Const)+import Data.Void (Void)+import Control.Functor.KanExtension++type Lim = Ran (Const Void)+type Colim = Lan (Const Void)
src/Control/Monad/Free.hs view
@@ -9,6 +9,11 @@ -- Stability   :  experimental -- Portability :  portable --+-- See <http://wwwtcs.inf.tu-dresden.de/%7Evoigt/mpc08.pdf> for+-- the background on rep, abs and improve and their use. NB: the C type+-- in that paper is just the right Kan extension of a monad +-- along itself, also known as the monad generated by a functor:+-- <http://www.tac.mta.ca/tac/volumes/10/19/10-19.ps> ---------------------------------------------------------------------------- module Control.Monad.Free  	( module Control.Monad.Parameterized@@ -18,19 +23,22 @@ 	, runFree 	, cataFree 	, free+	-- * Improving asymptotic performance with right Kan extensions+	, FreeLike(wrap)+	, improve 	) where -import Prelude hiding ((.),id)+import Prelude hiding ((.),id,abs) import Control.Category import Control.Category.Cartesian import Control.Functor import Control.Functor.Combinators.Biff+import Control.Functor.KanExtension import Control.Functor.Fix import Control.Monad.Parameterized import Control.Monad.Identity --type Free f a = Fix (PFree f) a+type Free f = Fix (PFree f)  inFree :: f (Free f a) -> Free f a inFree = InB . Biff . Right@@ -43,3 +51,15 @@  free :: Either a (f (Free f a)) -> Free f a free = InB . Biff . first Identity++class (Functor f, Monad m) => FreeLike f m where+        wrap :: f (m a) -> m a++instance FreeLike f m => FreeLike f (Ran m m) where+        wrap t = Ran (wrap . flip fmap t . flip runRan)++instance Functor f => FreeLike f (Free f) where+        wrap = inFree++improve :: Functor f => (forall m. FreeLike f m => m a) -> Free f a+improve m = abs m
src/Control/Monad/HigherOrder.hs view
@@ -17,20 +17,20 @@ 	, (>>**=), (=**<<) 	) where -import Control.Functor.Extras (Natural)+import Control.Functor.Extras  import Control.Functor.HigherOrder  infixl 1 >>**= infixr 1 =**<<  class HPointed m => HMonad m where-	hbind   :: (Functor f, Functor g) => Natural f (m g) -> Natural (m f) (m g)+	hbind   :: (Functor f, Functor g) => (f :~> m g) -> m f :~> m g -hjoin :: (HMonad m, Functor (m g), Functor g) => m (m g) a -> m g a+hjoin :: (HMonad m, Functor (m g), Functor g) => m (m g) :~> m g hjoin = hbind id -(>>**=) :: (HMonad m, Functor f, Functor g) => m f a -> Natural f (m g) -> m g a+(>>**=) :: (HMonad m, Functor f, Functor g) => m f a -> (f :~> m g) -> m g a m >>**= k = hbind k m  -(=**<<) :: (HMonad m, Functor f, Functor g) => Natural f (m g) -> Natural (m f) (m g)+(=**<<) :: (HMonad m, Functor f, Functor g) => (f :~> m g) -> m f :~> m g (=**<<) = hbind
src/Control/Morphism/Ana.hs view
@@ -22,12 +22,12 @@ import Control.Monad.Identity  -- | Anamorphisms are a generalized form of 'unfoldr'-ana :: Functor f => CoAlg f a -> a -> FixF f+ana :: Functor f => Coalgebra f a -> a -> FixF f ana g = InF . fmap (ana g) . g--- ana g = g_ana distAna (liftCoAlg g)+-- ana g = g_ana distAna (liftCoAlgebra 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 -> FixF f+g_ana :: (Functor f, Monad m) => Dist m f -> GCoalgebra f m a -> a -> FixF 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 @@ -35,12 +35,12 @@ distAna :: Functor f => Dist Identity f distAna = fmap Identity . runIdentity -biana :: Bifunctor f Hask Hask Hask => CoAlg (f b) a -> a -> Fix f b+biana :: Bifunctor f Hask Hask Hask => Coalgebra (f b) a -> a -> Fix f b biana g = InB . bimap id (biana g) . g -g_biana :: (Bifunctor f Hask Hask Hask, Monad m) => Dist m (f b) -> CoAlgM (f b) m a -> a -> Fix f b+g_biana :: (Bifunctor f Hask Hask Hask, Monad m) => Dist m (f b) -> GCoalgebra (f b) m a -> a -> Fix 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 :: HFunctor f => HCoalgebra f a -> a :~> FixH f hana g = InH . hfmap (hana g) . g
src/Control/Morphism/Apo.hs view
@@ -11,7 +11,14 @@ --  -- Traditional operators, shown here to show how to roll your own -----------------------------------------------------------------------------module Control.Morphism.Apo where+module Control.Morphism.Apo +	( apo+	, Apo, ApoT+	, distApoT+	, g_apo+	, GApo, GApoT+	, distGApo, distGApoT+	) where   import Control.Functor.Algebra@@ -24,10 +31,10 @@  -- * Unfold Sugar -apo :: Functor f => CoAlgM f (Apo f) a -> a -> FixF f+apo :: Functor f => GCoalgebra f (Apo f) a -> a -> FixF f apo = g_apo outF -g_apo :: Functor f => CoAlg f b -> CoAlgM f (GApo b) a -> a -> FixF f+g_apo :: Functor f => Coalgebra f b -> GCoalgebra f (GApo b) a -> a -> FixF f g_apo g = g_ana (distGApo g)  type Apo f a 		= Either (FixF f) a@@ -38,12 +45,12 @@  -- * Distributive Law Combinators -distGApo :: Functor f => CoAlg f b -> Dist (Either b) f+distGApo :: Functor f => Coalgebra 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 :: (Functor f, Monad m) => GCoalgebra 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)+distApoT = distGApoT (liftCoalgebra outF)
src/Control/Morphism/Cata.hs view
@@ -22,22 +22,22 @@ import Control.Functor.Fix import Control.Monad.Identity -cata :: Functor f => Alg f a -> FixF f -> a+cata :: Functor f => Algebra f a -> FixF f -> a cata f = f . fmap (cata f) . outF--- cata f = g_cata distCata (liftAlg f)+-- cata f = g_cata distCata (liftAlgebra f) -g_cata :: (Functor f, Comonad w) => Dist f w -> AlgW f w a -> FixF f -> a+g_cata :: (Functor f, Comonad w) => Dist f w -> GAlgebra f w a -> FixF f -> a g_cata k g = extract . c where c = liftW g . k . fmap (duplicate . c) . outF -- g_cata k f = g_hylo k distAna f id outM  distCata :: Functor f => Dist f Identity distCata = Identity . fmap runIdentity -bicata :: Bifunctor f Hask Hask Hask => Alg (f b) a -> Fix f b -> a+bicata :: Bifunctor f Hask Hask Hask => Algebra (f b) a -> Fix f b -> a bicata f = f . bimap id (bicata f) . outB -g_bicata :: (Bifunctor f Hask Hask Hask, Comonad w) => Dist (f b) w -> AlgW (f b) w a -> Fix f b -> a+g_bicata :: (Bifunctor f Hask Hask Hask, Comonad w) => Dist (f b) w -> GAlgebra (f b) w a -> Fix 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 :: HFunctor f => HAlgebra f a -> FixH f :~> a hcata f = f . hfmap (hcata f) . outH
src/Control/Morphism/Chrono.hs view
@@ -21,9 +21,9 @@ 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 :: (Functor f, Functor g) => GAlgebra g (Cofree g) b -> (f :~> g) -> GCoalgebra 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+	    Dist g h -> Dist j f -> GAlgebra g (Cofree h) b -> (f :~> g) -> GCoalgebra f (Free j) a -> a -> b g_chrono h f = g_hylo (distHisto h) (distFutu f)
src/Control/Morphism/Dyna.hs view
@@ -19,5 +19,5 @@ 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)+dyna :: (Functor f, Functor g) => GAlgebra g (Cofree g) b -> (f :~> g) -> Coalgebra f a -> a -> b+dyna f e g = g_hylo (distHisto id) distAna f e (liftCoalgebra g)
src/Control/Morphism/Futu.hs view
@@ -20,10 +20,10 @@ import Control.Monad.Free import Control.Morphism.Ana -futu :: Functor f => CoAlgM f (Free f) a -> a -> FixF f+futu :: Functor f => GCoalgebra f (Free f) a -> a -> FixF f futu = g_ana (distFutu id) -g_futu :: (Functor f, Functor h) => Dist h f -> CoAlgM f (Free h) a -> a -> FixF f+g_futu :: (Functor f, Functor h) => Dist h f -> GCoalgebra f (Free h) a -> a -> FixF f g_futu k = g_ana (distFutu k)  distFutu :: (Functor f, Functor h) => Dist h f -> Dist (Free h) f
src/Control/Morphism/Histo.hs view
@@ -20,10 +20,10 @@ import Control.Comonad.Cofree import Control.Morphism.Cata -histo :: Functor f => AlgW f (Cofree f) a -> FixF f -> a+histo :: Functor f => GAlgebra f (Cofree f) a -> FixF f -> a histo = g_cata (distHisto id) -g_histo :: (Functor f, Functor h) => Dist f h -> AlgW f (Cofree h) a -> FixF f -> a+g_histo :: (Functor f, Functor h) => Dist f h -> GAlgebra f (Cofree h) a -> FixF f -> a g_histo k = g_cata (distHisto k)  distHisto :: (Functor f, Functor h) => Dist f h -> Dist f (Cofree h)
src/Control/Morphism/Hylo.hs view
@@ -23,23 +23,23 @@ import Control.Functor.Extras import Control.Functor.HigherOrder -hylo :: Functor f => Alg g b -> Natural f g -> CoAlg f a -> a -> b+hylo :: Functor f => Algebra g b -> (f :~> g) -> Coalgebra 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+          Dist g w -> Dist m f -> GAlgebra g w b -> (f :~> g) -> GCoalgebra 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  -- The Jeremy Gibbons-style bifunctor-based version has the same expressive power, but may fuse with bimaps better -bihylo :: (QFunctor f Hask Hask) => Alg (g d) b -> Natural (f c) (g d) -> CoAlg (f c) a -> a -> b+bihylo :: (QFunctor f Hask Hask) => Algebra (g d) b -> (f c :~> g d) -> Coalgebra (f c) a -> a -> b bihylo f e g = f . e . second (bihylo f e g). g   g_bihylo :: (Comonad w, QFunctor f Hask Hask, 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+          Dist (g d) w -> Dist m (f c) -> GAlgebra (g d) w b -> (f c :~> g d) -> GCoalgebra (f c) m a -> a -> b g_bihylo w m f e g = extract . h . return where h = liftW f . w . e . second (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 :: HFunctor f => HAlgebra f b -> HCoalgebra f a -> a :~> b hhylo f g = f . hfmap (hhylo f g) . g
src/Control/Morphism/Meta.hs view
@@ -9,11 +9,13 @@ -- Stability   :  experimental -- Portability :  non-portable (rank-2 polymorphism) ----- Generalized metamorphisms +-- A very basic Jeremy Gibbons metamorphism, without all +-- the productive stream stuff. See:+-- <http://www.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/metamorphisms-scp.pdf>+-- TODO: Add some support for spigot algorithms over streams/lists. ---------------------------------------------------------------------------- module Control.Morphism.Meta where - import Control.Functor.Algebra import Control.Functor.Extras import Control.Functor.Fix@@ -22,11 +24,10 @@ import Control.Morphism.Ana import Control.Morphism.Cata - meta :: (Functor f, Functor g) => -	  CoAlg f b -> (a -> b) -> Alg g a -> FixF g -> FixF f+	  Coalgebra f b -> (a -> b) -> Algebra g a -> FixF g -> FixF 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 -> FixF g -> FixF f+	  Dist m f -> Dist g w -> GCoalgebra f m b -> (a -> b) -> GAlgebra g w a -> FixF g -> FixF f g_meta m w f e g = g_ana m f . e . g_cata w g
src/Control/Morphism/Para.hs view
@@ -22,14 +22,14 @@  -- * Refold Sugar -para :: Functor f => AlgW f (Para f) a -> FixF f -> a+type Para f 	= (,) (FixF f)+type ParaT w f 	= CoreaderT w (FixF f)++para :: Functor f => GAlgebra f (Para f) a -> FixF f -> a para = zygo InF -g_para :: (Functor f, Comonad w) => Dist f w -> AlgW f (ParaT w f) a -> FixF f -> a+g_para :: (Functor f, Comonad w) => Dist f w -> GAlgebra f (ParaT w f) a -> FixF f -> a g_para f = g_cata (distParaT f) -type Para f a 		= (FixF f, a)-type ParaT w f a 	= CoreaderT w (FixF f) a- distParaT :: (Functor f, Comonad w) => Dist f w -> Dist f (ParaT w f)-distParaT = distZygoT (liftAlg InF)+distParaT = distZygoT (liftAlgebra InF)
src/Control/Morphism/Zygo.hs view
@@ -20,19 +20,20 @@ import Control.Functor.Fix import Control.Morphism.Cata -type Zygo b a = (b,a)+type Zygo = (,)+type ZygoT = CoreaderT -zygo :: Functor f => Alg f b -> AlgW f (Zygo b) a -> FixF f -> a+zygo :: Functor f => Algebra f b -> GAlgebra f (Zygo b) a -> FixF f -> a zygo f = g_cata (distZygo f) -g_zygo :: (Functor f, Comonad w) => AlgW f w b -> Dist f w -> AlgW f (CoreaderT w b) a -> FixF f -> a+g_zygo :: (Functor f, Comonad w) => GAlgebra f w b -> Dist f w -> GAlgebra f (ZygoT w b) a -> FixF 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 :: Functor f => Algebra 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 (CoreaderT w b)+distZygoT :: (Functor f, Comonad w) => GAlgebra f w b -> Dist f w -> Dist f (ZygoT w b) distZygoT g k = CoreaderT . liftW (g . fmap (liftW fst) &&& fmap (snd . extract)) . k . fmap (duplicate . runCoreaderT)