recursion 0.1.0.1 → 1.0.0.0
raw patch · 4 files changed
+95/−56 lines, 4 filesdep +composition-prelude
Dependencies added: composition-prelude
Files
- CHANGELOG.md +7/−0
- README.md +2/−1
- recursion.cabal +6/−5
- src/Control/Recursion.hs +80/−50
CHANGELOG.md view
@@ -1,5 +1,12 @@ # recursion +## 0.1.1.0++* Add `dicata`+* Add `Mu`+* Add `Nu`+* Move `cata` and `ana` to typeclasses so that they can be shortcut+ ## 0.1.0.1 * Expose `ListF` & constructors
README.md view
@@ -2,6 +2,7 @@ This is heavily inspired by Edward Kmett's [recursion-schemes](http://hackage.haskell.org/package/recursion-schemes)-library. As such, you will find it suitable most places that `recusion-schemes` is.+library, and some code is drawn from it. As such, you will find it+suitable most places that `recusion-schemes` is. It also provides monadic versions of several common recursion schemes.
recursion.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: recursion-version: 0.1.0.1+version: 1.0.0.0 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale@@ -9,7 +9,7 @@ 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 no dependencies+ A performant recursion schemes library for Haskell with minimal dependencies category: Control, Recursion build-type: Simple extra-source-files:@@ -32,11 +32,12 @@ Control.Recursion hs-source-dirs: src default-language: Haskell2010- other-extensions: MultiParamTypeClasses KindSignatures- DeriveFunctor FlexibleInstances FlexibleContexts+ other-extensions: DeriveFunctor FlexibleContexts+ ExistentialQuantification RankNTypes TypeFamilies ghc-options: -Wall build-depends:- base >=4.8 && <5+ base >=4.8 && <5,+ composition-prelude -any if flag(development) ghc-options: -Werror
src/Control/Recursion.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-} module Control.Recursion ( -- * Typeclasses@@ -12,10 +11,10 @@ , Corecursive (..) -- * Types , Fix (..)+ , Mu (..)+ , Nu (..) , ListF (..) -- * Recursion schemes- , cata- , ana , hylo , prepro , postpro@@ -28,6 +27,7 @@ , micro , meta , meta'+ , dicata -- * Mendler-style recursion schemes , mhisto , mcata@@ -40,96 +40,126 @@ , colambek ) where -import Control.Monad ((<=<))-import Numeric.Natural (Natural)+import Control.Arrow ((&&&))+import Control.Composition ((.*), (.**))+import Control.Monad ((<=<))+import Numeric.Natural (Natural) -class Base t (f :: * -> *) where+type family Base t :: * -> * -class (Functor f, Base t f) => Recursive f t where- project :: t -> f t+class (Functor (Base t)) => Recursive t where+ project :: t -> Base t t -class (Functor f, Base t f) => Corecursive f t where- embed :: f t -> t+ -- | Catamorphism. Folds a structure. (see [here](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.41.125&rep=rep1&type=pdf))+ cata :: (Base t a -> a) -> t -> a+ cata f = c where c = f . fmap c . project ++class (Functor (Base t)) => Corecursive t where+ embed :: Base t t -> t++ -- | Anamorphism, meant to build up a structure recursively.+ ana :: (a -> Base t a) -> a -> t+ ana g = a where a = embed . fmap a . g++-- | Base functor for a list of type @[a]@. data ListF a b = Cons a b | Nil deriving (Functor) newtype Fix f = Fix { unFix :: f (Fix f) } -instance Base (Fix t) f where+data Nu f = forall a. Nu (a -> f a) a -instance Base Natural Maybe where+newtype Mu f = Mu (forall a. (f a -> a) -> a) -instance Recursive Maybe Natural where+type instance Base (Fix f) = f++type instance Base (Mu f) = f++type instance Base (Nu f) = f++type instance Base Natural = Maybe++type instance Base [a] = ListF a++instance Recursive Natural where project 0 = Nothing project n = Just (n-1) -instance Corecursive Maybe Natural where+instance Corecursive Natural where embed Nothing = 0 embed (Just n) = n+1 -instance Base b (ListF a) where+instance Functor f => Recursive (Nu f) where+ project (Nu f a) = Nu f <$> f a -instance Recursive (ListF a) [a] where+instance Functor f => Corecursive (Nu f) where+ embed = colambek+ ana = Nu++instance Functor f => Recursive (Mu f) where+ project = lambek+ cata f (Mu g) = g f++instance Functor f => Corecursive (Mu f) where+ embed m = Mu (\f -> f (fmap (cata f) m))++instance Recursive [a] where project [] = Nil project (x:xs) = Cons x xs -instance Corecursive (ListF a) [a] where+instance Corecursive [a] where embed Nil = [] embed (Cons x xs) = x : xs --- | Catamorphism. Folds a structure. (see [here](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.41.125&rep=rep1&type=pdf))-cata :: (Recursive f t) => (f a -> a) -> t -> a-cata f = c where c = f . fmap c . project---- | Anamorphism, meant to build up a structure recursively.-ana :: (Corecursive f t) => (a -> f a) -> a -> t-ana g = a where a = embed . fmap a . g- -- | Hylomorphism; 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 -cataM :: (Recursive f t, Traversable f, Monad m) => (f a -> m a) -> t -> m 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) -anaM :: (Corecursive f t, Traversable f, Monad m) => (a -> m (f a)) -> a -> m t+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 -lambek :: (Recursive f t, Corecursive f t) => (t -> f t)+lambek :: (Recursive t, Corecursive t) => (t -> Base t t) lambek = cata (fmap embed) -colambek :: (Recursive f t, Corecursive f t) => (f t -> t)+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.-prepro :: (Recursive f t, Corecursive f t) => (f t -> f t) -> (f a -> a) -> t -> a+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.-postpro :: (Recursive f t, Corecursive f t) => (f t -> f t) -> (a -> f a) -> a -> t+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.-mutu :: (Recursive f t) => (f (a, a) -> a) -> (f (a, a) -> a) -> t -> a-mutu f g = g . fmap (\x -> (mutu g f x, mutu f g x)) . project+mutu :: (Recursive t) => (Base t (a, a) -> a) -> (Base t (a, a) -> a) -> t -> a+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 .* (&&&))+ -- | Zygomorphism (see [here](http://www.iis.sinica.edu.tw/~scm/pub/mds.pdf) for a neat example)-zygo :: (Recursive f t) => (f b -> b) -> (f (b, a) -> a) -> t -> a-zygo f g = snd . cata (\x -> (f $ fmap fst x, g x))+zygo :: (Recursive t) => (Base t b -> b) -> (Base t (b, a) -> a) -> t -> a+zygo f g = snd . cata (((,) . f . fmap fst) <*> g) -- | Paramorphism-para :: (Recursive f t, Corecursive f t) => (f (t, a) -> a) -> t -> a-para f = snd . cata (\x -> (embed $ fmap fst x, f x))+para :: (Recursive t, Corecursive t) => (Base t (t, a) -> a) -> t -> a+para f = snd . cata (((,) . embed . fmap fst) <*> f) -- | Gibbons' metamorphism. Tear down a structure, transform it, and then build up a new structure-meta :: (Corecursive f t', Recursive g t) => (a -> f a) -> (b -> a) -> (g b -> b) -> t -> t'+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@@ -141,24 +171,24 @@ -- | Mendler's catamorphism mcata :: (forall y. ((y -> c) -> f y -> c)) -> Fix f -> c-mcata psi = psi (mcata psi) . unFix+mcata psi = mc where mc = psi mc . unFix -- | Mendler's histomorphism mhisto :: (forall y. ((y -> c) -> (y -> f y) -> f y -> c)) -> Fix f -> c-mhisto psi = psi (mhisto psi) unFix . unFix+mhisto psi = mh where mh = psi 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 = (id `either` (phi . fmap h)) . psi+elgot phi psi = h where h = either id (phi . fmap h) . psi --- | Anamorphism that allows shortcuts.-micro :: (Corecursive f a) => (b -> Either a (f b)) -> b -> a+-- | Anamorphism allowing shortcuts.+micro :: (Corecursive a) => (b -> Either a (Base a b)) -> b -> a micro = elgot embed -- | Elgot coalgebra coelgot :: Functor f => ((a, f b) -> b) -> (a -> f a) -> a -> b-coelgot phi psi = h where h = phi . (\x -> (x, (fmap h . psi) x))+coelgot phi psi = h where h = phi . ((,) <*> (fmap h . psi)) -- | Apomorphism-apo :: (Corecursive f t) => (a -> f (Either t a)) -> a -> t+apo :: (Corecursive t) => (a -> Base t (Either t a)) -> a -> t apo g = a where a = embed . fmap (either id a) . g