module Yaya.Zoo where
import Control.Arrow hiding (first)
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
import Yaya.Fold
import Yaya.Fold.Native (distCofreeT)
import Yaya.Pattern
apo
:: (Projectable t f, Corecursive t f, Functor f)
=> GCoalgebra (Either t) f a
-> a
-> t
apo = gana (seqEither project)
cataM :: (Monad m, Recursive t f, Traversable f) => AlgebraM m f a -> t -> m a
cataM φ = cata (φ <=< sequenceA)
mutu
:: (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
-> t
-> a
gmutu w v φ' φ = extract . mutu (lowerEnv w φ') (lowerEnv v φ)
where
lowerEnv x φ'' =
fmap φ''
. x
. fmap (fmap (uncurry EnvT) . distProd . (extract *** duplicate))
distProd p =
let a = fst p
in fmap (\b -> (a , b)) (snd p)
comutu
:: (Corecursive t f, Functor f)
=> GCoalgebra (Either a) f b
-> GCoalgebra (Either b) f a
-> a
-> t
comutu ψ' ψ = ana (fmap swapEither . ψ' ||| ψ) . pure
mutuM
:: (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 = gcata (distCofreeT id)
para
:: (Steppable t f, Recursive t f, Functor f)
=> GAlgebra ((,) t) f a
-> t
-> a
para = gcata (distTuple embed)
zygo
:: (Recursive t f, Functor f)
=> Algebra f b
-> GAlgebra ((,) b) f a
-> t
-> a
zygo φ = gcata (distTuple φ)
zygoM
:: (Monad m, Recursive t f, Traversable f)
=> AlgebraM m f b
-> GAlgebraM m ((,) b) f a
-> t
-> m a
zygoM φ' φ = mutuM (φ' . fmap snd) φ
type Colist a = Nu (XNor a)
type List a = Mu (XNor a)
type NonEmptyList a = Mu (AndMaybe a)
type Nat = Mu Maybe
newtype Partial a = Partial { fromPartial :: Nu (Either a) }
insidePartial :: (Nu (Either a) -> Nu (Either b)) -> Partial a -> Partial b
insidePartial f = Partial . f . fromPartial
instance Functor Partial where
fmap f = insidePartial (comap f)
instance Applicative Partial where
pure = Partial . embed . Left
ff <*> fa =
flip insidePartial ff
$ elgotAna (seqEither project)
((fromPartial . flip fmap fa +++ Right) . project)
instance Monad Partial where
pa >>= f = join (fmap f pa)
where
join =
insidePartial
$ elgotAna (seqEither project) ((fromPartial +++ Right) . project)
type Stream a = Nu ((,) a)
map :: (Recursive t (f a), Steppable u (f b), Bifunctor f) => (a -> b) -> t -> u
map f = cata (embed . first f)
comap
:: (Projectable t (f a), Corecursive u (f b), Bifunctor f)
=> (a -> b)
-> t
-> u
comap f = ana (first f . project)
traverse
:: ( Recursive t (f a)
, Steppable u (f b)
, Bitraversable f
, Traversable (f a)
, Monad m)
=> (a -> m b)
-> t
-> m u
traverse f = cata (fmap embed . bitraverse f pure <=< sequenceA)
contramap
:: (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)
=> (a -> b)
-> t
-> u
cocontramap f = ana (lmap f . project)