-- | This library is based on the notion of a predicate transformer, the below
-- type @PT a b@, which is a function from @a@ to predicates on @b@.
-- They act as a sort of compositional "matcher language".
-- Composing these predicate transformers is meant to be analogous to composing optics
-- and there are utilities for using predicate transformers with (`lens`-style) optics.
module PredicateTransformers where

import Prelude hiding (all)
import Control.Lens hiding (zoom)
import Data.Foldable(toList)
import Debug.Trace

-- |A convenient alias for predicates.
type Pred a = a -> Bool

-- |Predicate transformers form a category where composition is ordinary function
-- composition.
-- Multiple are already provided by the standard library,
-- for instance `Data.Foldable.all` and `Data.Foldable.any`.
type PT a b = Pred a -> Pred b

-- |Functor from Hask^op to PT.
function :: (b -> a) -> PT a b
function = flip (.)

-- |Operate on the target of a prism, or fail.
match :: APrism s t a b -> PT a s
match p pred s = either (const False) pred (matching p s)

-- |Operate on the target of a getter.
getter :: Getting a s a -> PT a s
getter g = function (view g)

-- |Invert a predicate.
nay :: PT a a
nay = (not .)

-- |Operate on the `Just` branch of a `Maybe`, or fail.
just :: PT a (Maybe a)
just = match _Just

-- |Operate on the `Left` branch of an `Either`, or fail.
left :: PT e (Either e a)
left = match _Left

-- |Operate on the `Right` branch of an `Either`, or fail.
right :: PT a (Either e a)
right = match _Right

-- |Operate on the last value in a list, or fail if it's not present.
endingWith :: PT a [a]
endingWith _ [] = False
endingWith p xs = p $ last xs

-- |Operate on the first value in a list, or fail if it's not present.
startingWith :: PT a [a]
startingWith p (x:_) = p x
startingWith _ [] = False

-- |Require that a list has a single element, and operate on that element.
only :: PT a [a]
only p [x] = p x
only _ _ = False

-- |Given a list of predicates and a list of values, ensure that each predicate holds for each respective value.
-- Fails if the two lists have different lengths.
dist :: [Pred a] -> Pred [a]
dist (p:ps) (x:xs) = p x && dist ps xs
dist [] [] = True
dist _ _ = False

-- |Given a functor-full of predicates, and a functor-full of values, ensure that the structures
-- of the two functors match and apply all of the predicates to all of the values.
-- Generalized version of `dist`.
distF ::
    (Eq (f ()), Functor f, Foldable f) =>
    f (Pred a) -> Pred (f a)
distF preds values =
    (() <$ preds) == (() <$ values) &&
    dist (toList preds) (toList values)

-- |Sugar for tupling.
(==>) :: a -> b -> (a, b)
(==>) = (,)

-- |Prints the input of a predicate, for debugging.
traced :: Show a => PT a a
traced = (. traceShowId)