yaya 0.2.1.2 → 0.3.0.0
raw patch · 10 files changed
+205/−218 lines, 10 files
Files
- CHANGELOG.md +8/−0
- src/Yaya/Applied.hs +24/−24
- src/Yaya/Experimental/Foldable.hs +5/−5
- src/Yaya/Fold.hs +110/−114
- src/Yaya/Fold/Common.hs +2/−5
- src/Yaya/Fold/Native.hs +12/−10
- src/Yaya/Functor.hs +2/−2
- src/Yaya/Pattern.hs +0/−15
- src/Yaya/Zoo.hs +40/−42
- yaya.cabal +2/−1
CHANGELOG.md view
@@ -4,6 +4,14 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## 0.3.0.0 – 2020–05–14+### Changed+- introduced minimal poly-kinding of type classes++## 0.2.1.3 – 2020–05–14+### Changed+- enabled and fixed warnings+ ## 0.2.1.2 – 2019–11–08 ### Changed - improved documentation
src/Yaya/Applied.hs view
@@ -7,96 +7,96 @@ import Yaya.Fold.Common import Yaya.Pattern -now :: Steppable t (Either a) => a -> t+now :: Steppable (->) t (Either a) => a -> t now = embed . Left -- | This will collapse all the intermediate steps to get to the value that must -- exist at the end.-runToEnd :: Recursive t (Either a) => t -> a+runToEnd :: Recursive (->) t (Either a) => t -> a runToEnd = cata fromEither -- | Converts exceptional divergence to non-termination.-fromMaybe :: (Steppable t (Either a), Corecursive t (Either a)) => Maybe a -> t+fromMaybe :: (Steppable (->) t (Either a), Corecursive (->) t (Either a)) => Maybe a -> t fromMaybe = maybe (ana (toRight . never) ()) now type Void = Mu Identity -absurd :: Recursive t Identity => t -> a+absurd :: Recursive (->) t Identity => t -> a absurd = cata runIdentity -vacuous :: (Functor f, Recursive t Identity) => f t -> f a+vacuous :: (Functor f, Recursive (->) t Identity) => f t -> f a vacuous = fmap absurd -zeroN :: Steppable t Maybe => t+zeroN :: Steppable (->) t Maybe => t zeroN = embed Nothing -succN :: Steppable t Maybe => t -> t+succN :: Steppable (->) t Maybe => t -> t succN = embed . Just -height :: (Foldable f, Steppable n Maybe, Ord n) => f n -> n+height :: (Foldable f, Steppable (->) n Maybe, Ord n) => f n -> n height = foldr (max . succN) zeroN -naturals :: (Steppable n Maybe, Corecursive t ((,) n)) => t+naturals :: (Steppable (->) n Maybe, Corecursive (->) t ((,) n)) => t naturals = ana (unarySequence succN) zeroN -- | Extracts _no more than_ @n@ elements from the possibly-infinite sequence -- @s@. takeUpTo- :: (Recursive n Maybe, Projectable s (XNor a), Steppable l (XNor a))+ :: (Recursive (->) n Maybe, Projectable (->) s (XNor a), Steppable (->) l (XNor a)) => n -> s -> l takeUpTo = cata (lowerDay (embed . takeAvailable)) -- | Extracts _exactly_ @n@ elements from the infinite stream @s@. take- :: (Recursive n Maybe, Projectable s ((,) a), Steppable l (XNor a))+ :: (Recursive (->) n Maybe, Projectable (->) s ((,) a), Steppable (->) l (XNor a)) => n -> s -> l take = cata (lowerDay (embed . takeAnother)) -- | Turns part of a structure inductive, so it can be analyzed, without forcing -- the entire tree. maybeReify- :: (Projectable s f, Steppable l (FreeF f s), Functor f)- => Algebra Maybe (s -> l)+ :: (Projectable (->) s f, Steppable (->) l (FreeF f s), Functor f)+ => Algebra (->) Maybe (s -> l) maybeReify Nothing = embed . Pure maybeReify (Just f) = embed . Free . fmap f . project reifyUpTo- :: (Recursive n Maybe, Projectable s f, Steppable l (FreeF f s), Functor f)+ :: (Recursive (->) n Maybe, Projectable (->) s f, Steppable (->) l (FreeF f s), Functor f) => n -> s -> l reifyUpTo = cata maybeReify -fibonacciPolynomials :: (Integral i, Corecursive t ((,) i)) => i -> t+fibonacciPolynomials :: (Integral i, Corecursive (->) t ((,) i)) => i -> t fibonacciPolynomials x = lucasSequenceU x (-1) -fibonacci :: Corecursive t ((,) Int) => t+fibonacci :: Corecursive (->) t ((,) Int) => t fibonacci = fibonacciPolynomials 1 -lucasSequenceU :: (Integral i, Corecursive t ((,) i)) => i -> i -> t+lucasSequenceU :: (Integral i, Corecursive (->) t ((,) i)) => i -> i -> t lucasSequenceU p q = lucasSequence' p q `ana` (0, 1) -lucasSequenceV :: (Integral i, Corecursive t ((,) i)) => i -> i -> t+lucasSequenceV :: (Integral i, Corecursive (->) t ((,) i)) => i -> i -> t lucasSequenceV p q = lucasSequence' p q `ana` (2, p) -lucas :: Integral i => Corecursive t ((,) i) => t+lucas :: Integral i => Corecursive (->) t ((,) i) => t lucas = lucasSequenceV 1 (-1) -pell :: (Integral i, Corecursive t ((,) i)) => t+pell :: (Integral i, Corecursive (->) t ((,) i)) => t pell = lucasSequenceU 2 (-1) -jacobsthal :: (Integral i, Corecursive t ((,) i)) => t+jacobsthal :: (Integral i, Corecursive (->) t ((,) i)) => t jacobsthal = lucasSequenceU 1 (-2) -mersenne :: (Integral i, Corecursive t ((,) i)) => t+mersenne :: (Integral i, Corecursive (->) t ((,) i)) => t mersenne = lucasSequenceU 3 2 -- | Creates an infinite stream of the provided value.-constantly :: Corecursive t ((,) a) => a -> t+constantly :: Corecursive (->) t ((,) a) => a -> t constantly = ana split -- | Lops off the branches of the tree below a certain depth, turning a -- potentially-infinite structure into a finite one. Like a generalized -- `Yaya.Applied.take`. truncate- :: (Recursive n Maybe, Projectable t f, Steppable u (FreeF f ()), Functor f)+ :: (Recursive (->) n Maybe, Projectable (->) t f, Steppable (->) u (FreeF f ()), Functor f) => n -> t -> u truncate = cata (lowerDay (embed . truncate'))
src/Yaya/Experimental/Foldable.hs view
@@ -12,7 +12,7 @@ import Yaya.Fold.Common import Yaya.Pattern -foldMap :: (Recursive t (XNor a), Monoid m) => (a -> m) -> t -> m+foldMap :: (Recursive (->) t (XNor a), Monoid m) => (a -> m) -> t -> m foldMap = cata . lowerMonoid -- | This class represents the ability of a structure to be converted to a@@ -21,16 +21,16 @@ -- specialized to lists. class Listable f where naturalList :: f a b -> Free (XNor a) b- -- toColist :: (Projectable t (f a), Corecursive u (XNor a)) => t -> u+ -- toColist :: (Projectable t (f a), Corecursive (->) u (XNor a)) => t -> u -- toColist = elgotAna seqFree (naturalList . project)- -- toList :: (Recursive t (f a), Steppable u (XNor a)) => t -> u+ -- toList :: (Recursive (->) t (f a), Steppable u (XNor a)) => t -> u -- toList = cata (embed . unFree . naturalList) -- FIXME: Use @cata . liftCoEnv@ instead of `iter`. -- | This is simply `cata` applied to a list – the function is the @Cons@ -- case, while the initial value is the @Nil@ case.-foldr :: (Listable f, Recursive t (f a)) => (a -> b -> b) -> b -> t -> b+foldr :: (Listable f, Recursive (->) t (f a)) => (a -> b -> b) -> b -> t -> b foldr f b = cata (iter (\case Neither -> b@@ -38,7 +38,7 @@ . naturalList) -- | Simply `cata` with a carrier of @b -> b@.-foldl :: (Listable f, Recursive t (f a)) => (b -> a -> b) -> b -> t -> b+foldl :: (Listable f, Recursive (->) t (f a)) => (b -> a -> b) -> b -> t -> b foldl f = flip (cata (iter (\case
src/Yaya/Fold.hs view
@@ -6,19 +6,15 @@ import Control.Arrow import Control.Comonad import Control.Comonad.Cofree-import Control.Comonad.Hoist.Class import Control.Comonad.Trans.Env import Control.Lens hiding ((:<)) import Control.Monad import Control.Monad.Trans.Free-import Data.Bifunctor import Data.Bitraversable-import Data.Distributive import Data.Either.Combinators import Data.Foldable import Data.Functor.Classes import Data.Functor.Day-import Data.Functor.Identity import Data.List.NonEmpty (NonEmpty(..)) import Data.Void import Numeric.Natural@@ -27,53 +23,53 @@ import Yaya.Functor import Yaya.Pattern -type Algebra f a = f a -> a-type GAlgebra w f a = f (w a) -> a-type ElgotAlgebra w f a = w (f a) -> a-type AlgebraM m f a = f a -> m a-type GAlgebraM m w f a = f (w a) -> m a-type ElgotAlgebraM m w f a = w (f a) -> m a+type Algebra c f a = f a `c` a+type GAlgebra c w f a = f (w a) `c` a+type ElgotAlgebra c w f a = w (f a) `c` a+type AlgebraM c m f a = f a `c` m a+type GAlgebraM c m w f a = f (w a) `c` m a+type ElgotAlgebraM c m w f a = w (f a) `c` m a -type Coalgebra f a = a -> f a-type GCoalgebra m f a = a -> f (m a)-type ElgotCoalgebra m f a = a -> m (f a)+type Coalgebra c f a = a `c` f a+type GCoalgebra c m f a = a `c` f (m a)+type ElgotCoalgebra c m f a = a `c` m (f a) -- | Note that using a `CoalgebraM` “directly” is partial (e.g., with -- `Yaya.Unsafe.Fold.anaM`). However, @ana . Compose@ can accept a `CoalgebraM` -- and produce something like an effectful stream.-type CoalgebraM m f a = a -> m (f a)-type GCoalgebraM m n f a = a -> m (f (n a))+type CoalgebraM c m f a = a `c` m (f a)+type GCoalgebraM c m n f a = a `c` m (f (n a)) -- | This type class is lawless on its own, but there exist types that can’t -- implement the corresponding `embed` operation. Laws are induced by -- implementing either `Steppable` (which extends this) or `Corecursive` -- (which doesn’t).-class Projectable t f | t -> f where- project :: Coalgebra f t+class Projectable c t f | t -> f where+ project :: Coalgebra c f t -- | Structures you can walk through step-by-step.-class Projectable t f => Steppable t f | t -> f where- embed :: Algebra f t+class Projectable c t f => Steppable c t f | t -> f where+ embed :: Algebra c f t -- | Inductive structures that can be reasoned about in the way we usually do – -- with pattern matching.-class Recursive t f | t -> f where- cata :: Algebra f a -> t -> a+class Recursive c t f | t -> f where+ cata :: Algebra c f a -> t `c` a -- | Coinductive (potentially-infinite) structures that guarantee _productivity_ -- rather than termination.-class Corecursive t f | t -> f where- ana :: Coalgebra f a -> a -> t+class Corecursive c t f | t -> f where+ ana :: Coalgebra c f a -> a `c` t -- | An implementation of `Eq` for any `Recursive` instance. Note that this is -- actually more general than `Eq`, as it can compare between different -- fixed-point representations of the same functor. recursiveEq- :: (Recursive t f, Steppable u f, Functor f, Foldable f, Eq1 f)+ :: (Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f, Eq1 f) => t -> u -> Bool recursiveEq = cata2 equal -- | An implementation of `Show` for any `Recursive` instance.-recursiveShowsPrec :: (Recursive t f, Show1 f) => Int -> t -> ShowS+recursiveShowsPrec :: (Recursive (->) t f, Show1 f) => Int -> t -> ShowS recursiveShowsPrec prec = cata (showParen True . liftShowsPrec (const id) (foldMap id) prec) @@ -82,19 +78,19 @@ -- *NB*: This is only guaranteed to be finite when @f a@ is strict in @a@ -- (having strict functors won't prevent `Nu` from being lazy). Using -- @-XStrictData@ can help with this a lot.-data Mu f = Mu (forall a. Algebra f a -> a)+data Mu f = Mu (forall a. Algebra (->) f a -> a) -instance Functor f => Projectable (Mu f) f where+instance Functor f => Projectable (->) (Mu f) f where project = lambek -instance Functor f => Steppable (Mu f) f where+instance Functor f => Steppable (->) (Mu f) f where embed m = Mu (\f -> f (fmap (cata f) m)) -instance Recursive (Mu f) f where+instance Recursive (->) (Mu f) f where cata φ (Mu f) = f φ instance DFunctor Mu where- dmap f (Mu fold) = Mu (\φ -> fold (φ . f))+ dmap f (Mu run) = Mu (\φ -> run (φ . f)) instance Show1 f => Show (Mu f) where showsPrec = recursiveShowsPrec@@ -104,147 +100,147 @@ -- | A fixed-point operator for coinductive / potentially-infinite data -- structures.-data Nu f where Nu :: Coalgebra f a -> a -> Nu f+data Nu f where Nu :: Coalgebra (->) f a -> a -> Nu f -instance Functor f => Projectable (Nu f) f where+instance Functor f => Projectable (->) (Nu f) f where project (Nu f a) = Nu f <$> f a -instance Functor f => Steppable (Nu f) f where+instance Functor f => Steppable (->) (Nu f) f where embed = colambek -instance Corecursive (Nu f) f where+instance Corecursive (->) (Nu f) f where ana = Nu instance DFunctor Nu where dmap f (Nu φ a) = Nu (f . φ) a -instance Projectable [a] (XNor a) where+instance Projectable (->) [a] (XNor a) where project [] = Neither project (h : t) = Both h t -instance Steppable [a] (XNor a) where+instance Steppable (->) [a] (XNor a) where embed Neither = [] embed (Both h t) = h : t -instance Projectable (NonEmpty a) (AndMaybe a) where+instance Projectable (->) (NonEmpty a) (AndMaybe a) where project (a :| []) = Only a project (a :| b : bs) = Indeed a (b :| bs) -instance Steppable (NonEmpty a) (AndMaybe a) where+instance Steppable (->) (NonEmpty a) (AndMaybe a) where embed (Only a) = a :| [] embed (Indeed a b) = a :| toList b -instance Projectable Natural Maybe where+instance Projectable (->) Natural Maybe where project 0 = Nothing project n = Just (pred n) -instance Steppable Natural Maybe where+instance Steppable (->) Natural Maybe where embed = maybe 0 succ -instance Projectable Void Identity where+instance Projectable (->) Void Identity where project = Identity -instance Steppable Void Identity where+instance Steppable (->) Void Identity where embed = runIdentity -instance Recursive Void Identity where+instance Recursive (->) Void Identity where cata _ = absurd -instance Projectable (Cofree f a) (EnvT a f) where+instance Projectable (->) (Cofree f a) (EnvT a f) where project (a :< ft) = EnvT a ft -instance Steppable (Cofree f a) (EnvT a f) where+instance Steppable (->) (Cofree f a) (EnvT a f) where embed (EnvT a ft) = a :< ft -instance Projectable (Free f a) (FreeF f a) where+instance Projectable (->) (Free f a) (FreeF f a) where project = runFree -instance Steppable (Free f a) (FreeF f a) where+instance Steppable (->) (Free f a) (FreeF f a) where embed = free -- | Combines two `Algebra`s with different carriers into a single tupled -- `Algebra`.-zipAlgebras :: Functor f => Algebra f a -> Algebra f b -> Algebra f (a, b)+zipAlgebras :: Functor f => Algebra (->) f a -> Algebra (->) f b -> Algebra (->) f (a, b) zipAlgebras f g = (f . fmap fst &&& g . fmap snd) -- | Algebras over Day convolution are convenient for binary operations, but -- aren’t directly handleable by `cata`.-lowerDay :: Projectable t g => Algebra (Day f g) a -> Algebra f (t -> a)+lowerDay :: Projectable (->) t g => Algebra (->) (Day f g) a -> Algebra (->) f (t -> a) lowerDay φ fta t = φ (Day fta (project t) ($)) -- | By analogy with `liftA2` (which also relies on `Day`, at least -- conceptually).-cata2 :: (Recursive t f, Projectable u g) => Algebra (Day f g) a -> t -> u -> a+cata2 :: (Recursive (->) t f, Projectable (->) u g) => Algebra (->) (Day f g) a -> t -> u -> a cata2 = cata . lowerDay -- | Makes it possible to provide a `GAlgebra` to `cata`. lowerAlgebra :: (Functor f, Comonad w)- => DistributiveLaw f w- -> GAlgebra w f a- -> Algebra f (w a)+ => DistributiveLaw (->) f w+ -> GAlgebra (->) w f a+ -> Algebra (->) f (w a) lowerAlgebra k φ = fmap φ . k . fmap duplicate -- | Makes it possible to provide a `GAlgebraM` to `Yaya.Zoo.cataM`. lowerAlgebraM :: (Applicative m, Traversable f, Comonad w, Traversable w)- => DistributiveLaw f w- -> GAlgebraM m w f a- -> AlgebraM m f (w a)+ => DistributiveLaw (->) f w+ -> GAlgebraM (->) m w f a+ -> AlgebraM (->) m f (w a) lowerAlgebraM k φ = traverse φ . k . fmap duplicate -- | Makes it possible to provide a `GCoalgebra` to `ana`. lowerCoalgebra :: (Functor f, Monad m)- => DistributiveLaw m f- -> GCoalgebra m f a- -> Coalgebra f (m a)+ => DistributiveLaw (->) m f+ -> GCoalgebra (->) m f a+ -> Coalgebra (->) f (m a) lowerCoalgebra k ψ = fmap join . k . fmap ψ -- | Makes it possible to provide a `GCoalgebraM` to `Yaya.Unsafe.Fold.anaM`. lowerCoalgebraM :: (Applicative m, Traversable f, Monad n, Traversable n)- => DistributiveLaw n f- -> GCoalgebraM m n f a- -> CoalgebraM m f (n a)+ => DistributiveLaw (->) n f+ -> GCoalgebraM (->) m n f a+ -> CoalgebraM (->) m f (n a) lowerCoalgebraM k ψ = fmap (fmap join . k) . traverse ψ gcata- :: (Recursive t f, Functor f, Comonad w)- => DistributiveLaw f w- -> GAlgebra w f a+ :: (Recursive (->) t f, Functor f, Comonad w)+ => DistributiveLaw (->) f w+ -> GAlgebra (->) w f a -> t -> a gcata k φ = extract . cata (lowerAlgebra k φ) elgotCata- :: (Recursive t f, Functor f, Comonad w)- => DistributiveLaw f w- -> ElgotAlgebra w f a+ :: (Recursive (->) t f, Functor f, Comonad w)+ => DistributiveLaw (->) f w+ -> ElgotAlgebra (->) w f a -> t -> a elgotCata k φ = φ . cata (k . fmap (extend φ)) gcataM- :: (Monad m, Recursive t f, Traversable f, Comonad w, Traversable w)- => DistributiveLaw f w- -> GAlgebraM m w f a+ :: (Monad m, Recursive (->) t f, Traversable f, Comonad w, Traversable w)+ => DistributiveLaw (->) f w+ -> GAlgebraM (->) m w f a -> t -> m a gcataM w φ = fmap extract . cata (lowerAlgebraM w φ <=< sequenceA) elgotCataM- :: (Monad m, Recursive t f, Traversable f, Comonad w, Traversable w)- => DistributiveLaw f w- -> ElgotAlgebraM m w f a+ :: (Monad m, Recursive (->) t f, Traversable f, Comonad w, Traversable w)+ => DistributiveLaw (->) f w+ -> ElgotAlgebraM (->) m w f a -> t -> m a elgotCataM w φ = φ <=< cata (fmap w . traverse (sequence . extend φ) <=< sequenceA) ezygoM- :: (Monad m, Recursive t f, Traversable f)- => AlgebraM m f b- -> ElgotAlgebraM m ((,) b) f a+ :: (Monad m, Recursive (->) t f, Traversable f)+ => AlgebraM (->) m f b+ -> ElgotAlgebraM (->) m ((,) b) f a -> t -> m a ezygoM φ' φ =@@ -254,69 +250,69 @@ <=< sequenceA) gana- :: (Corecursive t f, Functor f, Monad m)- => DistributiveLaw m f- -> GCoalgebra m f a+ :: (Corecursive (->) t f, Functor f, Monad m)+ => DistributiveLaw (->) m f+ -> GCoalgebra (->) m f a -> a -> t gana k ψ = ana (lowerCoalgebra k ψ) . pure elgotAna- :: (Corecursive t f, Functor f, Monad m)- => DistributiveLaw m f- -> ElgotCoalgebra m f a+ :: (Corecursive (->) t f, Functor f, Monad m)+ => DistributiveLaw (->) m f+ -> ElgotCoalgebra (->) m f a -> a -> t elgotAna k ψ = ana (fmap (>>= ψ) . k) . ψ -lambek :: (Steppable t f, Recursive t f, Functor f) => Coalgebra f t+lambek :: (Steppable (->) t f, Recursive (->) t f, Functor f) => Coalgebra (->) f t lambek = cata (fmap embed) -colambek :: (Projectable t f, Corecursive t f, Functor f) => Algebra f t+colambek :: (Projectable (->) t f, Corecursive (->) t f, Functor f) => Algebra (->) f t colambek = ana (fmap project) -- | There are a number of distributive laws, including -- `Data.Traversable.sequenceA`, `Data.Distributive.distribute`, and -- `Data.Align.sequenceL`. Yaya also provides others for specific recursion -- schemes.-type DistributiveLaw f g = forall a. f (g a) -> g (f a)+type DistributiveLaw c f g = forall a. f (g a) `c` g (f a) -- | A less-constrained `distribute` for `Identity`.-distIdentity :: Functor f => DistributiveLaw f Identity+distIdentity :: Functor f => DistributiveLaw (->) f Identity distIdentity = Identity . fmap runIdentity -- | A less-constrained `sequenceA` for `Identity`.-seqIdentity :: Functor f => DistributiveLaw Identity f+seqIdentity :: Functor f => DistributiveLaw (->) Identity f seqIdentity = fmap Identity . runIdentity -distTuple :: Functor f => Algebra f a -> DistributiveLaw f ((,) a)+distTuple :: Functor f => Algebra (->) f a -> DistributiveLaw (->) f ((,) a) distTuple φ = φ . fmap fst &&& fmap snd distEnvT :: Functor f- => Algebra f a- -> DistributiveLaw f w- -> DistributiveLaw f (EnvT a w)+ => Algebra (->) f a+ -> DistributiveLaw (->) f w+ -> DistributiveLaw (->) f (EnvT a w) distEnvT φ k = uncurry EnvT . (φ . fmap ask &&& k . fmap lowerEnvT) -seqEither :: Functor f => Coalgebra f a -> DistributiveLaw (Either a) f+seqEither :: Functor f => Coalgebra (->) f a -> DistributiveLaw (->) (Either a) f seqEither ψ = fmap Left . ψ ||| fmap Right -- | Converts an `Algebra` to one that annotates the tree with the result for -- each node. attributeAlgebra- :: (Steppable t (EnvT a f), Functor f)- => Algebra f a -> Algebra f t+ :: (Steppable (->) t (EnvT a f), Functor f)+ => Algebra (->) f a -> Algebra (->) f t attributeAlgebra φ ft = embed $ EnvT (φ (fmap (fst . runEnvT . project) ft)) ft -- | Converts a `Coalgebra` to one that annotates the tree with the seed that -- generated each node.-attributeCoalgebra :: Coalgebra f a -> Coalgebra (EnvT a f) a+attributeCoalgebra :: Coalgebra (->) f a -> Coalgebra (->) (EnvT a f) a attributeCoalgebra ψ = uncurry EnvT . (id &&& ψ) -- | This is just a more obvious name for composing `lowerEnvT` with your -- algebra directly.-ignoringAttribute :: Algebra f a -> Algebra (EnvT b f) a+ignoringAttribute :: Algebra (->) f a -> Algebra (->) (EnvT b f) a ignoringAttribute φ = φ . lowerEnvT -- | It is somewhat common to have a natural transformation that looks like@@ -324,7 +320,7 @@ -- pass to `Yaya.Zoo.apo`) with @η . project@, but the desired `Algebra` is -- more likely to be @cata unFree . η@ than @embed . η@. See yaya-streams for -- some examples of this.-unFree :: Steppable t f => Algebra (FreeF f t) t+unFree :: Steppable (->) t f => Algebra (->) (FreeF f t) t unFree = \case Pure t -> t Free ft -> embed ft@@ -334,40 +330,40 @@ -- * instances for non-recursive types -constEmbed :: Algebra (Const a) a+constEmbed :: Algebra (->) (Const a) a constEmbed = getConst -constProject :: Coalgebra (Const a) a+constProject :: Coalgebra (->) (Const a) a constProject = Const -constCata :: Algebra (Const b) a -> b -> a+constCata :: Algebra (->) (Const b) a -> b -> a constCata φ = φ . Const -constAna :: Coalgebra (Const b) a -> a -> b+constAna :: Coalgebra (->) (Const b) a -> a -> b constAna ψ = getConst . ψ -instance Projectable (Either a b) (Const (Either a b)) where+instance Projectable (->) (Either a b) (Const (Either a b)) where project = constProject -instance Steppable (Either a b) (Const (Either a b)) where+instance Steppable (->) (Either a b) (Const (Either a b)) where embed = constEmbed -instance Recursive (Either a b) (Const (Either a b)) where+instance Recursive (->) (Either a b) (Const (Either a b)) where cata = constCata -instance Corecursive (Either a b) (Const (Either a b)) where+instance Corecursive (->) (Either a b) (Const (Either a b)) where ana = constAna -instance Projectable (Maybe a) (Const (Maybe a)) where+instance Projectable (->) (Maybe a) (Const (Maybe a)) where project = constProject -instance Steppable (Maybe a) (Const (Maybe a)) where+instance Steppable (->) (Maybe a) (Const (Maybe a)) where embed = constEmbed -instance Recursive (Maybe a) (Const (Maybe a)) where+instance Recursive (->) (Maybe a) (Const (Maybe a)) where cata = constCata -instance Corecursive (Maybe a) (Const (Maybe a)) where+instance Corecursive (->) (Maybe a) (Const (Maybe a)) where ana = constAna -- * Optics@@ -376,17 +372,17 @@ type AlgebraPrism f a = Prism' (f a) a type CoalgebraPrism f a = Prism' a (f a) -steppableIso :: Steppable t f => BialgebraIso f t+steppableIso :: Steppable (->) t f => BialgebraIso f t steppableIso = iso embed project birecursiveIso- :: (Recursive t f, Corecursive t f)+ :: (Recursive (->) t f, Corecursive (->) t f) => BialgebraIso f a -> Iso' t a birecursiveIso alg = iso (cata (view alg)) (ana (review alg))-+ recursivePrism- :: (Recursive t f, Corecursive t f, Traversable f)+ :: (Recursive (->) t f, Corecursive (->) t f, Traversable f) => AlgebraPrism f a -> Prism' t a recursivePrism alg =
src/Yaya/Fold/Common.hs view
@@ -1,15 +1,12 @@ -- | Common algebras that are useful when folding. module Yaya.Fold.Common where -import Control.Arrow import Control.Monad import Control.Monad.Trans.Free import Data.Foldable-import Data.Functor import Data.Functor.Classes import Data.Functor.Day import Data.Functor.Identity-import Data.Semigroup import Numeric.Natural import Yaya.Pattern@@ -27,7 +24,7 @@ Indeed a b -> f a <> b -- | Converts the free monad into some other `Monad`.-lowerMonad :: Monad m => (forall a. f a -> m a) -> FreeF f a (m a) -> m a+lowerMonad :: Monad m => (forall x. f x -> m x) -> FreeF f a (m a) -> m a lowerMonad f = \case Pure a -> pure a Free fm -> join (f fm)@@ -88,7 +85,7 @@ truncate' :: Functor f => Day Maybe f a -> FreeF f () a truncate' = \case- Day Nothing fa _ -> Pure ()+ Day Nothing _ _ -> Pure () Day (Just n) fa f -> Free (fmap (f n) fa) -- | Converts a single value into a tuple with the same value on both sides.
src/Yaya/Fold/Native.hs view
@@ -1,3 +1,5 @@+{-# options_ghc -Wno-orphans #-}+ -- | Uses of recursion schemes that use Haskell’s built-in recursion in a total -- manner. module Yaya.Fold.Native where@@ -17,33 +19,33 @@ -- lazy/corecursive. newtype Fix f = Fix { unFix :: f (Fix f) } -instance Projectable (Fix f) f where+instance Projectable (->) (Fix f) f where project = unFix -instance Steppable (Fix f) f where+instance Steppable (->) (Fix f) f where embed = Fix -instance Functor f => Corecursive (Fix f) f where+instance Functor f => Corecursive (->) (Fix f) f where ana φ = embed . fmap (ana φ) . φ -instance Recursive Natural Maybe where+instance Recursive (->) Natural Maybe where cata ɸ = ɸ . fmap (cata ɸ) . project -instance Corecursive [a] (XNor a) where+instance Corecursive (->) [a] (XNor a) where ana ψ = (\case Neither -> [] Both h t -> h : ana ψ t) . ψ -instance Corecursive (NonEmpty a) (AndMaybe a) where+instance Corecursive (->) (NonEmpty a) (AndMaybe a) where ana ψ = (\case Only h -> h :| [] Indeed h t -> h :| toList (ana ψ t)) . ψ -instance Functor f => Corecursive (Free f a) (FreeF f a) where+instance Functor f => Corecursive (->) (Free f a) (FreeF f a) where ana ψ = free . (\case@@ -51,12 +53,12 @@ Free fb -> Free . fmap (ana ψ) $ fb) . ψ -instance Functor f => Corecursive (Cofree f a) (EnvT a f) where+instance Functor f => Corecursive (->) (Cofree f a) (EnvT a f) where ana ψ = uncurry (:<) . fmap (fmap (ana ψ)) . runEnvT . ψ distCofreeT :: (Functor f, Functor h)- => DistributiveLaw f h- -> DistributiveLaw f (Cofree h)+ => DistributiveLaw (->) f h+ -> DistributiveLaw (->) f (Cofree h) distCofreeT k = ana $ uncurry EnvT . (fmap extract &&& k . fmap unwrap)
src/Yaya/Functor.hs view
@@ -7,7 +7,7 @@ -- | A functor from the category of endofunctors to *Hask*. The @D@ is meant to -- be a mnemonic for “down”, as we’re “lowering” from endofunctors to types. class DFunctor (d :: (* -> *) -> *) where- dmap :: (forall a. f a -> g a) -> d f -> d g+ dmap :: (forall x. f x -> g x) -> d f -> d g -- | This isn’t a Functor instance because of the position of the @a@, but you -- can use it like:@@ -19,4 +19,4 @@ -- | An endofunctor in the category of endofunctors. class HFunctor (h :: (* -> *) -> * -> *) where- hmap :: (forall a. f a -> g a) -> h f a -> h g a+ hmap :: (forall x. f x -> g x) -> h f a -> h g a
src/Yaya/Pattern.hs view
@@ -3,22 +3,7 @@ -- | Common pattern functors (and instances for them). module Yaya.Pattern where -import Control.Applicative-import Control.Arrow-import Control.Comonad-import Control.Comonad.Cofree-import Control.Comonad.Env-import Control.Monad-import Control.Monad.Trans.Free import Data.Bifunctor-import Data.Bitraversable-import Data.Distributive-import Data.Foldable-import Data.Functor.Classes-import Data.Functor.Day-import Data.Functor.Identity-import Data.Void-import Numeric.Natural -- | Isomorphic to 'Maybe (a, b)', it’s also the pattern functor for lists. data XNor a b = Neither | Both ~a b deriving (Functor, Foldable, Traversable)
src/Yaya/Zoo.hs view
@@ -8,11 +8,9 @@ import Control.Comonad.Cofree import Control.Comonad.Env import Control.Monad-import Control.Monad.Trans.Free import Data.Bifunctor import Data.Bitraversable import Data.Either.Combinators-import Data.Function import Data.Profunctor import Data.Tuple @@ -23,34 +21,34 @@ -- | A recursion scheme that allows you to return a complete branch when -- unfolding. apo- :: (Projectable t f, Corecursive t f, Functor f)- => GCoalgebra (Either t) f a+ :: (Projectable (->) t f, Corecursive (->) t f, Functor f)+ => GCoalgebra (->) (Either t) f a -> a -> t apo = gana (seqEither project) -- | If you have a monadic algebra, you can fold it by distributing the monad -- over the algebra.-cataM :: (Monad m, Recursive t f, Traversable f) => AlgebraM m f a -> t -> m a+cataM :: (Monad m, Recursive (->) t f, Traversable f) => AlgebraM (->) m f a -> t -> m a cataM φ = cata (φ <=< sequenceA) -- | A recursion scheme that allows to algebras to see each others’ results. (A -- generalization of `zygo`.) This is an example that falls outside the scope -- of “comonadic folds”, but _would_ be covered by “adjoint folds”. mutu- :: (Recursive t f, Functor f)- => GAlgebra ((,) a) f b- -> GAlgebra ((,) b) f a+ :: (Recursive (->) t f, Functor f)+ => GAlgebra (->) ((,) a) f b+ -> GAlgebra (->) ((,) b) f a -> t -> a mutu φ' φ = extract . cata (φ' . fmap swap &&& φ) gmutu- :: (Comonad w, Comonad v, Recursive t f, Functor f)- => DistributiveLaw f w- -> DistributiveLaw f v- -> GAlgebra (EnvT a w) f b- -> GAlgebra (EnvT b v) f a+ :: (Comonad w, Comonad v, Recursive (->) t f, Functor f)+ => DistributiveLaw (->) f w+ -> DistributiveLaw (->) f v+ -> GAlgebra (->) (EnvT a w) f b+ -> GAlgebra (->) (EnvT b v) f a -> t -> a gmutu w v φ' φ = extract . mutu (lowerEnv w φ') (lowerEnv v φ)@@ -65,19 +63,19 @@ -- | This could use a better name. comutu- :: (Corecursive t f, Functor f)- => GCoalgebra (Either a) f b- -> GCoalgebra (Either b) f a+ :: (Corecursive (->) t f, Functor f)+ => GCoalgebra (->) (Either a) f b+ -> GCoalgebra (->) (Either b) f a -> a -> t comutu ψ' ψ = ana (fmap swapEither . ψ' ||| ψ) . pure -- gcomutu--- :: (Monad m, Monad n, Corecursive t f, Functor f)--- => DistributiveLaw m f--- -> DistributiveLaw n f--- -> GCoalgebra (FreeF m a) f b--- -> GCoalgebra (FreeF n b) f a+-- :: (Monad m, Monad n, Corecursive (->) t f, Functor f)+-- => DistributiveLaw (->) m f+-- -> DistributiveLaw (->) n f+-- -> GCoalgebra (->) (FreeF m a) f b+-- -> GCoalgebra (->) (FreeF n b) f a -- -> a -- -> t -- gcomutu m n ψ' ψ = comutu (lowerFree m ψ') (lowerFree n ψ) . pure@@ -86,27 +84,27 @@ -- fmap ((pure +++ join) . distProd . fmap (uncurry EnvT)) -- . x -- . fmap ψ''--- distProd :: DistributiveLaw f (Either a)+-- distProd :: DistributiveLaw (->) f (Either a) -- distProd p = -- let a = fst p -- in fmap (\b -> (a , b)) (snd p) mutuM- :: (Monad m, Recursive t f, Traversable f)- => GAlgebraM m ((,) a) f b- -> GAlgebraM m ((,) b) f a+ :: (Monad m, Recursive (->) t f, Traversable f)+ => GAlgebraM (->) m ((,) a) f b+ -> GAlgebraM (->) m ((,) b) f a -> t -> m a mutuM φ' φ = fmap snd . cataM (bisequence . (φ' . fmap swap &&& φ)) -histo :: (Recursive t f, Functor f) => GAlgebra (Cofree f) f a -> t -> a+histo :: (Recursive (->) t f, Functor f) => GAlgebra (->) (Cofree f) f a -> t -> a histo = gcata (distCofreeT id) -- | A recursion scheme that gives you access to the original structure as you -- fold. (A specialization of `zygo`.) para- :: (Steppable t f, Recursive t f, Functor f)- => GAlgebra ((,) t) f a+ :: (Steppable (->) t f, Recursive (->) t f, Functor f)+ => GAlgebra (->) ((,) t) f a -> t -> a para = gcata (distTuple embed)@@ -115,9 +113,9 @@ -- information when folding. (A generalization of `para`, and specialization -- of `mutu`.) zygo- :: (Recursive t f, Functor f)- => Algebra f b- -> GAlgebra ((,) b) f a+ :: (Recursive (->) t f, Functor f)+ => Algebra (->) f b+ -> GAlgebra (->) ((,) b) f a -> t -> a zygo φ = gcata (distTuple φ)@@ -126,9 +124,9 @@ -- because it has a monadic “helper” algebra. But at least it gives us the -- opportunity to show how `zygo` is a specialization of `mutu`. zygoM- :: (Monad m, Recursive t f, Traversable f)- => AlgebraM m f b- -> GAlgebraM m ((,) b) f a+ :: (Monad m, Recursive (->) t f, Traversable f)+ => AlgebraM (->) m f b+ -> GAlgebraM (->) m ((,) b) f a -> t -> m a zygoM φ' φ = mutuM (φ' . fmap snd) φ@@ -165,9 +163,9 @@ ((fromPartial . flip fmap fa +++ Right) . project) instance Monad Partial where- pa >>= f = join (fmap f pa)+ pa >>= f = join' (fmap f pa) where- join =+ join' = insidePartial $ elgotAna (seqEither project) ((fromPartial +++ Right) . project) @@ -177,12 +175,12 @@ -- | A more general implementation of `fmap`, because it can also work to, from, -- or within monomorphic structures, obviating the need for classes like -- `Data.MonoTraversable.MonoFunctor`.-map :: (Recursive t (f a), Steppable u (f b), Bifunctor f) => (a -> b) -> t -> u+map :: (Recursive (->) t (f a), Steppable (->) u (f b), Bifunctor f) => (a -> b) -> t -> u map f = cata (embed . first f) -- | A version of `Yaya.Zoo.map` that applies to Corecursive structures. comap- :: (Projectable t (f a), Corecursive u (f b), Bifunctor f)+ :: (Projectable (->) t (f a), Corecursive (->) u (f b), Bifunctor f) => (a -> b) -> t -> u@@ -193,8 +191,8 @@ -- can also work to, from, or within monomorphic structures, obviating the -- need for classes like `Data.MonoTraversable.MonoTraversable`. traverse- :: ( Recursive t (f a)- , Steppable u (f b)+ :: ( Recursive (->) t (f a)+ , Steppable (->) u (f b) , Bitraversable f , Traversable (f a) , Monad m)@@ -206,14 +204,14 @@ -- | A more general implementation of `Data.Functor.contramap`, because it can -- also work to, from, or within monomorphic structures. contramap- :: (Recursive t (f b), Steppable u (f a), Profunctor f)+ :: (Recursive (->) t (f b), Steppable (->) u (f a), Profunctor f) => (a -> b) -> t -> u contramap f = cata (embed . lmap f) cocontramap- :: (Projectable t (f b), Corecursive u (f a), Profunctor f)+ :: (Projectable (->) t (f b), Corecursive (->) u (f a), Profunctor f) => (a -> b) -> t -> u
yaya.cabal view
@@ -1,5 +1,5 @@ name: yaya-version: 0.2.1.2+version: 0.3.0.0 synopsis: Total recursion schemes. description: Recursion schemes allow you to separate recursion from your business logic – making your own operations simpler, more@@ -55,6 +55,7 @@ , RankNTypes , ScopedTypeVariables , TupleSections+ , TypeOperators default-language: Haskell2010 source-repository head