module Fold.Shortcut.Examples.Interesting
  (
    {- * Length -} null,
    {- * Boolean -} and, or, all, any,
    {- * Search -} element, notElement, find, lookup,
    {- * Index -} index, findIndex, elementIndex,
  )
  where

import Fold.Shortcut.Type

import Control.Applicative (liftA2)
import Data.Bool (Bool)
import Data.Eq (Eq, (/=), (==))
import Data.Functor (($>), (<&>))
import Data.Maybe (Maybe (Just, Nothing))
import Fold.Shortcut.Conversion (fold)
import Fold.Shortcut.Utilities (demotivate)
import Numeric.Natural (Natural)
import Prelude ((-))
import Strict (isAlive, isDead)

import qualified Fold.Pure.Examples.Interesting as Fold

{-| 'True' if the input contains no inputs (tenacious) -}
null :: ShortcutFold a Bool
null :: forall a. ShortcutFold a Bool
null = ShortcutFold
  { initial :: Vitality () ()
initial = forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
  , step :: () -> a -> Vitality () ()
step = \() a
_ -> forall a b. a -> Vitality a b
Dead ()
  , extract :: Vitality () () -> Bool
extract = forall a b. Vitality a b -> Bool
isAlive
  }

{-| 'True' if all inputs are 'True' (tenacious) -}
and :: ShortcutFold Bool Bool
and :: ShortcutFold Bool Bool
and = ShortcutFold
  { initial :: Vitality () ()
initial = forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
  , step :: () -> Bool -> Vitality () ()
step = \()
_ Bool
a -> if Bool
a then forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious () else forall a b. a -> Vitality a b
Dead ()
  , extract :: Vitality () () -> Bool
extract = forall a b. Vitality a b -> Bool
isAlive
  }

{-| 'True' if any input is 'True' (tenacious) -}
or :: ShortcutFold Bool Bool
or :: ShortcutFold Bool Bool
or = ShortcutFold
  { initial :: Vitality () ()
initial = forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
  , step :: () -> Bool -> Vitality () ()
step = \() Bool
a -> if Bool
a then forall a b. a -> Vitality a b
Dead () else forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
  , extract :: Vitality () () -> Bool
extract = forall a b. Vitality a b -> Bool
isDead
  }

{-| 'True' if all inputs satisfy the predicate (tenacious) -}
all :: (a -> Bool) -> ShortcutFold a Bool
all :: forall a. (a -> Bool) -> ShortcutFold a Bool
all a -> Bool
predicate = ShortcutFold
  { initial :: Vitality () ()
initial = forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
  , step :: () -> a -> Vitality () ()
step = \() a
a -> if a -> Bool
predicate a
a then forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious () else forall a b. a -> Vitality a b
Dead ()
  , extract :: Vitality () () -> Bool
extract = forall a b. Vitality a b -> Bool
isAlive
  }

{-| 'True' if any input satisfies the predicate (tenacious) -}
any :: (a -> Bool) -> ShortcutFold a Bool
any :: forall a. (a -> Bool) -> ShortcutFold a Bool
any a -> Bool
predicate = ShortcutFold
  { initial :: Vitality () ()
initial = forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
  , step :: () -> a -> Vitality () ()
step = \()
_ a
a -> if a -> Bool
predicate a
a then forall a b. a -> Vitality a b
Dead () else forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
  , extract :: Vitality () () -> Bool
extract = forall a b. Vitality a b -> Bool
isDead
  }

{-| 'True' if any input is equal to the given value (tenacious) -}
element :: Eq a => a -> ShortcutFold a Bool
element :: forall a. Eq a => a -> ShortcutFold a Bool
element a
a = forall a. (a -> Bool) -> ShortcutFold a Bool
any (a
a ==)

{-| 'False' if any input is equal to the given value (tenacious) -}
notElement :: Eq a => a -> ShortcutFold a Bool
notElement :: forall a. Eq a => a -> ShortcutFold a Bool
notElement a
a = forall a. (a -> Bool) -> ShortcutFold a Bool
all (a
a /=)

{-| The first input that satisfies the predicate, if any (tenacious) -}
find :: (a -> Bool) -> ShortcutFold a (Maybe a)
find :: forall a. (a -> Bool) -> ShortcutFold a (Maybe a)
find a -> Bool
ok = ShortcutFold
    { initial :: Vitality a ()
initial = forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
    , step :: () -> a -> Vitality a ()
step = \() a
a -> if a -> Bool
ok a
a then forall a b. a -> Vitality a b
Dead a
a else forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
    , extract :: Vitality a () -> Maybe a
extract = \Vitality a ()
v -> case Vitality a ()
v of { Dead a
x -> forall a. a -> Maybe a
Just a
x; Vitality a ()
_ -> forall a. Maybe a
Nothing }
    }

{-| The /n/th input, where n=0 is the first input, if the index is in
    bounds (tenacious) -}
index :: Natural -> ShortcutFold a (Maybe a)
index :: forall a. Natural -> ShortcutFold a (Maybe a)
index Natural
i = ShortcutFold
    { initial :: Vitality a Natural
initial = forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious Natural
i
    , step :: Natural -> a -> Vitality a Natural
step = \Natural
i' a
a -> if Natural
i' forall a. Eq a => a -> a -> Bool
== Natural
0 then forall a b. a -> Vitality a b
Dead a
a else forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious (Natural
i' forall a. Num a => a -> a -> a
- Natural
1)
    , extract :: Vitality a Natural -> Maybe a
extract = \Vitality a Natural
v -> case Vitality a Natural
v of { Dead a
x -> forall a. a -> Maybe a
Just a
x; Vitality a Natural
_ -> forall a. Maybe a
Nothing }
    }

{-| The index of the first input that matches the given value, if any
    (tenacious) -}
elementIndex :: Eq a => a -> ShortcutFold a (Maybe Natural)
elementIndex :: forall a. Eq a => a -> ShortcutFold a (Maybe Natural)
elementIndex a
a = forall a. (a -> Bool) -> ShortcutFold a (Maybe Natural)
findIndex (a
a ==)

{-| The index of the first input that satisfies the predicate, if any
    (tenacious) -}
findIndex :: (a -> Bool) -> ShortcutFold a (Maybe Natural)
findIndex :: forall a. (a -> Bool) -> ShortcutFold a (Maybe Natural)
findIndex a -> Bool
ok = forall a b. ShortcutFold a b -> ShortcutFold a b
demotivate
  (
    forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall a b. Fold a b -> ShortcutFold a b
fold forall a. Fold a Natural
Fold.length) (forall a. (a -> Bool) -> ShortcutFold a (Maybe a)
find a -> Bool
ok)
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Natural
n, Maybe a
found) -> Maybe a
found forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Natural
n forall a. Num a => a -> a -> a
- Natural
1)
  )

{-| The @b@ from the first tuple where @a@ equals the given value,
    if any (tenacious) -}
lookup :: Eq a => a -> ShortcutFold (a, b) (Maybe b)
lookup :: forall a b. Eq a => a -> ShortcutFold (a, b) (Maybe b)
lookup a
a0 = ShortcutFold
    { initial :: Vitality b ()
initial = forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
    , step :: () -> (a, b) -> Vitality b ()
step = \() (a
a, b
b) -> if a
a forall a. Eq a => a -> a -> Bool
== a
a0 then forall a b. a -> Vitality a b
Dead b
b else forall a b. Will -> b -> Vitality a b
Alive Will
Tenacious ()
    , extract :: Vitality b () -> Maybe b
extract = \Vitality b ()
v -> case Vitality b ()
v of { Dead b
x -> forall a. a -> Maybe a
Just b
x; Vitality b ()
_ -> forall a. Maybe a
Nothing }
    }