recursion-schemes 5.0.3 → 5.1
raw patch · 6 files changed
+158/−74 lines, 6 filesdep ~template-haskellnew-uploader
Dependency ranges changed: template-haskell
Files
- .travis.yml +18/−18
- CHANGELOG.markdown +7/−0
- Data/Functor/Base.hs +3/−12
- Data/Functor/Foldable.hs +92/−37
- include/recursion-schemes-common.h +28/−0
- recursion-schemes.cabal +10/−7
.travis.yml view
@@ -2,7 +2,7 @@ # # runghc make_travis_yml_2.hs '-o' '.travis.yml' '--ghc-head' '--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench' '--no-unconstrained' 'cabal.project' #-# For more information, see https://github.com/hvr/multi-ghc-travis+# For more information, see https://github.com/haskell-CI/haskell-ci # language: c sudo: false@@ -36,37 +36,36 @@ matrix: include:- - compiler: "ghc-8.6.1"- env: GHCHEAD=true- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.6.1], sources: [hvr-ghc]}}- - compiler: "ghc-8.4.3"+ - compiler: "ghc-8.6.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.3], sources: [hvr-ghc]}}+ - compiler: "ghc-8.4.4"+ # env: TEST=--disable-tests BENCH=--disable-benchmarks+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}} - compiler: "ghc-8.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}}+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}} - compiler: "ghc-8.0.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}}+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}} - compiler: "ghc-7.10.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}}+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.10.3], sources: [hvr-ghc]}} - compiler: "ghc-7.8.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}}+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.8.4], sources: [hvr-ghc]}} - compiler: "ghc-7.6.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.6.3], sources: [hvr-ghc]}}+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.6.3], sources: [hvr-ghc]}} - compiler: "ghc-7.4.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.4.2], sources: [hvr-ghc]}}+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.4.2], sources: [hvr-ghc]}} - compiler: "ghc-head" env: GHCHEAD=true addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}} allow_failures: - compiler: "ghc-head"- - compiler: "ghc-8.6.1" before_install: - HC=${CC}@@ -110,8 +109,9 @@ fi - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - "printf 'packages: \".\"\\n' > cabal.project"+ - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" - touch cabal.project.local- - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"+ - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- recursion-schemes | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then@@ -126,13 +126,14 @@ # any command which exits with a non-zero exit code causes the build to fail. script: # test that source-distributions can be generated- - (cd "." && cabal sdist)- - mv "."/dist/recursion-schemes-*.tar.gz ${DISTDIR}/+ - cabal new-sdist all+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - "printf 'packages: recursion-schemes-*/*.cabal\\n' > cabal.project"+ - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" - touch cabal.project.local- - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"+ - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- recursion-schemes | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi" - cat cabal.project || true - cat cabal.project.local || true @@ -144,7 +145,6 @@ - (cd recursion-schemes-* && cabal check) # haddock- - rm -rf ./dist-newstyle - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi # REGENDATA ["-o",".travis.yml","--ghc-head","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-unconstrained","cabal.project"]
CHANGELOG.markdown view
@@ -1,3 +1,10 @@+## 5.1+* Export gfutu+* `distGHisto`, `ghisto`, and `gchrono` now use `Cofree (Base t)`+* `distGFutu`, `gfutu`, and `gchrono` now use `Free (Base t)`+* Add `hoist`, `hoistMu` and `hoistNu`+* Add `transverse` and `cataA`+ ## 5.0.3 [2018.07.01] * Make the Template Haskell machinery look through type synonyms. * Avoid incurring some dependencies when using recent GHCs.
Data/Functor/Base.hs view
@@ -1,14 +1,5 @@ {-# LANGUAGE CPP #-}---- See Data.Functor.Foldable for explanation-#ifndef MIN_VERSION_transformers_compat-#define MIN_VERSION_transformers_compat(x,y,z) 0-#endif--#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)+#include "recursion-schemes-common.h" #ifdef __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable #-}@@ -37,7 +28,7 @@ import Data.Functor.Classes ( Eq1(..), Ord1(..), Show1(..), Read1(..)-#if EXPLICIT_DICT_FUNCTOR_CLASSES+#ifdef LIFTED_FUNCTOR_CLASSES , Eq2(..), Ord2(..), Show2(..), Read2(..) #endif )@@ -62,7 +53,7 @@ #endif ) -#if EXPLICIT_DICT_FUNCTOR_CLASSES+#ifdef LIFTED_FUNCTOR_CLASSES instance Eq2 NonEmptyF where liftEq2 f g (NonEmptyF a mb) (NonEmptyF a' mb') = f a a' && liftEq g mb mb'
Data/Functor/Foldable.hs view
@@ -1,22 +1,5 @@ {-# 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------ We don't always depend on transformers-compat, so we need a shim for its version check.-#ifndef MIN_VERSION_transformers_compat-#define MIN_VERSION_transformers_compat(x,y,z) 0-#endif--#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)+#include "recursion-schemes-common.h" #ifdef __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable #-}@@ -28,8 +11,6 @@ #endif #endif -- ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2008-2015 Edward Kmett@@ -47,8 +28,8 @@ , ListF(..) -- * Fixed points , Fix(..), unfix- , Mu(..)- , Nu(..)+ , Mu(..), hoistMu+ , Nu(..), hoistNu -- * Folding , Recursive(..) -- ** Combinators@@ -59,6 +40,7 @@ , histo , ghisto , futu+ , gfutu , chrono , gchrono -- ** Distributive laws@@ -84,6 +66,7 @@ , hylo , ghylo -- ** Changing representation+ , hoist , refix -- * Common names , fold, gfold@@ -97,6 +80,9 @@ , coelgot -- * Zygohistomorphic prepromorphisms , zygoHistoPrepro+ -- * Effectful combinators+ , cataA+ , transverse ) where import Control.Applicative@@ -171,7 +157,7 @@ -> (Base t a -> a) -> t -> a- prepro e f = c where c = f . fmap (c . cata (embed . e)) . project+ prepro e f = c where c = f . fmap (c . hoist e) . project --- | A generalized prepromorphism gprepro@@ -181,7 +167,7 @@ -> (Base t (w a) -> a) -> t -> a- gprepro k e f = extract . c where c = fmap f . k . fmap (duplicate . c . cata (embed . e)) . project+ gprepro k e f = extract . c where c = fmap f . k . fmap (duplicate . c . hoist e) . project distPara :: Corecursive t => Base t (t, a) -> (t, Base t a) distPara = distZygo embed@@ -207,7 +193,7 @@ -> (a -> Base t a) -- a (Base t)-coalgebra -> a -- seed -> t- postpro e g = a where a = embed . fmap (ana (e . project) . a) . g+ postpro e g = a where a = embed . fmap (hoist e . a) . g -- | A generalized postpromorphism gpostpro@@ -217,7 +203,7 @@ -> (a -> Base t (m a)) -- a (Base t)-m-coalgebra -> a -- seed -> t- gpostpro k e g = a . return where a = embed . fmap (ana (e . project) . a . join) . k . liftM g+ gpostpro k e g = a . return where a = embed . fmap (hoist e . a . join) . k . liftM g hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b hylo f g = h where h = f . fmap h . g@@ -242,7 +228,7 @@ #endif ) -#if EXPLICIT_DICT_FUNCTOR_CLASSES+#ifdef LIFTED_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'@@ -448,12 +434,18 @@ futu :: Corecursive t => (a -> Base t (Free (Base t) a)) -> a -> t futu = gana distFutu +gfutu :: (Corecursive t, Functor m, Monad m) => (forall b. m (Base t b) -> Base t (m b)) -> (a -> Base t (FreeT (Base t) m a)) -> a -> t+gfutu g = gana (distGFutu g)+ distFutu :: Functor f => Free f (f a) -> f (Free f a)-distFutu = distGFutu id+distFutu (Pure fx) = Pure <$> fx+distFutu (Free ff) = Free . distFutu <$> ff -distGFutu :: (Functor f, Functor h) => (forall b. h (f b) -> f (h b)) -> Free h (f a) -> f (Free h a)-distGFutu _ (Pure fa) = Pure <$> fa-distGFutu k (Free as) = Free <$> k (distGFutu k <$> as)+distGFutu :: (Functor f, Functor h) => (forall b. h (f b) -> f (h b)) -> FreeT f h (f a) -> f (FreeT f h a)+distGFutu k = d where+ d = fmap FreeT . k . fmap d' . runFreeT+ d' (CMTF.Pure ff) = CMTF.Pure <$> ff+ d' (CMTF.Free ff) = CMTF.Free . d <$> ff ------------------------------------------------------------------------------- -- Fix@@ -521,6 +513,10 @@ instance Functor f => Corecursive (Fix f) where embed = Fix +hoist :: (Recursive s, Corecursive t)+ => (forall a. Base s a -> Base t a) -> s -> t+hoist n = cata (embed . n)+ refix :: (Recursive s, Corecursive t, Base s ~ Base t) => s -> t refix = cata embed @@ -530,6 +526,7 @@ fromFix :: Corecursive t => Fix (Base t) -> t fromFix = refix + ------------------------------------------------------------------------------- -- Lambek -------------------------------------------------------------------------------@@ -567,6 +564,11 @@ fromFix <$> step readPrec #endif +-- | A specialized, faster version of 'hoist' for 'Mu'.+hoistMu :: (forall a. f a -> g a) -> Mu f -> Mu g+hoistMu n (Mu mk) = Mu $ \roll -> mk (roll . n)++ -- | Church encoded free monads are Recursive/Corecursive, in the same way that -- 'Mu' is. type instance Base (CMFC.F f a) = FreeF f a@@ -579,6 +581,7 @@ embed (CMTF.Pure a) = CMFC.F $ \p _ -> p a embed (CMTF.Free fr) = CMFC.F $ \p f -> f $ fmap (cmfcCata p f) fr + data Nu f where Nu :: (a -> f a) -> a -> Nu f type instance Base (Nu f) = f instance Functor f => Corecursive (Nu f) where@@ -604,6 +607,11 @@ fromFix <$> step readPrec #endif +-- | A specialized, faster version of 'hoist' for 'Nu'.+hoistNu :: (forall a. f a -> g a) -> Nu f -> Nu g+hoistNu n (Nu next seed) = Nu (n . next) seed++ zygo :: Recursive t => (Base t b -> b) -> (Base t (b, a) -> a) -> t -> a zygo f = gfold (distZygo f) @@ -651,22 +659,22 @@ histo :: Recursive t => (Base t (Cofree (Base t) a) -> a) -> t -> a histo = gcata distHisto -ghisto :: (Recursive t, Functor h) => (forall b. Base t (h b) -> h (Base t b)) -> (Base t (Cofree h a) -> a) -> t -> a+ghisto :: (Recursive t, Comonad w) => (forall b. Base t (w b) -> w (Base t b)) -> (Base t (CofreeT (Base t) w a) -> a) -> t -> a ghisto g = gcata (distGHisto g) distHisto :: Functor f => f (Cofree f a) -> Cofree f (f a)-distHisto = distGHisto id+distHisto fc = fmap extract fc :< fmap (distHisto . Cofree.unwrap) fc -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)))+distGHisto :: (Functor f, Functor h) => (forall b. f (h b) -> h (f b)) -> f (CofreeT f h a) -> CofreeT f h (f a)+distGHisto k = d where d = CofreeT . fmap (\fc -> fmap CCTC.headF fc CCTC.:< fmap (d . CCTC.tailF) fc) . k . fmap runCofreeT 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) =>+gchrono :: (Functor f, Functor w, Functor m, Comonad w, Monad 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)) ->+ (f (CofreeT f w b) -> b) -> (a -> f (FreeT f m a)) -> (a -> b) gchrono w m = ghylo (distGHisto w) (distGFutu m) @@ -697,6 +705,53 @@ -> t -> a zygoHistoPrepro f g t = gprepro (distZygoT f distHisto) g t++-------------------------------------------------------------------------------+-- Effectful combinators+-------------------------------------------------------------------------------++-- | Effectful |fold|.+--+-- This is a type specialisation of 'cata'.+--+-- An example terminating a recursion immediately:+--+-- >>> cataA (\alg -> case alg of { Nil -> pure (); Cons a _ -> Const [a] }) "hello"+-- Const "h"+--+cataA :: (Recursive t) => (Base t (f a) -> f a) -> t -> f a+cataA = cata++-- | An effectful version of 'hoist'.+--+-- Properties:+--+-- @+-- 'transverse' 'sequenceA' = 'pure'+-- @+--+-- Examples:+--+-- The weird type of first argument allows user to decide+-- an order of sequencing:+--+-- >>> transverse (\x -> print (void x) *> sequence x) "foo" :: IO String+-- Cons 'f' ()+-- Cons 'o' ()+-- Cons 'o' ()+-- Nil+-- "foo"+--+-- >>> transverse (\x -> sequence x <* print (void x)) "foo" :: IO String+-- Nil+-- Cons 'o' ()+-- Cons 'o' ()+-- Cons 'f' ()+-- "foo"+--+transverse :: (Recursive s, Corecursive t, Functor f)+ => (forall a. Base s (f a) -> f (Base t a)) -> s -> f t+transverse n = cata (fmap embed . n) ------------------------------------------------------------------------------- -- Not exposed anywhere
+ include/recursion-schemes-common.h view
@@ -0,0 +1,28 @@+#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif++#ifndef MIN_VERSION_transformers+#define MIN_VERSION_tarnsformers(x,y,z) 1+#endif++#ifndef MIN_VERSION_transformers_compat+#define MIN_VERSION_transformers_compat(x,y,z) 0+#endif+++#if MIN_VERSION_base(4,9,0)+#define LIFTED_FUNCTOR_CLASSES 1++#elif MIN_VERSION_transformers(0,5,0)+#define LIFTED_FUNCTOR_CLASSES 1++#elif MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)+#define LIFTED_FUNCTOR_CLASSES 1+#endif+++#define HAS_GENERIC (__GLASGOW_HASKELL__ >= 702)+#define HAS_GENERIC1 (__GLASGOW_HASKELL__ >= 706)++#define HAS_POLY_TYPEABLE MIN_VERSION_base(4,7,0)
recursion-schemes.cabal view
@@ -1,6 +1,6 @@ name: recursion-schemes category: Control, Recursion-version: 5.0.3+version: 5.1 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -16,10 +16,10 @@ "Generalized bananas, lenses and barbed wire" by Erik Meijer, Maarten Fokkinga and Ross Paterson. -tested-with: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1+tested-with: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.3 build-type: Simple-extra-source-files: .travis.yml CHANGELOG.markdown .gitignore README.markdown+extra-source-files: .travis.yml CHANGELOG.markdown .gitignore README.markdown include/recursion-schemes-common.h source-repository head type: git@@ -41,6 +41,9 @@ StandaloneDeriving UndecidableInstances + include-dirs: include+ -- includes: recursion-schemes-common.h+ build-depends: base >= 4.5 && < 5, comonad >= 4 && < 6,@@ -76,9 +79,9 @@ if flag(template-haskell) build-depends:- template-haskell >= 2.5.0.0 && < 2.14,- base-orphans >= 0.5.4 && < 0.8,- th-abstraction >= 0.2.4 && < 1+ template-haskell >= 2.5.0.0 && < 2.15,+ base-orphans >= 0.5.4 && < 0.9,+ th-abstraction >= 0.2.4 && < 0.3 exposed-modules: Data.Functor.Foldable.TH @@ -96,5 +99,5 @@ base, HUnit <1.7, recursion-schemes,- template-haskell >= 2.5.0.0 && < 2.14,+ template-haskell, transformers >= 0.2 && < 1