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

-- | 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 = cata fromEither

-- | Converts exceptional divergence to non-termination.
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

-- | 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 = cata (lowerDay (embed . 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 = 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)
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

-- | Creates an infinite stream of the provided value.
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
--  'take'.
truncate
  :: (Recursive n Maybe, Projectable t f, Steppable u (FreeF f ()), Functor f)
  => n -> t -> u
truncate = cata (lowerDay (embed . truncate'))