module Pandora.Paradigm.Primary.Functor.Predicate where

import Pandora.Core.Functor (type (~>), type (:=>))
import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category (($))
import Pandora.Pattern.Functor.Contravariant (Contravariant ((->$<-)))
import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False), bool)
import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))

newtype Predicate a = Predicate (a -> Boolean)

instance Interpreted Predicate where
	type Primary Predicate a = a -> Boolean
	run :: Predicate a -> Primary Predicate a
run ~(Predicate a -> Boolean
f) = Primary Predicate a
a -> Boolean
f
	unite :: Primary Predicate a -> Predicate a
unite = Primary Predicate a -> Predicate a
forall a. (a -> Boolean) -> Predicate a
Predicate

instance Contravariant (->) (->) Predicate where
	a -> b
f ->$<- :: (a -> b) -> Predicate b -> Predicate a
->$<- Predicate b -> Boolean
g = (a -> Boolean) -> Predicate a
forall a. (a -> Boolean) -> Predicate a
Predicate ((a -> Boolean) -> Predicate a) -> (a -> Boolean) -> Predicate a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ b -> Boolean
g (b -> Boolean) -> (a -> b) -> a -> Boolean
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. a -> b
f

equate :: Setoid a => a :=> Predicate
equate :: a :=> Predicate
equate a
x = (a -> Boolean) -> Predicate a
forall a. (a -> Boolean) -> Predicate a
Predicate (a -> a -> Boolean
forall a. Setoid a => a -> a -> Boolean
== a
x)

not :: Predicate ~> Predicate
not :: Predicate a -> Predicate a
not (Predicate a -> Boolean
p) = (a -> Boolean) -> Predicate a
forall a. (a -> Boolean) -> Predicate a
Predicate ((a -> Boolean) -> Predicate a) -> (a -> Boolean) -> Predicate a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ Boolean -> Boolean -> Boolean -> Boolean
forall a. a -> a -> Boolean -> a
bool Boolean
True Boolean
False (Boolean -> Boolean) -> (a -> Boolean) -> a -> Boolean
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. a -> Boolean
p