module Yaya.Applied where
import Control.Monad.Trans.Free
import Data.Functor.Identity
import Yaya.Fold
import Yaya.Fold.Common
import Yaya.Pattern
now :: Steppable t (Either a) => a -> t
now = embed . Left
runToEnd :: Recursive t (Either a) => t -> a
runToEnd = cata fromEither
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 = cata runIdentity
vacuous :: (Functor f, Recursive t Identity) => f t -> f a
vacuous = fmap absurd
zeroN :: Steppable t Maybe => t
zeroN = embed Nothing
succN :: Steppable t Maybe => t -> t
succN = embed . Just
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 = ana (unarySequence succN) zeroN
takeUpTo
:: (Recursive n Maybe, Projectable s (XNor a), Steppable l (XNor a))
=> n -> s -> l
takeUpTo = cata (lowerDay (embed . takeAvailable))
take
:: (Recursive n Maybe, Projectable s ((,) a), Steppable l (XNor a))
=> n -> s -> l
take = cata (lowerDay (embed . takeAnother))
maybeReify
:: (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)
=> n -> s -> l
reifyUpTo = cata maybeReify
fibonacciPolynomials :: (Integral i, Corecursive t ((,) i)) => i -> t
fibonacciPolynomials x = lucasSequenceU x (-1)
fibonacci :: Corecursive t ((,) Int) => t
fibonacci = fibonacciPolynomials 1
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 p q = lucasSequence' p q `ana` (2, p)
lucas :: Integral i => Corecursive t ((,) i) => t
lucas = lucasSequenceV 1 (-1)
pell :: (Integral i, Corecursive t ((,) i)) => t
pell = lucasSequenceU 2 (-1)
jacobsthal :: (Integral i, Corecursive t ((,) i)) => t
jacobsthal = lucasSequenceU 1 (-2)
mersenne :: (Integral i, Corecursive t ((,) i)) => t
mersenne = lucasSequenceU 3 2
constantly :: Corecursive t ((,) a) => a -> t
constantly = ana split
truncate
:: (Recursive n Maybe, Projectable t f, Steppable u (FreeF f ()), Functor f)
=> n -> t -> u
truncate = cata (lowerDay (embed . truncate'))