recursion-schemes 4.1.2 → 5
raw patch · 7 files changed
+385/−82 lines, 7 filesdep +bifunctorsdep +ghc-primdep +transformers-compatdep ~comonadnew-uploader
Dependencies added: bifunctors, ghc-prim, transformers-compat
Dependency ranges changed: comonad
Files
- .gitignore +21/−0
- .travis.yml +88/−1
- CHANGELOG.markdown +9/−0
- Data/Functor/Foldable.hs +239/−75
- LICENSE +1/−1
- README.markdown +15/−0
- recursion-schemes.cabal +12/−5
+ .gitignore view
@@ -0,0 +1,21 @@+dist/+dist-newstyle/+.stack-work/+.hsenv/+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#+.cabal-sandbox/+cabal.sandbox.config+codex.tags+src/highlight.js+src/style.css
.travis.yml view
@@ -1,1 +1,88 @@-language: haskell+# This file has been generated -- see https://github.com/hvr/multi-ghc-travis+language: c+sudo: false++cache:+ directories:+ - $HOME/.cabsnap+ - $HOME/.cabal/packages++before_cache:+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar++matrix:+ include:+ - env: CABALVER=1.16 GHCVER=7.4.2+ compiler: ": #GHC 7.4.2"+ addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2], sources: [hvr-ghc]}}+ - env: CABALVER=1.16 GHCVER=7.6.3+ compiler: ": #GHC 7.6.3"+ addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}+ - env: CABALVER=1.18 GHCVER=7.8.4+ compiler: ": #GHC 7.8.4"+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}+ - env: CABALVER=1.22 GHCVER=7.10.3+ compiler: ": #GHC 7.10.3"+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=8.0.1+ compiler: ": #GHC 8.0.1b"+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}++before_install:+ - unset CC+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH++install:+ - cabal --version+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];+ then+ zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >+ $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;+ fi+ - travis_retry cabal update -v+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config+ - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt++# check whether current requested install-plan matches cached package-db snapshot+ - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;+ then+ echo "cabal build-cache HIT";+ rm -rfv .ghc;+ cp -a $HOME/.cabsnap/ghc $HOME/.ghc;+ cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;+ else+ echo "cabal build-cache MISS";+ rm -rf $HOME/.cabsnap;+ mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;+ cabal install --only-dependencies --enable-tests --enable-benchmarks;+ fi++# snapshot package-db on cache miss+ - if [ ! -d $HOME/.cabsnap ];+ then+ echo "snapshotting package-db to build-cache";+ mkdir $HOME/.cabsnap;+ cp -a $HOME/.ghc $HOME/.cabsnap/ghc;+ cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;+ fi++# Here starts the actual work to be performed for the package under test;+# any command which exits with a non-zero exit code causes the build to fail.+script:+ - if [ -f configure.ac ]; then autoreconf -i; fi+ - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging+ - cabal build # this builds all libraries and executables (including tests/benchmarks)+ - cabal test+ - cabal check+ - cabal sdist # tests that a source-distribution can be generated++# Check that the resulting source distribution can be built & installed.+# If there are no other `.tar.gz` files in `dist`, this can be even simpler:+# `cabal install --force-reinstalls dist/*-*.tar.gz`+ - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&+ (cd dist && cabal install --force-reinstalls "$SRC_TGZ")++# EOF
CHANGELOG.markdown view
@@ -1,3 +1,12 @@+## 5+* Renamed `Foldable` to `Recursive` and `Unfoldable` to `Corecursive`. With `Foldable` in `Prelude` in GHC 7.10+, having a needlessly conflicting name seemed silly.+* Add support for GHC-8.0.1+* Use `Eq1`, `Ord1`, `Show1`, `Read1` to derive `Fix`, `Nu` and `Mu` `Eq`, `Ord` `Show` and `Read` instances+* Remove `Prim` data family. `ListF` as a new name for `Prim [a]`, with plenty of instances, e.g. `Traversable`.+* Export `unfix`+* Add chronomorphisms: `chrono` and `gchrono`.+* Add `distGApoT`+ ## 4.1.2 * Support for `free` 4.12.1
Data/Functor/Foldable.hs view
@@ -1,13 +1,32 @@ {-# LANGUAGE CPP, TypeFamilies, Rank2Types, FlexibleContexts, FlexibleInstances, GADTs, StandaloneDeriving, UndecidableInstances #-}++-- explicit dictionary higher-kind instances are defined in+-- - base-4.9+-- - transformers >= 0.5+-- - transformes-compat >= 0.5 when transformers aren't 0.4+#define EXPLICIT_DICT_FUNCTOR_CLASSES (MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0) || (MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)))++#define HAS_GENERIC (__GLASGOW_HASKELL__ >= 702)+#define HAS_GENERIC1 (__GLASGOW_HASKELL__ >= 706)++-- Polymorphic typeable+#define HAS_POLY_TYPEABLE MIN_VERSION_base(4,7,0)+ #ifdef __GLASGOW_HASKELL__-#if MIN_VERSION_base(4,7,0) {-# LANGUAGE DeriveDataTypeable #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE ConstrainedClassMethods #-} #endif+#if HAS_GENERIC+{-# LANGUAGE DeriveGeneric #-} #endif+#endif+++ ----------------------------------------------------------------------------- -- |--- Module : Data.Functor.Foldable--- Copyright : (C) 2008-2013 Edward Kmett+-- Copyright : (C) 2008-2015 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett <ekmett@gmail.com>@@ -19,13 +38,13 @@ ( -- * Base functors for fixed points Base+ , ListF(..) -- * Fixed points- , Fix(..)+ , Fix(..), unfix , Mu(..) , Nu(..)- , Prim(..) -- * Folding- , Foldable(..)+ , Recursive(..) -- ** Combinators , gapo , gcata@@ -34,6 +53,8 @@ , histo , ghisto , futu+ , chrono+ , gchrono -- ** Distributive laws , distCata , distPara@@ -45,13 +66,14 @@ , distFutu , distGFutu -- * Unfolding- , Unfoldable(..)+ , Corecursive(..) -- ** Combinators , gana -- ** Distributive laws , distAna , distApo , distGApo+ , distGApoT -- * Refolding , hylo , ghylo@@ -79,28 +101,40 @@ import Control.Comonad.Cofree (Cofree(..)) import Control.Monad (liftM, join) import Control.Monad.Free (Free(..))+import Control.Monad.Trans.Except (ExceptT(..), runExceptT) import Data.Functor.Identity import Control.Arrow import Data.Function (on)+import Data.Functor.Classes import Text.Read+import Text.Show #ifdef __GLASGOW_HASKELL__ import Data.Data hiding (gunfold)-#if MIN_VERSION_base(4,7,0)+#if HAS_POLY_TYPEABLE #else import qualified Data.Data as Data #endif-#if MIN_VERSION_base(4,8,0)-import Prelude hiding (Foldable)+#if HAS_GENERIC+import GHC.Generics (Generic) #endif+#if HAS_GENERIC1+import GHC.Generics (Generic1) #endif+#endif -type family Base t :: * -> *+import Data.Monoid (Monoid (..))+import Prelude -data family Prim t :: * -> *--- type instance Base (Maybe a) = Const (Maybe a)--- type instance Base (Either a b) = Const (Either a b)+import qualified Data.Foldable as F+import qualified Data.Traversable as T -class Functor (Base t) => Foldable t where+import qualified Data.Bifunctor as Bi+import qualified Data.Bifoldable as Bi+import qualified Data.Bitraversable as Bi++type family Base t :: * -> *++class Functor (Base t) => Recursive t where project :: t -> Base t t cata :: (Base t a -> a) -- ^ a (Base t)-algebra@@ -111,12 +145,12 @@ para :: (Base t (t, a) -> a) -> t -> a para t = p where p x = t . fmap ((,) <*> p) $ project x - gpara :: (Unfoldable t, Comonad w) => (forall b. Base t (w b) -> w (Base t b)) -> (Base t (EnvT t w a) -> a) -> t -> a+ gpara :: (Corecursive t, Comonad w) => (forall b. Base t (w b) -> w (Base t b)) -> (Base t (EnvT t w a) -> a) -> t -> a gpara t = gzygo embed t -- | Fokkinga's prepromorphism prepro- :: Unfoldable t+ :: Corecursive t => (forall b. Base t b -> Base t b) -> (Base t a -> a) -> t@@ -125,7 +159,7 @@ --- | A generalized prepromorphism gprepro- :: (Unfoldable t, Comonad w)+ :: (Corecursive t, Comonad w) => (forall b. Base t (w b) -> w (Base t b)) -> (forall c. Base t c -> Base t c) -> (Base t (w a) -> a)@@ -133,13 +167,13 @@ -> a gprepro k e f = extract . c where c = fmap f . k . fmap (duplicate . c . cata (embed . e)) . project -distPara :: Unfoldable t => Base t (t, a) -> (t, Base t a)+distPara :: Corecursive t => Base t (t, a) -> (t, Base t a) distPara = distZygo embed -distParaT :: (Unfoldable t, Comonad w) => (forall b. Base t (w b) -> w (Base t b)) -> Base t (EnvT t w a) -> EnvT t w (Base t a)+distParaT :: (Corecursive t, Comonad w) => (forall b. Base t (w b) -> w (Base t b)) -> Base t (EnvT t w a) -> EnvT t w (Base t a) distParaT t = distZygoT embed t -class Functor (Base t) => Unfoldable t where+class Functor (Base t) => Corecursive t where embed :: Base t t -> t ana :: (a -> Base t a) -- ^ a (Base t)-coalgebra@@ -147,12 +181,12 @@ -> t -- ^ resulting fixed point ana g = a where a = embed . fmap a . g - apo :: Foldable t => (a -> Base t (Either t a)) -> a -> t+ apo :: (a -> Base t (Either t a)) -> a -> t apo g = a where a = embed . (fmap (either id a)) . g -- | Fokkinga's postpromorphism postpro- :: Foldable t+ :: Recursive t => (forall b. Base t b -> Base t b) -- natural transformation -> (a -> Base t a) -- a (Base t)-coalgebra -> a -- seed@@ -161,7 +195,7 @@ -- | A generalized postpromorphism gpostpro- :: (Foldable t, Monad m)+ :: (Recursive t, Monad m) => (forall b. m (Base t b) -> Base t (m b)) -- distributive law -> (forall c. Base t c -> Base t c) -- natural transformation -> (a -> Base t (m a)) -- a (Base t)-m-coalgebra@@ -172,29 +206,111 @@ hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b hylo f g = h where h = f . fmap h . g -fold :: Foldable t => (Base t a -> a) -> t -> a+fold :: Recursive t => (Base t a -> a) -> t -> a fold = cata -unfold :: Unfoldable t => (a -> Base t a) -> a -> t+unfold :: Corecursive t => (a -> Base t a) -> a -> t unfold = ana refold :: Functor f => (f b -> b) -> (a -> f a) -> a -> b refold = hylo -data instance Prim [a] b = Cons a b | Nil deriving (Eq,Ord,Show,Read)-instance Functor (Prim [a]) where+-- | Base functor of @[]@.+data ListF a b = Nil | Cons a b+ deriving (Eq,Ord,Show,Read,Typeable+#if HAS_GENERIC+ , Generic+#endif+#if HAS_GENERIC1+ , Generic1+#endif+ )++#if EXPLICIT_DICT_FUNCTOR_CLASSES+instance Eq2 ListF where+ liftEq2 _ _ Nil Nil = True+ liftEq2 f g (Cons a b) (Cons a' b') = f a a' && g b b'+ liftEq2 _ _ _ _ = False++instance Eq a => Eq1 (ListF a) where+ liftEq = liftEq2 (==)++instance Ord2 ListF where+ liftCompare2 _ _ Nil Nil = EQ+ liftCompare2 _ _ Nil _ = LT+ liftCompare2 _ _ _ Nil = GT+ liftCompare2 f g (Cons a b) (Cons a' b') = f a a' `mappend` g b b'++instance Ord a => Ord1 (ListF a) where+ liftCompare = liftCompare2 compare++instance Show a => Show1 (ListF a) where+ liftShowsPrec = liftShowsPrec2 showsPrec showList++instance Show2 ListF where+ liftShowsPrec2 _ _ _ _ _ Nil = showString "Nil"+ liftShowsPrec2 sa _ sb _ d (Cons a b) = showParen (d > 10)+ $ showString "Cons "+ . sa 11 a+ . showString " "+ . sb 11 b++instance Read2 ListF where+ liftReadsPrec2 ra _ rb _ d = readParen (d > 10) $ \s -> nil s ++ cons s+ where+ nil s0 = do+ ("Nil", s1) <- lex s0+ return (Nil, s1)+ cons s0 = do+ ("Cons", s1) <- lex s0+ (a, s2) <- ra 11 s1+ (b, s3) <- rb 11 s2+ return (Cons a b, s3)++instance Read a => Read1 (ListF a) where+ liftReadsPrec = liftReadsPrec2 readsPrec readList++#else+instance Eq a => Eq1 (ListF a) where eq1 = (==)+instance Ord a => Ord1 (ListF a) where compare1 = compare+instance Show a => Show1 (ListF a) where showsPrec1 = showsPrec+instance Read a => Read1 (ListF a) where readsPrec1 = readsPrec+#endif++-- These instances cannot be auto-derived on with GHC <= 7.6+instance Functor (ListF a) where+ fmap _ Nil = Nil fmap f (Cons a b) = Cons a (f b)- fmap _ Nil = Nil -type instance Base [a] = Prim [a]-instance Foldable [a] where+instance F.Foldable (ListF a) where+ foldMap _ Nil = Data.Monoid.mempty+ foldMap f (Cons _ b) = f b++instance T.Traversable (ListF a) where+ traverse _ Nil = pure Nil+ traverse f (Cons a b) = Cons a <$> f b++instance Bi.Bifunctor ListF where+ bimap _ _ Nil = Nil+ bimap f g (Cons a b) = Cons (f a) (g b)++instance Bi.Bifoldable ListF where+ bifoldMap _ _ Nil = mempty+ bifoldMap f g (Cons a b) = mappend (f a) (g b)++instance Bi.Bitraversable ListF where+ bitraverse _ _ Nil = pure Nil+ bitraverse f g (Cons a b) = Cons <$> f a <*> g b++type instance Base [a] = ListF a+instance Recursive [a] where project (x:xs) = Cons x xs project [] = Nil para f (x:xs) = f (Cons x (xs, para f xs)) para f [] = f Nil -instance Unfoldable [a] where+instance Corecursive [a] where embed (Cons x xs) = x:xs embed Nil = [] @@ -205,17 +321,17 @@ -- | Example boring stub for non-recursive data types type instance Base (Maybe a) = Const (Maybe a)-instance Foldable (Maybe a) where project = Const-instance Unfoldable (Maybe a) where embed = getConst+instance Recursive (Maybe a) where project = Const+instance Corecursive (Maybe a) where embed = getConst -- | Example boring stub for non-recursive data types type instance Base (Either a b) = Const (Either a b)-instance Foldable (Either a b) where project = Const-instance Unfoldable (Either a b) where embed = getConst+instance Recursive (Either a b) where project = Const+instance Corecursive (Either a b) where embed = getConst -- | A generalized catamorphism gfold, gcata- :: (Foldable t, Comonad w)+ :: (Recursive t, Comonad w) => (forall b. Base t (w b) -> w (Base t b)) -- ^ a distributive law -> (Base t (w a) -> a) -- ^ a (Base t)-w-algebra -> t -- ^ fixed point@@ -229,7 +345,7 @@ -- | A generalized anamorphism gunfold, gana- :: (Unfoldable t, Monad m)+ :: (Corecursive t, Monad m) => (forall b. m (Base t b) -> Base t (m b)) -- ^ a distributive law -> (a -> Base t (m a)) -- ^ a (Base t)-m-coalgebra -> a -- ^ seed@@ -254,7 +370,7 @@ h = fmap f . w . fmap (duplicate . h . join) . m . liftM g grefold w m f g a = ghylo w m f g a -futu :: Unfoldable t => (a -> Base t (Free (Base t) a)) -> a -> t+futu :: Corecursive t => (a -> Base t (Free (Base t) a)) -> a -> t futu = gana distFutu distFutu :: Functor f => Free f (f a) -> f (Free f a)@@ -264,19 +380,36 @@ distGFutu _ (Pure fa) = Pure <$> fa distGFutu k (Free as) = Free <$> k (distGFutu k <$> as) +-------------------------------------------------------------------------------+-- Fix+-------------------------------------------------------------------------------+ newtype Fix f = Fix (f (Fix f)) unfix :: Fix f -> f (Fix f) unfix (Fix f) = f -deriving instance Eq (f (Fix f)) => Eq (Fix f)-deriving instance Ord (f (Fix f)) => Ord (Fix f)-deriving instance Show (f (Fix f)) => Show (Fix f)-deriving instance Read (f (Fix f)) => Read (Fix f)+instance Eq1 f => Eq (Fix f) where+ Fix a == Fix b = eq1 a b +instance Ord1 f => Ord (Fix f) where+ compare (Fix a) (Fix b) = compare1 a b++instance Show1 f => Show (Fix f) where+ showsPrec d (Fix a) =+ showParen (d >= 11)+ $ showString "Fix "+ . showsPrec1 11 a++instance Read1 f => Read (Fix f) where+ readPrec = parens $ prec 10 $ do+ Ident "Fix" <- lexP+ Fix <$> step (readS_to_Prec readsPrec1)+ #ifdef __GLASGOW_HASKELL__-#if MIN_VERSION_base(4,7,0)+#if HAS_POLY_TYPEABLE deriving instance Typeable Fix+deriving instance (Typeable f, Data (f (Fix f))) => Data (Fix f) #else instance Typeable1 f => Typeable (Fix f) where typeOf t = mkTyConApp fixTyCon [typeOf1 (undefined `asArgsTypeOf` t)]@@ -284,9 +417,6 @@ asArgsTypeOf = const fixTyCon :: TyCon-#endif-#if MIN_VERSION_base(4,7,0)-#else #if MIN_VERSION_base(4,4,0) fixTyCon = mkTyCon3 "recursion-schemes" "Data.Functor.Foldable" "Fix" #else@@ -311,48 +441,52 @@ #endif type instance Base (Fix f) = f-instance Functor f => Foldable (Fix f) where+instance Functor f => Recursive (Fix f) where project (Fix a) = a-instance Functor f => Unfoldable (Fix f) where+instance Functor f => Corecursive (Fix f) where embed = Fix -refix :: (Foldable s, Unfoldable t, Base s ~ Base t) => s -> t+refix :: (Recursive s, Corecursive t, Base s ~ Base t) => s -> t refix = cata embed -toFix :: Foldable t => t -> Fix (Base t)+toFix :: Recursive t => t -> Fix (Base t) toFix = refix -fromFix :: Unfoldable t => Fix (Base t) -> t+fromFix :: Corecursive t => Fix (Base t) -> t fromFix = refix +-------------------------------------------------------------------------------+-- Lambek+-------------------------------------------------------------------------------+ -- | Lambek's lemma provides a default definition for 'project' in terms of 'cata' and 'embed'-lambek :: (Foldable t, Unfoldable t) => (t -> Base t t)+lambek :: (Recursive t, Corecursive t) => (t -> Base t t) lambek = cata (fmap embed) -- | The dual of Lambek's lemma, provides a default definition for 'embed' in terms of 'ana' and 'project'-colambek :: (Foldable t, Unfoldable t) => (Base t t -> t)+colambek :: (Recursive t, Corecursive t) => (Base t t -> t) colambek = ana (fmap project) newtype Mu f = Mu (forall a. (f a -> a) -> a) type instance Base (Mu f) = f-instance Functor f => Foldable (Mu f) where+instance Functor f => Recursive (Mu f) where project = lambek cata f (Mu g) = g f-instance Functor f => Unfoldable (Mu f) where+instance Functor f => Corecursive (Mu f) where embed m = Mu (\f -> f (fmap (fold f) m)) -instance (Functor f, Eq (f (Fix f)), Eq (Fix f)) => Eq (Mu f) where+instance (Functor f, Eq1 f) => Eq (Mu f) where (==) = (==) `on` toFix -instance (Functor f, Ord (f (Fix f)), Ord (Fix f)) => Ord (Mu f) where+instance (Functor f, Ord1 f) => Ord (Mu f) where compare = compare `on` toFix -instance (Functor f, Show (f (Fix f)), Show (Fix f)) => Show (Mu f) where+instance (Functor f, Show1 f) => Show (Mu f) where showsPrec d f = showParen (d > 10) $ showString "fromFix " . showsPrec 11 (toFix f) #ifdef __GLASGOW_HASKELL__-instance (Functor f, Read (f (Fix f)), Read (Fix f)) => Read (Mu f) where+instance (Functor f, Read1 f) => Read (Mu f) where readPrec = parens $ prec 10 $ do Ident "fromFix" <- lexP fromFix <$> step readPrec@@ -360,30 +494,30 @@ data Nu f where Nu :: (a -> f a) -> a -> Nu f type instance Base (Nu f) = f-instance Functor f => Unfoldable (Nu f) where+instance Functor f => Corecursive (Nu f) where embed = colambek ana = Nu-instance Functor f => Foldable (Nu f) where+instance Functor f => Recursive (Nu f) where project (Nu f a) = Nu f <$> f a -instance (Functor f, Eq (f (Fix f)), Eq (Fix f)) => Eq (Nu f) where+instance (Functor f, Eq1 f) => Eq (Nu f) where (==) = (==) `on` toFix -instance (Functor f, Ord (f (Fix f)), Ord (Fix f)) => Ord (Nu f) where+instance (Functor f, Ord1 f) => Ord (Nu f) where compare = compare `on` toFix -instance (Functor f, Show (f (Fix f)), Show (Fix f)) => Show (Nu f) where+instance (Functor f, Show1 f) => Show (Nu f) where showsPrec d f = showParen (d > 10) $ showString "fromFix " . showsPrec 11 (toFix f) #ifdef __GLASGOW_HASKELL__-instance (Functor f, Read (f (Fix f)), Read (Fix f)) => Read (Nu f) where+instance (Functor f, Read1 f) => Read (Nu f) where readPrec = parens $ prec 10 $ do Ident "fromFix" <- lexP fromFix <$> step readPrec #endif -zygo :: Foldable t => (Base t b -> b) -> (Base t (b, a) -> a) -> t -> a+zygo :: Recursive t => (Base t b -> b) -> (Base t (b, a) -> a) -> t -> a zygo f = gfold (distZygo f) distZygo@@ -393,7 +527,7 @@ distZygo g m = (g (fmap fst m), fmap snd m) gzygo- :: (Foldable t, Comonad w)+ :: (Recursive t, Comonad w) => (Base t b -> b) -> (forall c. Base t (w c) -> w (Base t c)) -> (Base t (EnvT b w a) -> a)@@ -409,20 +543,28 @@ distZygoT g k fe = EnvT (g (getEnv <$> fe)) (k (lower <$> fe)) where getEnv (EnvT e _) = e -gapo :: Unfoldable t => (b -> Base t b) -> (a -> Base t (Either b a)) -> a -> t+gapo :: Corecursive t => (b -> Base t b) -> (a -> Base t (Either b a)) -> a -> t gapo g = gunfold (distGApo g) -distApo :: Foldable t => Either t (Base t a) -> Base t (Either t a)+distApo :: Recursive t => Either t (Base t a) -> Base t (Either t a) distApo = distGApo project distGApo :: Functor f => (b -> f b) -> Either b (f a) -> f (Either b a) distGApo f = either (fmap Left . f) (fmap Right) +distGApoT+ :: (Functor f, Functor m)+ => (b -> f b)+ -> (forall c. m (f c) -> f (m c))+ -> ExceptT b m (f a)+ -> f (ExceptT b m a)+distGApoT g k = fmap ExceptT . k . fmap (distGApo g) . runExceptT+ -- | Course-of-value iteration-histo :: Foldable t => (Base t (Cofree (Base t) a) -> a) -> t -> a+histo :: Recursive t => (Base t (Cofree (Base t) a) -> a) -> t -> a histo = gcata distHisto -ghisto :: (Foldable t, Functor h) => (forall b. Base t (h b) -> h (Base t b)) -> (Base t (Cofree h a) -> a) -> t -> a+ghisto :: (Recursive t, Functor h) => (forall b. Base t (h b) -> h (Base t b)) -> (Base t (Cofree h a) -> a) -> t -> a ghisto g = gcata (distGHisto g) distHisto :: Functor f => f (Cofree f a) -> Cofree f (f a)@@ -431,9 +573,16 @@ distGHisto :: (Functor f, Functor h) => (forall b. f (h b) -> h (f b)) -> f (Cofree h a) -> Cofree h (f a) distGHisto k = Cofree.unfold (\as -> (extract <$> as, k (Cofree.unwrap <$> as))) --- TODO: futu & chrono, these require Free monads--- TODO: distGApoT, requires EitherT+chrono :: Functor f => (f (Cofree f b) -> b) -> (a -> f (Free f a)) -> (a -> b)+chrono = ghylo distHisto distFutu +gchrono :: (Functor f, Functor w, Functor m) =>+ (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)+gchrono w m = ghylo (distGHisto w) (distGFutu m)+ -- | Mendler-style iteration mcata :: (forall y. (y -> c) -> f y -> c) -> Fix f -> c mcata psi = psi (mcata psi) . unfix@@ -454,10 +603,25 @@ -- -- A corrected and modernized version of <http://www.haskell.org/haskellwiki/Zygohistomorphic_prepromorphisms> zygoHistoPrepro- :: (Unfoldable t, Foldable t)+ :: (Corecursive t, Recursive t) => (Base t b -> b) -> (forall c. Base t c -> Base t c) -> (Base t (EnvT b (Cofree (Base t)) a) -> a) -> t -> a zygoHistoPrepro f g t = gprepro (distZygoT f distHisto) g t++-------------------------------------------------------------------------------+-- Not exposed anywhere+-------------------------------------------------------------------------------++-- | Read a list (using square brackets and commas), given a function+-- for reading elements.+_readListWith :: ReadS a -> ReadS [a]+_readListWith rp =+ readParen False (\r -> [pr | ("[",s) <- lex r, pr <- readl s])+ where+ readl s = [([],t) | ("]",t) <- lex s] +++ [(x:xs,u) | (x,t) <- rp s, (xs,u) <- readl' t]+ readl' s = [([],t) | ("]",t) <- lex s] +++ [(x:xs,v) | (",",t) <- lex s, (x,u) <- rp t, (xs,v) <- readl' u]
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2011-2013 Edward Kmett+Copyright 2011-2015 Edward Kmett All rights reserved.
+ README.markdown view
@@ -0,0 +1,15 @@+recursion-schemes+==========++[](https://hackage.haskell.org/package/recursion-schemes) [](http://travis-ci.org/ekmett/recursion-schemes)++This package includes code for functional programming with bananas, envelopes, lenses, barbed wire and all that.++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett
recursion-schemes.cabal view
@@ -1,6 +1,6 @@ name: recursion-schemes category: Control, Recursion-version: 4.1.2+version: 5 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE@@ -9,12 +9,14 @@ stability: provisional homepage: http://github.com/ekmett/recursion-schemes/ bug-reports: http://github.com/ekmett/recursion-schemes/issues-copyright: Copyright (C) 2008-2013 Edward A. Kmett+copyright: Copyright (C) 2008-2015 Edward A. Kmett synopsis: Generalized bananas, lenses and barbed wire description: Generalized bananas, lenses and barbed wire +tested-with: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.1+ build-type: Simple-extra-source-files: .travis.yml CHANGELOG.markdown+extra-source-files: .travis.yml CHANGELOG.markdown .gitignore README.markdown source-repository head type: git@@ -33,9 +35,14 @@ build-depends: base >= 4 && < 5,- comonad >= 4 && < 5,+ bifunctors >= 4 && < 6,+ comonad >= 4 && < 6, free >= 4 && < 5,- transformers >= 0.2 && < 1+ transformers >= 0.2 && < 1,+ transformers-compat >= 0.3 && < 1++ if impl(ghc < 7.5)+ build-depends: ghc-prim exposed-modules: Data.Functor.Foldable