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 :: a -> t
now = Algebra (->) (Either a) t
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (Either a) t -> (a -> Either a t) -> a -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a t
forall a b. a -> Either a b
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 :: t -> a
runToEnd = Algebra (->) (Either a) a -> t -> a
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata Algebra (->) (Either a) a
forall a. Either a a -> a
fromEither

-- | Converts exceptional divergence to non-termination.
fromMaybe :: (Steppable (->) t (Either a), Corecursive (->) t (Either a)) => Maybe a -> t
fromMaybe :: Maybe a -> t
fromMaybe = t -> (a -> t) -> Maybe a -> t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Coalgebra (->) (Either a) () -> () -> t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana (Identity () -> Either a ()
forall b a. Identity b -> Either a b
toRight (Identity () -> Either a ())
-> (() -> Identity ()) -> Coalgebra (->) (Either a) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Identity ()
forall a. a -> Identity a
never) ()) a -> t
forall t a. Steppable (->) t (Either a) => a -> t
now

type Void = Mu Identity

absurd :: Recursive (->) t Identity => t -> a
absurd :: t -> a
absurd = Algebra (->) Identity a -> t -> a
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata Algebra (->) Identity a
forall a. Identity a -> a
runIdentity

vacuous :: (Functor f, Recursive (->) t Identity) => f t -> f a
vacuous :: f t -> f a
vacuous = (t -> a) -> f t -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t -> a
forall t a. Recursive (->) t Identity => t -> a
absurd

zeroN :: Steppable (->) t Maybe => t
zeroN :: t
zeroN = Algebra (->) Maybe t
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Maybe t
forall a. Maybe a
Nothing

succN :: Steppable (->) t Maybe => t -> t
succN :: t -> t
succN = Algebra (->) Maybe t
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) Maybe t -> (t -> Maybe t) -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe t
forall a. a -> Maybe a
Just

height :: (Foldable f, Steppable (->) n Maybe, Ord n) => f n -> n
height :: f n -> n
height = (n -> n -> n) -> n -> f n -> n
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (n -> n -> n
forall a. Ord a => a -> a -> a
max (n -> n -> n) -> (n -> n) -> n -> n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> n
forall t. Steppable (->) t Maybe => t -> t
succN) n
forall t. Steppable (->) t Maybe => t
zeroN

naturals :: (Steppable (->) n Maybe, Corecursive (->) t ((,) n)) => t
naturals :: t
naturals = Coalgebra (->) ((,) n) n -> n -> t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana ((n -> n) -> Coalgebra (->) ((,) n) n
forall a b. (a -> b) -> a -> (a, b)
unarySequence n -> n
forall t. Steppable (->) t Maybe => t -> t
succN) n
forall t. Steppable (->) t Maybe => t
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)) =>
  n ->
  s ->
  l
takeUpTo :: n -> s -> l
takeUpTo = Algebra (->) (Day Maybe (XNor a)) l -> n -> s -> l
forall t (f :: * -> *) u (g :: * -> *) a.
(Recursive (->) t f, Projectable (->) u g) =>
Algebra (->) (Day f g) a -> t -> u -> a
cata2 (Algebra (->) (XNor a) l
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (XNor a) l
-> (Day Maybe (XNor a) l -> XNor a l)
-> Algebra (->) (Day Maybe (XNor a)) l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day Maybe (XNor a) l -> XNor a l
forall a b. Day Maybe (XNor a) b -> XNor a b
takeAvailable)

-- | Extracts _exactly_ @n@ elements from the infinite stream @s@.
take ::
  (Recursive (->) n Maybe, Projectable (->) s ((,) a), Steppable (->) l (XNor a)) =>
  n ->
  s ->
  l
take :: n -> s -> l
take = Algebra (->) (Day Maybe ((,) a)) l -> n -> s -> l
forall t (f :: * -> *) u (g :: * -> *) a.
(Recursive (->) t f, Projectable (->) u g) =>
Algebra (->) (Day f g) a -> t -> u -> a
cata2 (Algebra (->) (XNor a) l
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (XNor a) l
-> (Day Maybe ((,) a) l -> XNor a l)
-> Algebra (->) (Day Maybe ((,) a)) l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day Maybe ((,) a) l -> XNor a l
forall a b. Day Maybe ((,) a) b -> XNor a b
takeAnother)

-- | Extracts the element at a finite index of an infinite sequence (a `!!` that
--   can't fail).
at :: (Recursive (->) n Maybe, Projectable (->) s ((,) a)) => n -> s -> a
at :: n -> s -> a
at = Algebra (->) (Day Maybe ((,) a)) a -> n -> s -> a
forall t (f :: * -> *) u (g :: * -> *) a.
(Recursive (->) t f, Projectable (->) u g) =>
Algebra (->) (Day f g) a -> t -> u -> a
cata2 Algebra (->) (Day Maybe ((,) a)) a
forall a. Day Maybe ((,) a) a -> a
takeNext

-- | Extracts the element at a finite index of a (co)list (a `!!` that fails
--   with `Nothing`).
atMay ::
  (Recursive (->) n Maybe, Projectable (->) s (XNor a)) => n -> s -> Maybe a
atMay :: n -> s -> Maybe a
atMay = Algebra (->) (Day Maybe (XNor a)) (Maybe a) -> n -> s -> Maybe a
forall t (f :: * -> *) u (g :: * -> *) a.
(Recursive (->) t f, Projectable (->) u g) =>
Algebra (->) (Day f g) a -> t -> u -> a
cata2 Algebra (->) (Day Maybe (XNor a)) (Maybe a)
forall a. Day Maybe (XNor a) (Maybe a) -> Maybe a
maybeTakeNext

-- | 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)
maybeReify :: Algebra (->) Maybe (s -> l)
maybeReify Maybe (s -> l)
Nothing = Algebra (->) (FreeF f s) l
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (FreeF f s) l -> (s -> FreeF f s l) -> s -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> FreeF f s l
forall (f :: * -> *) a b. a -> FreeF f a b
Pure
maybeReify (Just s -> l
f) = Algebra (->) (FreeF f s) l
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (FreeF f s) l -> (s -> FreeF f s l) -> s -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f l -> FreeF f s l
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f l -> FreeF f s l) -> (s -> f l) -> s -> FreeF f s l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> l) -> f s -> f l
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> l
f (f s -> f l) -> (s -> f s) -> s -> f l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> f s
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Projectable c t f =>
Coalgebra c f t
project

reifyUpTo ::
  (Recursive (->) n Maybe, Projectable (->) s f, Steppable (->) l (FreeF f s), Functor f) =>
  n ->
  s ->
  l
reifyUpTo :: n -> s -> l
reifyUpTo = Algebra (->) Maybe (s -> l) -> n -> s -> l
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Recursive c t f =>
Algebra c f a -> c t a
cata Algebra (->) Maybe (s -> l)
forall s (f :: * -> *) l.
(Projectable (->) s f, Steppable (->) l (FreeF f s), Functor f) =>
Algebra (->) Maybe (s -> l)
maybeReify

fibonacciPolynomials :: (Integral i, Corecursive (->) t ((,) i)) => i -> t
fibonacciPolynomials :: i -> t
fibonacciPolynomials i
x = i -> i -> t
forall i t. (Integral i, Corecursive (->) t ((,) i)) => i -> i -> t
lucasSequenceU i
x (-i
1)

fibonacci :: Corecursive (->) t ((,) Int) => t
fibonacci :: t
fibonacci = Int -> t
forall i t. (Integral i, Corecursive (->) t ((,) i)) => i -> t
fibonacciPolynomials Int
1

lucasSequenceU :: (Integral i, Corecursive (->) t ((,) i)) => i -> i -> t
lucasSequenceU :: i -> i -> t
lucasSequenceU i
p i
q = i -> i -> (i, i) -> (i, (i, i))
forall i. Integral i => i -> i -> (i, i) -> (i, (i, i))
lucasSequence' i
p i
q ((i, i) -> (i, (i, i))) -> (i, i) -> t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
`ana` (i
0, i
1)

lucasSequenceV :: (Integral i, Corecursive (->) t ((,) i)) => i -> i -> t
lucasSequenceV :: i -> i -> t
lucasSequenceV i
p i
q = i -> i -> (i, i) -> (i, (i, i))
forall i. Integral i => i -> i -> (i, i) -> (i, (i, i))
lucasSequence' i
p i
q ((i, i) -> (i, (i, i))) -> (i, i) -> t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
`ana` (i
2, i
p)

lucas :: Integral i => Corecursive (->) t ((,) i) => t
lucas :: t
lucas = i -> i -> t
forall i t. (Integral i, Corecursive (->) t ((,) i)) => i -> i -> t
lucasSequenceV i
1 (-i
1)

pell :: (Integral i, Corecursive (->) t ((,) i)) => t
pell :: t
pell = i -> i -> t
forall i t. (Integral i, Corecursive (->) t ((,) i)) => i -> i -> t
lucasSequenceU i
2 (-i
1)

jacobsthal :: (Integral i, Corecursive (->) t ((,) i)) => t
jacobsthal :: t
jacobsthal = i -> i -> t
forall i t. (Integral i, Corecursive (->) t ((,) i)) => i -> i -> t
lucasSequenceU i
1 (-i
2)

mersenne :: (Integral i, Corecursive (->) t ((,) i)) => t
mersenne :: t
mersenne = i -> i -> t
forall i t. (Integral i, Corecursive (->) t ((,) i)) => i -> i -> t
lucasSequenceU i
3 i
2

-- | Creates an infinite stream of the provided value.
constantly :: Corecursive (->) t ((,) a) => a -> t
constantly :: a -> t
constantly = Coalgebra (->) ((,) a) a -> a -> t
forall k k (c :: k -> k -> *) (t :: k) (f :: k -> k) (a :: k).
Corecursive c t f =>
Coalgebra c f a -> c a t
ana Coalgebra (->) ((,) a) a
forall a. a -> (a, a)
diagonal

-- | 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) =>
  n ->
  t ->
  u
truncate :: n -> t -> u
truncate = Algebra (->) (Day Maybe f) u -> n -> t -> u
forall t (f :: * -> *) u (g :: * -> *) a.
(Recursive (->) t f, Projectable (->) u g) =>
Algebra (->) (Day f g) a -> t -> u -> a
cata2 (Algebra (->) (FreeF f ()) u
forall k (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed Algebra (->) (FreeF f ()) u
-> (Day Maybe f u -> FreeF f () u) -> Algebra (->) (Day Maybe f) u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day Maybe f u -> FreeF f () u
forall (f :: * -> *) a. Functor f => Day Maybe f a -> FreeF f () a
truncate')