packages feed

yaya 0.2.1.2 → 0.3.0.0

raw patch · 10 files changed

+205/−218 lines, 10 files

Files

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