{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}

module Data.Predicate(
  PredicateT(..)
, Predicate
, predicateT
, predicate
, predicate'
, purePredicate
, true
, false
, (.&&.)
, (.||.)
, (.->.)
, not
, and
, or
, all
, any
, equals
, notEquals
, elem
, notElem
, isInfixOf
, isPrefixOf
, isSuffixOf
, isSubsequenceOf
, find
, filter
, null
, takeWhile
, dropWhile
) where

import Control.Applicative ( Applicative(pure, liftA2) )
import Control.Category ( Category((.), id) )
import Control.Lens
    ( Getting,
      allOf,
      andOf,
      anyOf,
      orOf,
      iso,
      review,
      over,
      Iso )
import Control.Monad ( Monad((>>=)) )
import Control.Monad.Reader.Class ( MonadReader )
import Data.Bool ( Bool(..), (||), bool )
import qualified Data.Bool as Bool
import Data.Either( either )
import Data.Eq ( Eq((==)) )
import Data.Functor( Functor( fmap ))
import Data.Functor.Contravariant ( Contravariant(contramap) )
import Data.Functor.Contravariant.Divisible
    ( Decidable(..), Divisible(..) )
import Data.Functor.Identity ( Identity(..) )
import Data.Foldable(Foldable( foldr ))
import qualified Data.List as List
import Data.Maybe ( Maybe(..) )
import Data.Monoid ( Monoid(mempty), All, Any )
import Data.Semigroup ( Semigroup((<>)) )
import Data.Void( absurd )

newtype PredicateT f a =
  PredicateT (a -> f Bool)

type Predicate a =
  PredicateT Identity a

predicateT ::
  Iso
    (PredicateT f a)
    (PredicateT f' a')
    (a -> f Bool)
    (a' -> f' Bool)
predicateT :: forall (f :: * -> *) a (f' :: * -> *) a'.
Iso
  (PredicateT f a) (PredicateT f' a') (a -> f Bool) (a' -> f' Bool)
predicateT =
  forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\(PredicateT a -> f Bool
p) -> a -> f Bool
p)
    forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT

predicate ::
  Iso
    (Predicate a)
    (Predicate a')
    (a -> Bool)
    (a' -> Bool)
predicate :: forall a a'.
Iso (Predicate a) (Predicate a') (a -> Bool) (a' -> Bool)
predicate =
  forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\(PredicateT a -> Identity Bool
p) -> forall a. Identity a -> a
runIdentity forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Identity Bool
p)
    (\a' -> Bool
p -> forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall a. a -> Identity a
Identity forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a' -> Bool
p))

predicate' ::
  MonadReader (a -> Bool) f =>
  f (Predicate a)
predicate' :: forall a (f :: * -> *).
MonadReader (a -> Bool) f =>
f (Predicate a)
predicate' =
  forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall a a'.
Iso (Predicate a) (Predicate a') (a -> Bool) (a' -> Bool)
predicate

instance Contravariant (PredicateT f) where
  contramap :: forall a' a. (a' -> a) -> PredicateT f a -> PredicateT f a'
contramap a' -> a
f =
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (f :: * -> *) a (f' :: * -> *) a'.
Iso
  (PredicateT f a) (PredicateT f' a') (a -> f Bool) (a' -> f' Bool)
predicateT (forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a' -> a
f)

instance Monad f => Divisible (PredicateT f) where
  divide :: forall a b c.
(a -> (b, c)) -> PredicateT f b -> PredicateT f c -> PredicateT f a
divide a -> (b, c)
f (PredicateT b -> f Bool
p) (PredicateT c -> f Bool
q) =
    forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (\a
a -> let (b
b, c
c) = a -> (b, c)
f a
a in b -> f Bool
p b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> a -> Bool -> a
bool (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) (c -> f Bool
q c
c))
  conquer :: forall a. PredicateT f a
conquer =
    forall a. Monoid a => a
mempty

instance Monad f => Decidable (PredicateT f) where
  lose :: forall a. (a -> Void) -> PredicateT f a
lose a -> Void
f =
    forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Void -> a
absurd forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Void
f)
  choose :: forall a b c.
(a -> Either b c)
-> PredicateT f b -> PredicateT f c -> PredicateT f a
choose a -> Either b c
f (PredicateT b -> f Bool
p) (PredicateT c -> f Bool
q) =
    forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> f Bool
p c -> f Bool
q forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Either b c
f)

instance Monad f => Semigroup (PredicateT f a) where
  PredicateT a -> f Bool
p <> :: PredicateT f a -> PredicateT f a -> PredicateT f a
<> PredicateT a -> f Bool
q =
    forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (\a
a -> a -> f Bool
p a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> a -> Bool -> a
bool (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) (a -> f Bool
q a
a))

instance Monad f => Monoid (PredicateT f a) where
  mempty :: PredicateT f a
mempty =
    forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True))

purePredicate ::
  Applicative f =>
  (a -> Bool)
  -> PredicateT f a
purePredicate :: forall (f :: * -> *) a.
Applicative f =>
(a -> Bool) -> PredicateT f a
purePredicate a -> Bool
p =
  forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Bool
p)

true ::
  Applicative f =>
  PredicateT f a
true :: forall (f :: * -> *) a. Applicative f => PredicateT f a
true =
  forall (f :: * -> *) a.
Applicative f =>
(a -> Bool) -> PredicateT f a
purePredicate (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)

false ::
  Applicative f =>
  PredicateT f b
false :: forall (f :: * -> *) a. Applicative f => PredicateT f a
false =
  forall (f :: * -> *) a.
Applicative f =>
(a -> Bool) -> PredicateT f a
purePredicate (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)

(.&&.) ::
  Monad f =>
  PredicateT f a
  -> PredicateT f a
  -> PredicateT f a
.&&. :: forall (f :: * -> *) a.
Monad f =>
PredicateT f a -> PredicateT f a -> PredicateT f a
(.&&.) =
  forall a. Semigroup a => a -> a -> a
(<>)

(.||.) ::
  Monad f =>
  PredicateT f a
  -> PredicateT f a
  -> PredicateT f a
PredicateT a -> f Bool
p .||. :: forall (f :: * -> *) a.
Monad f =>
PredicateT f a -> PredicateT f a -> PredicateT f a
.||. PredicateT a -> f Bool
q =
  forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (\a
a -> a -> f Bool
p a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> a -> Bool -> a
bool (a -> f Bool
q a
a) (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True))

(.->.) ::
  Monad f =>
  PredicateT f a
  -> PredicateT f a
  -> PredicateT f a
PredicateT a -> f Bool
p .->. :: forall (f :: * -> *) a.
Monad f =>
PredicateT f a -> PredicateT f a -> PredicateT f a
.->. PredicateT a -> f Bool
q =
  forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (\a
a -> a -> f Bool
p a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p' -> a -> f Bool
q a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
q' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Bool
Bool.not Bool
p' Bool -> Bool -> Bool
|| Bool
q'))

not ::
  Functor f =>
  PredicateT f a
  -> PredicateT f a
not :: forall (f :: * -> *) a.
Functor f =>
PredicateT f a -> PredicateT f a
not (PredicateT a -> f Bool
p) =
  forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
Bool.not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f Bool
p)

and ::
  Applicative f =>
  Getting All s Bool
  -> PredicateT f s
and :: forall (f :: * -> *) s.
Applicative f =>
Getting All s Bool -> PredicateT f s
and =
  forall (f :: * -> *) a.
Applicative f =>
(a -> Bool) -> PredicateT f a
purePredicate forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s. Getting All s Bool -> s -> Bool
andOf

or ::
  Applicative f =>
  Getting Any s Bool
  -> PredicateT f s
or :: forall (f :: * -> *) s.
Applicative f =>
Getting Any s Bool -> PredicateT f s
or =
  forall (f :: * -> *) a.
Applicative f =>
(a -> Bool) -> PredicateT f a
purePredicate forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s. Getting Any s Bool -> s -> Bool
orOf

all ::
  Getting All s a
  -> Predicate a
  -> Predicate s
all :: forall s a. Getting All s a -> Predicate a -> Predicate s
all =
  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a a'.
Iso (Predicate a) (Predicate a') (a -> Bool) (a' -> Bool)
predicate forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s a. Getting All s a -> (a -> Bool) -> s -> Bool
allOf

any ::
  Getting Any s a
  -> Predicate a
  -> Predicate s
any :: forall s a. Getting Any s a -> Predicate a -> Predicate s
any =
  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a a'.
Iso (Predicate a) (Predicate a') (a -> Bool) (a' -> Bool)
predicate forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf

equals ::
  (Applicative f, Eq a) =>
  a
  -> PredicateT f a
equals :: forall (f :: * -> *) a.
(Applicative f, Eq a) =>
a -> PredicateT f a
equals a
s =
  forall (f :: * -> *) a.
Applicative f =>
(a -> Bool) -> PredicateT f a
purePredicate (a
s forall a. Eq a => a -> a -> Bool
==)

notEquals ::
  (Applicative f, Eq a) =>
  a
  -> PredicateT f a
notEquals :: forall (f :: * -> *) a.
(Applicative f, Eq a) =>
a -> PredicateT f a
notEquals =
  forall (f :: * -> *) a.
Functor f =>
PredicateT f a -> PredicateT f a
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a.
(Applicative f, Eq a) =>
a -> PredicateT f a
equals

elem ::
  Eq a =>
  Getting Any s a
  -> a
  -> Predicate s
elem :: forall a s. Eq a => Getting Any s a -> a -> Predicate s
elem Getting Any s a
l =
  forall s a. Getting Any s a -> Predicate a -> Predicate s
any Getting Any s a
l forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a.
(Applicative f, Eq a) =>
a -> PredicateT f a
equals

notElem ::
  Eq a =>
  Getting All s a
  -> a
  -> Predicate s
notElem :: forall a s. Eq a => Getting All s a -> a -> Predicate s
notElem Getting All s a
l =
  forall s a. Getting All s a -> Predicate a -> Predicate s
all Getting All s a
l forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a.
(Applicative f, Eq a) =>
a -> PredicateT f a
notEquals

isInfixOf ::
  (Applicative f, Eq a) =>
  [a]
  -> PredicateT f [a]
isInfixOf :: forall (f :: * -> *) a.
(Applicative f, Eq a) =>
[a] -> PredicateT f [a]
isInfixOf [a]
s =
  forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([a]
s forall a. Eq a => [a] -> [a] -> Bool
`List.isInfixOf`))

isPrefixOf ::
  (Applicative f, Eq a) =>
  [a]
  -> PredicateT f [a]
isPrefixOf :: forall (f :: * -> *) a.
(Applicative f, Eq a) =>
[a] -> PredicateT f [a]
isPrefixOf [a]
s =
  forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([a]
s forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf`))

isSuffixOf ::
  (Applicative f, Eq a) =>
  [a]
  -> PredicateT f [a]
isSuffixOf :: forall (f :: * -> *) a.
(Applicative f, Eq a) =>
[a] -> PredicateT f [a]
isSuffixOf [a]
s =
  forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([a]
s forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf`))

isSubsequenceOf ::
  (Applicative f, Eq a) =>
  [a]
  -> PredicateT f [a]
isSubsequenceOf :: forall (f :: * -> *) a.
(Applicative f, Eq a) =>
[a] -> PredicateT f [a]
isSubsequenceOf [a]
s =
  forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([a]
s forall a. Eq a => [a] -> [a] -> Bool
`List.isSubsequenceOf`))

find ::
  (Monad f, Foldable t) =>
  PredicateT f a
  -> t a
  -> f (Maybe a)
find :: forall (f :: * -> *) (t :: * -> *) a.
(Monad f, Foldable t) =>
PredicateT f a -> t a -> f (Maybe a)
find (PredicateT a -> f Bool
p) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
a f (Maybe a)
b -> a -> f Bool
p a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> a -> Bool -> a
bool f (Maybe a)
b (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
a))) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)

filter ::
  Applicative f =>
  PredicateT f a
  -> [a]
  -> f [a]
filter :: forall (f :: * -> *) a.
Applicative f =>
PredicateT f a -> [a] -> f [a]
filter (PredicateT a -> f Bool
p) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
a -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a. a -> a -> Bool -> a
bool forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a
aforall a. a -> [a] -> [a]
:)) (a -> f Bool
p a
a)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure [])

null ::
  (Applicative f, Foldable t) =>
  PredicateT f (t a)
null :: forall (f :: * -> *) (t :: * -> *) a.
(Applicative f, Foldable t) =>
PredicateT f (t a)
null =
  forall (f :: * -> *) a. (a -> f Bool) -> PredicateT f a
PredicateT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null)

takeWhile ::
  Monad f =>
  PredicateT f a
  -> [a]
  -> f [a]
takeWhile :: forall (f :: * -> *) a. Monad f => PredicateT f a -> [a] -> f [a]
takeWhile (PredicateT a -> f Bool
p) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
a f [a]
b -> a -> f Bool
p a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> a -> Bool -> a
bool (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
aforall a. a -> [a] -> [a]
:) f [a]
b)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure [])

dropWhile ::
  Monad f =>
  PredicateT f a
  -> [a]
  -> f [a]
dropWhile :: forall (f :: * -> *) a. Monad f => PredicateT f a -> [a] -> f [a]
dropWhile PredicateT f a
_ [] =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure []
dropWhile p' :: PredicateT f a
p'@(PredicateT a -> f Bool
p) (a
h:[a]
t) =
  a -> f Bool
p a
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> a -> Bool -> a
bool (forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
hforall a. a -> [a] -> [a]
:[a]
t)) (forall (f :: * -> *) a. Monad f => PredicateT f a -> [a] -> f [a]
dropWhile PredicateT f a
p' [a]
t)