{-# LANGUAGE TypeOperators #-}

module Data.Predicate
    ( -- * Predicate
      Predicate
    , constant
    , failure
    , true
    , false
    , and
    , or
    , orElse
    , (.&.)
    , (.|.)
    , (|||)
    , exec
    -- * Result
    , module Data.Predicate.Result
    -- * Product
    , module Data.Predicate.Product
    ) where

import Control.Monad
import Data.Predicate.Product
import Data.Predicate.Result
import Prelude hiding (and, or)

-- | A predicate is a function of some value of type @a@ to a 'Result',
-- i.e. a 'Bool'-like value with 'Okay' as 'True' and 'Fail' as 'False',
-- which carries additional data in each branch.
type Predicate a f t = a -> Result f t

-- | A predicate which always returns @Okay@ with the given
-- value as metadata.
constant :: t -> Predicate a f t
constant :: t -> Predicate a f t
constant t
t a
_ = t -> Result f t
forall (m :: * -> *) a. Monad m => a -> m a
return t
t

true :: Predicate a f ()
true :: Predicate a f ()
true = () -> Predicate a f ()
forall t a f. t -> Predicate a f t
constant ()

-- | A predicate which always returns @Fail@ with the given
-- value as metadata.
failure :: f -> Predicate a f t
failure :: f -> Predicate a f t
failure f
f a
_ = f -> Result f t
forall f t. f -> Result f t
Fail f
f

false :: Predicate a () t
false :: Predicate a () t
false = () -> Predicate a () t
forall f a t. f -> Predicate a f t
failure ()

infixr 3 .&.
infixr 2 .|.
infixr 2 |||

-- | A predicate corresponding to the logical AND connective
-- of two predicate.
and :: Predicate a f t -> Predicate a f t' -> Predicate a f (t ::: t')
and :: Predicate a f t -> Predicate a f t' -> Predicate a f (t ::: t')
and Predicate a f t
f Predicate a f t'
g a
x = Predicate a f t
f a
x Result f t -> Result f t' -> Result f (t ::: t')
forall f a b. Result f a -> Result f b -> Result f (a ::: b)
`cmp` Predicate a f t'
g a
x
  where
    cmp :: Result f a -> Result f b -> Result f (a ::: b)
cmp (Okay Double
d a
y) (Okay Double
w b
z) = Double -> (a ::: b) -> Result f (a ::: b)
forall f t. Double -> t -> Result f t
Okay (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w) (a
y a -> b -> a ::: b
forall a b. a -> b -> a ::: b
::: b
z)
    cmp (Okay Double
_ a
_) (Fail   f
y) = f -> Result f (a ::: b)
forall f t. f -> Result f t
Fail f
y
    cmp (Fail   f
y) Result f b
_          = f -> Result f (a ::: b)
forall f t. f -> Result f t
Fail f
y

-- | A predicate corresponding to the logical
-- OR connective of two predicates. It requires the
-- metadata of each @Okay@ branch to be of the same type.
--
-- If both arguments evaluate to @Okay@ the one with the
-- smaller \"delta\" will be preferred, or--if equal--the
-- left-hand argument.
or :: Predicate a f t -> Predicate a f t -> Predicate a f t
or :: Predicate a f t -> Predicate a f t -> Predicate a f t
or Predicate a f t
f Predicate a f t
g a
x = Predicate a f t
f a
x Result f t -> Result f t -> Result f t
forall f t. Result f t -> Result f t -> Result f t
`cmp` Predicate a f t
g a
x
  where
    cmp :: Result f t -> Result f t -> Result f t
cmp a :: Result f t
a@(Okay Double
d t
_) b :: Result f t
b@(Okay Double
w t
_)  = if Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
d then Result f t
b else Result f t
a
    cmp a :: Result f t
a@(Okay Double
_ t
_)   (Fail f
_)    = Result f t
a
    cmp (Fail f
_)     b :: Result f t
b@(Okay Double
_ t
_)  = Result f t
b
    cmp (Fail f
_)     b :: Result f t
b@(Fail f
_)    = Result f t
b

-- | A predicate corresponding to the logical
-- OR connective of two predicates. The metadata of
-- each @Okay@ branch can be of different types.
--
-- If both arguments evaluate to @Okay@ the one with the
-- smaller \"delta\" will be preferred, or--if equal--the
-- left-hand argument.
orElse :: Predicate a f t -> Predicate a f t' -> Predicate a f (Either t t')
orElse :: Predicate a f t -> Predicate a f t' -> Predicate a f (Either t t')
orElse Predicate a f t
f Predicate a f t'
g a
x = Predicate a f t
f a
x Result f t -> Result f t' -> Result f (Either t t')
forall f a f b. Result f a -> Result f b -> Result f (Either a b)
`cmp` Predicate a f t'
g a
x
  where
    cmp :: Result f a -> Result f b -> Result f (Either a b)
cmp (Okay Double
d a
y) (Okay Double
w b
z) = if Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
d then Double -> Either a b -> Result f (Either a b)
forall f t. Double -> t -> Result f t
Okay Double
w (b -> Either a b
forall a b. b -> Either a b
Right b
z) else Double -> Either a b -> Result f (Either a b)
forall f t. Double -> t -> Result f t
Okay Double
d (a -> Either a b
forall a b. a -> Either a b
Left a
y)
    cmp (Okay Double
d a
y) (Fail   f
_) = Double -> Either a b -> Result f (Either a b)
forall f t. Double -> t -> Result f t
Okay Double
d (a -> Either a b
forall a b. a -> Either a b
Left a
y)
    cmp (Fail   f
_) (Okay Double
d b
y) = Double -> Either a b -> Result f (Either a b)
forall f t. Double -> t -> Result f t
Okay Double
d (b -> Either a b
forall a b. b -> Either a b
Right b
y)
    cmp (Fail   f
_) (Fail   f
y) = f -> Result f (Either a b)
forall f t. f -> Result f t
Fail f
y

-- | Alias of 'and'.
(.&.) :: Predicate a f t -> Predicate a f t' -> Predicate a f (t ::: t')
.&. :: Predicate a f t -> Predicate a f t' -> Predicate a f (t ::: t')
(.&.) = Predicate a f t -> Predicate a f t' -> Predicate a f (t ::: t')
forall a f t t'.
Predicate a f t -> Predicate a f t' -> Predicate a f (t ::: t')
and

-- | Alias of 'or'.
(.|.) :: Predicate a f t -> Predicate a f t -> Predicate a f t
.|. :: Predicate a f t -> Predicate a f t -> Predicate a f t
(.|.) = Predicate a f t -> Predicate a f t -> Predicate a f t
forall a f t. Predicate a f t -> Predicate a f t -> Predicate a f t
or

-- | Alias of 'orElse'.
(|||) :: Predicate a f t -> Predicate a f t' -> Predicate a f (Either t t')
||| :: Predicate a f t -> Predicate a f t' -> Predicate a f (Either t t')
(|||) = Predicate a f t -> Predicate a f t' -> Predicate a f (Either t t')
forall a f t t'.
Predicate a f t -> Predicate a f t' -> Predicate a f (Either t t')
orElse

exec :: Predicate a f t -> a -> (f -> b) -> (t -> b) -> b
exec :: Predicate a f t -> a -> (f -> b) -> (t -> b) -> b
exec Predicate a f t
p a
a f -> b
g t -> b
f = case Predicate a f t
p a
a of
    Okay Double
_ t
x -> t -> b
f t
x
    Fail   f
x -> f -> b
g f
x