{-# language ViewPatterns #-}

-- | 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 Control.Lens hiding (index, zoom)
import Control.Monad.Writer(execWriter, tell)
import Data.Foldable(toList)
import Data.Functor.Rep(Representable(..))
import Data.Semigroup(All(..))
import Debug.Trace

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

-- |Close to a CPS transform of @b -> a@, except that @c@ isn't quantified over.
-- Stands for "function transformer".
type FT c a b = (a -> c) -> (b -> c)

-- |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 = FT Bool a b

-- |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 -> FT c a s
getter g = (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 :: Foldable f => PT a (f a)
endingWith _ (toList -> []) = False
endingWith p (toList -> xs) = p $ last xs

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

-- |Require that a list has a single element, and operate on that element.
only :: Foldable f => PT a (f a)
only p (toList -> [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)

-- |Given a representable functor-full of predicates, and a functor-full of values,
-- yield a representable functor-full of booleans. Similar to `distF`.
distRep :: Representable f =>
    f (a -> Bool) -> f a -> f Bool
distRep pr fa = tabulate (\r -> index pr r $ index fa r)

-- |Test all predicates against one value.
checkAll :: Monoid m => [a -> m] -> a -> m
checkAll ps a = foldMap ($ a) ps

-- |Given a plated type, take a monoidal sum over every child recursively, bottom-up.
sumOver :: (Monoid m, Plated a) => FT m a a
sumOver p = execWriter . transformM (\a -> a <$ tell (p a))

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

pair :: Pred a -> Pred b -> Pred (a,b)
pair f s (a,b) = f a && s b

-- |Flipped function composition; @f !@ for a function @f@ is a predicate transformer.
(!) :: (b -> a) -> FT c a b
(!) = flip (.)

-- |Prints the input of a predicate, for debugging.
traced :: Show a => FT c a a
traced p a = traceShow a (p a)