recursion 2.0.0.0 → 2.1.0.0

raw patch · 3 files changed

+111/−62 lines, 3 files

Files

CHANGELOG.md +6/−0
recursion.cabal +30/−29
src/Control/Recursion.hs +75/−33

CHANGELOG.md view

@@ -1,5 +1,11 @@ # recursion +## 2.1.0.0++* Add `scolioM`, `scolioM'`, `paraM`, `microM`, `mutuM`, `mutuM'`, `elgotM`, and+`coelgotM`+* Rename `dicata` to `scolio`+ ## 2.0.0.0  * Add `zygoM'`, the second monadic zygomorphism

recursion.cabal view

@@ -1,39 +1,41 @@-cabal-version:      1.18-name:               recursion-version:            2.0.0.0-license:            BSD3-license-file:       LICENSE-copyright:          Copyright: (c) 2018 Vanessa McHale-maintainer:         vanessa.mchale@iohk.io-author:             Vanessa McHale-bug-reports:        https://hub.darcs.net/vmchale/recursion/issues-synopsis:           A recursion schemes library for GHC.+cabal-version: 1.18+name: recursion+version: 2.1.0.0+license: BSD3+license-file: LICENSE+copyright: Copyright: (c) 2018 Vanessa McHale+maintainer: vanessa.mchale@iohk.io+author: Vanessa McHale+bug-reports: https://hub.darcs.net/vmchale/recursion/issues+synopsis: A recursion schemes library for GHC. description:     A performant recursion schemes library for Haskell with minimal dependencies-category:           Control, Recursion-build-type:         Simple-extra-source-files: cabal.project.local-extra-doc-files:-    README.md-    CHANGELOG.md+category: Control, Recursion+build-type: Simple+extra-source-files:+    cabal.project.local+extra-doc-files: README.md+                 CHANGELOG.md  source-repository head-    type:     darcs+    type: darcs     location: https://hub.darcs.net/vmchale/recursion  flag development-    description: Enable `-Werror`-    default:     False-    manual:      True+    description:+        Enable `-Werror`+    default: False+    manual: True  library-    exposed-modules:  Control.Recursion-    hs-source-dirs:   src+    exposed-modules:+        Control.Recursion+    hs-source-dirs: src     default-language: Haskell2010-    other-extensions:-        DeriveFunctor FlexibleContexts ExistentialQuantification RankNTypes-        TypeFamilies DeriveFoldable DeriveTraversable-    ghc-options:      -Wall+    other-extensions: DeriveFunctor FlexibleContexts+                      ExistentialQuantification RankNTypes TypeFamilies DeriveFoldable+                      DeriveTraversable+    ghc-options: -Wall     build-depends:         base >=4.9 && <5,         composition-prelude -any@@ -42,9 +44,8 @@         ghc-options: -Werror      if impl(ghc >=8.0)-        ghc-options:-            -Wincomplete-uni-patterns -Wincomplete-record-updates-            -Wredundant-constraints -Wnoncanonical-monad-instances+        ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates+                     -Wredundant-constraints -Wnoncanonical-monad-instances      if impl(ghc >=8.4)         ghc-options: -Wmissing-export-lists

src/Control/Recursion.hs view

@@ -30,7 +30,7 @@     , micro     , meta     , meta'-    , dicata+    , scolio     , cata     , ana     -- * Mendler-style recursion schemes@@ -42,6 +42,14 @@     , hyloM     , zygoM     , zygoM'+    , scolioM+    , scolioM'+    , coelgotM+    , elgotM+    , paraM+    , mutuM+    , mutuM'+    , microM     -- * Helper functions     , lambek     , colambek@@ -86,6 +94,7 @@  newtype Fix f = Fix { unFix :: f (Fix f) } +-- Ν, Μ data Nu f = forall a. Nu (a -> f a) a  newtype Mu f = Mu (forall a. (f a -> a) -> a)@@ -146,7 +155,10 @@ instance Functor f => Corecursive (Fix f) where     embed = Fix --- | Catamorphism. Folds a structure. (see [here](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.41.125&rep=rep1&type=pdf))+eitherM :: Monad m => (a -> m c) -> (b -> m c) -> m (Either a b) -> m c+eitherM l r = (either l r =<<)++-- | Catamorφsm. Folds a structure. (see [here](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.41.125&rep=rep1&type=pdf)) cata :: (Recursive t) => (Base t a -> a) -> t -> a cata f = c where c = f . fmap c . project {-# NOINLINE [0] cata #-}@@ -155,7 +167,7 @@   "cata/Mu" forall f (g :: forall a. (f a -> a) -> a). cata f (Mu g) = g f;      #-} --- | Anamorphism, meant to build up a structure recursively.+-- | Anamorφsm, meant to build up a structure recursively. ana :: (Corecursive t) => (a -> Base t a) -> a -> t ana g = a where a = embed . fmap a . g {-# NOINLINE [0] ana #-}@@ -165,7 +177,7 @@       #-}  -- | Base functor for a list of type @[a]@.--- | Hylomorphism; fold a structure while buildiung it up.+-- | Hylomorφsm; fold a structure while buildiung it up. hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b hylo f g = h where h = f . fmap h . g {-# NOINLINE [0] hylo #-}@@ -174,85 +186,115 @@   "ana/cata/hylo"  forall f g x. cata f (ana g x) = hylo f g x;      #-} +zipA :: (Applicative f) => f a -> f b -> f (a, b)+zipA x y = (,) <$> x <*> y++zipM :: (Monad m) => m a -> m b -> m (a, b)+zipM x y = do { a <- y; b <- x; pure (b, a) }+ cataM :: (Recursive t, Traversable (Base t), Monad m) => (Base t a -> m a) -> t -> m a cataM f = c where c = f <=< (traverse c . project) +paraM :: (Recursive t, Corecursive t, Traversable (Base t), Monad m) => (Base t (t, a) -> m a) -> t -> m a+paraM f = fmap snd . cataM (\x -> (,) (embed (fmap fst x)) <$> f x)+ zygoM :: (Recursive t, Traversable (Base t), Monad m) => (Base t b -> m b) -> (Base t (b, a) -> m a) -> t -> m a-zygoM f g = fmap snd . cataM (\x -> (,) <$> f (fmap fst x) <*> g x)+zygoM f g = fmap snd . cataM (\x -> zipA (f (fmap fst x)) (g x))  zygoM' :: (Recursive t, Traversable (Base t), Monad m) => (Base t b -> m b) -> (Base t (b, a) -> m a) -> t -> m a-zygoM' f g = fmap snd . cataM (\x -> do { a <- g x; b <- f (fmap fst x); pure (b, a) })+zygoM' f g = fmap snd . cataM (\x -> zipM (f (fmap fst x)) (g x)) +scolioM :: (Recursive t, Traversable (Base t), Monad m) => (Base t (t, a) -> m t) -> (Base t (t, a) -> m a) -> t -> m a+scolioM f g = fmap snd . cataM (\x -> zipA (f x) (g x))++scolioM' :: (Recursive t, Traversable (Base t), Monad m) => (Base t (t, a) -> m t) -> (Base t (t, a) -> m a) -> t -> m a+scolioM' f g = fmap snd . cataM (\x -> zipM (f x) (g x))+ anaM :: (Corecursive t, Traversable (Base t), Monad m) => (a -> m (Base t a)) -> a -> m t anaM f = a where a = (fmap embed . traverse a) <=< f  hyloM :: (Traversable f, Monad m) => (f b -> m b) -> (a -> m (f a)) -> a -> m b hyloM f g = h where h = f <=< traverse h <=< g +elgotM :: (Traversable f, Monad m) => (f a -> m a) -> (b -> m (Either a (f b))) -> b -> m a+elgotM φ ψ = h where h = eitherM pure (φ <=< traverse h) . ψ++microM :: (Corecursive a, Traversable (Base a), Monad m) => (b -> m (Either a (Base a b))) -> b -> m a+microM = elgotM (pure . embed)++coelgotM :: (Traversable f, Monad m) => ((a, f b) -> m b) -> (a -> m (f a)) -> a -> m b+coelgotM φ ψ = h where h = φ <=< (\x -> (,) x <$> (traverse h <=< ψ) x)+ lambek :: (Recursive t, Corecursive t) => (t -> Base t t) lambek = cata (fmap embed)  colambek :: (Recursive t, Corecursive t) => (Base t t -> t) colambek = ana (fmap project) --- | Prepromorphism. Fold a structure while applying a natural transformation at each step.+-- | Prepromorφsm. Fold a structure while applying a natural transformation at each step. prepro :: (Recursive t, Corecursive t) => (Base t t -> Base t t) -> (Base t a -> a) -> t -> a prepro e f = c     where c = f . fmap (c . cata (embed . e)) . project --- | Postpromorphism. Build up a structure, applying a natural transformation along the way.+-- | Postpromorφsm. Build up a structure, applying a natural transformation along the way. postpro :: (Recursive t, Corecursive t) => (Base t t -> Base t t) -> (a -> Base t a) -> a -> t postpro e g = a'     where a' = embed . fmap (ana (e . project) . a') . g --- | A mutumorphism.+-- | A mutumorφsm. mutu :: (Recursive t) => (Base t (a, a) -> a) -> (Base t (a, a) -> a) -> t -> a-mutu f g =  snd . cata (f &&& g)+mutu f g = snd . cata (f &&& g) --- | Catamorphism collapsing along two data types simultaneously. Basically a fancy zygomorphism.-dicata :: (Recursive t) => (Base t (a, t) -> a) -> (Base t (a, t) -> t) -> t -> a-dicata = fst .** (cata .* (&&&))+mutuM :: (Recursive t, Traversable (Base t), Monad m) => (Base t (a, a) -> m a) -> (Base t (a, a) -> m a) -> t -> m a+mutuM f g = h where h = fmap snd . cataM (\x -> zipA (f x) (g x)) --- | Zygomorphism (see [here](http://www.iis.sinica.edu.tw/~scm/pub/mds.pdf) for a neat example)+mutuM' :: (Recursive t, Traversable (Base t), Monad m) => (Base t (a, a) -> m a) -> (Base t (a, a) -> m a) -> t -> m a+mutuM' f g = h where h = fmap snd . cataM (\x -> zipM (f x) (g x))++-- | Catamorφsm collaψng along two data types simultaneously.+scolio :: (Recursive t) => (Base t (a, t) -> a) -> (Base t (a, t) -> t) -> t -> a+scolio = fst .** (cata .* (&&&))++-- | Zygomorφsm (see [here](http://www.iis.sinica.edu.tw/~scm/pub/mds.pdf) for a neat example) zygo :: (Recursive t) => (Base t b -> b) -> (Base t (b, a) -> a) -> t -> a-zygo f g = snd . cata (((,) . f . fmap fst) <*> g)+zygo f g = snd . cata (\x -> (f (fmap fst x), g x)) --- | Paramorphism+-- | Paramorφsm para :: (Recursive t, Corecursive t) => (Base t (t, a) -> a) -> t -> a-para f = snd . cata (((,) . embed . fmap fst) <*> f)+para f = snd . cata (\x -> (embed (fmap fst x), f x)) --- | Gibbons' metamorphism. Tear down a structure, transform it, and then build up a new structure+-- | Gibbons' metamorφsm. Tear down a structure, transform it, and then build up a new structure meta :: (Corecursive t', Recursive t) => (a -> Base t' a) -> (b -> a) -> (Base t b -> b) -> t -> t' meta f e g = ana f . e . cata g --- | Erwig's metamorphism. Essentially a hylomorphism with a natural+-- | Erwig's metamorφsm. Essentially a hylomorφsm with a natural -- transformation in between. This allows us to use more than one functor in a--- hylomorphism.+-- hylomorφsm. meta' :: (Functor g) => (f a -> a) -> (forall c. g c -> f c) -> (b -> g b) -> b -> a meta' h e k = g     where g = h . e . fmap g . k --- | Mendler's catamorphism+-- | Mendler's catamorφsm mcata :: (forall y. ((y -> c) -> f y -> c)) -> Fix f -> c-mcata psi = mc where mc = psi mc . unFix+mcata ψ = mc where mc = ψ mc . unFix --- | Mendler's histomorphism+-- | Mendler's histomorφsm mhisto :: (forall y. ((y -> c) -> (y -> f y) -> f y -> c)) -> Fix f -> c-mhisto psi = mh where mh = psi mh unFix . unFix+mhisto ψ = mh where mh = ψ mh unFix . unFix  -- | Elgot algebra (see [this paper](https://arxiv.org/abs/cs/0609040)) elgot :: Functor f => (f a -> a) -> (b -> Either a (f b)) -> b -> a-elgot phi psi = h where h = either id (phi . fmap h) . psi+elgot φ ψ = h where h = either id (φ . fmap h) . ψ --- | Anamorphism allowing shortcuts. Compare 'apo'+-- | Anamorφsm allowing shortcuts. Compare 'apo' micro :: (Corecursive a) => (b -> Either a (Base a b)) -> b -> a micro = elgot embed --- | Elgot coalgebra+-- | Co-(Elgot algebra) coelgot :: Functor f => ((a, f b) -> b) -> (a -> f a) -> a -> b-coelgot phi psi = h where h = phi . ((,) <*> (fmap h . psi))+coelgot φ ψ = h where h = φ . (\x -> (x, fmap h . ψ $ x)) --- | Apomorphism. Compare 'micro'.+-- | Apomorφsm. Compare 'micro'. apo :: (Corecursive t) => (a -> Base t (Either t a)) -> a -> t apo g = a where a = embed . fmap (either id a) . g @@ -264,17 +306,17 @@ {-# NOINLINE [0] hoist #-}  hoistMu :: (forall a. f a -> g a) -> Mu f -> Mu g-hoistMu eta (Mu f) = Mu (f . (. eta))+hoistMu η (Mu f) = Mu (f . (. η))  hoistNu :: (forall a. f a -> g a) -> Nu f -> Nu g-hoistNu n (Nu f x) = Nu (n . f) x+hoistNu ν (Nu f x) = Nu (ν . f) x  {-# RULES-  "hoist/hoistMu" forall (eta :: forall a. f a -> f a) (f :: forall a. (f a -> a) -> a). hoist eta (Mu f) = hoistMu eta (Mu f);+  "hoist/hoistMu" forall (η :: forall a. f a -> f a) (f :: forall a. (f a -> a) -> a). hoist η (Mu f) = hoistMu η (Mu f);      #-}  {-# RULES-  "hoist/hoistNu" forall (eta :: forall a. f a -> f a) (f :: a -> f a) x. hoist eta (Nu f x) = hoistNu eta (Nu f x);+  "hoist/hoistNu" forall (η :: forall a. f a -> f a) (f :: a -> f a) x. hoist η (Nu f x) = hoistNu η (Nu f x);      #-}  refix :: (Recursive s, Corecursive t, Base s ~ Base t) => s -> t