module TPDB.Data.Rule where

import Data.Typeable

data Relation = Strict |  Weak | Equal deriving ( Relation -> Relation -> Bool
(Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool) -> Eq Relation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq, Eq Relation
Eq Relation
-> (Relation -> Relation -> Ordering)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool)
-> (Relation -> Relation -> Relation)
-> (Relation -> Relation -> Relation)
-> Ord Relation
Relation -> Relation -> Bool
Relation -> Relation -> Ordering
Relation -> Relation -> Relation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Relation -> Relation -> Relation
$cmin :: Relation -> Relation -> Relation
max :: Relation -> Relation -> Relation
$cmax :: Relation -> Relation -> Relation
>= :: Relation -> Relation -> Bool
$c>= :: Relation -> Relation -> Bool
> :: Relation -> Relation -> Bool
$c> :: Relation -> Relation -> Bool
<= :: Relation -> Relation -> Bool
$c<= :: Relation -> Relation -> Bool
< :: Relation -> Relation -> Bool
$c< :: Relation -> Relation -> Bool
compare :: Relation -> Relation -> Ordering
$ccompare :: Relation -> Relation -> Ordering
$cp1Ord :: Eq Relation
Ord, Typeable, Int -> Relation -> ShowS
[Relation] -> ShowS
Relation -> String
(Int -> Relation -> ShowS)
-> (Relation -> String) -> ([Relation] -> ShowS) -> Show Relation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relation] -> ShowS
$cshowList :: [Relation] -> ShowS
show :: Relation -> String
$cshow :: Relation -> String
showsPrec :: Int -> Relation -> ShowS
$cshowsPrec :: Int -> Relation -> ShowS
Show )

data Rule a = Rule { Rule a -> a
lhs :: a, Rule a -> a
rhs :: a 
                   , Rule a -> Relation
relation :: Relation
                   , Rule a -> Bool
top :: Bool
                   }
    deriving ( Rule a -> Rule a -> Bool
(Rule a -> Rule a -> Bool)
-> (Rule a -> Rule a -> Bool) -> Eq (Rule a)
forall a. Eq a => Rule a -> Rule a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rule a -> Rule a -> Bool
$c/= :: forall a. Eq a => Rule a -> Rule a -> Bool
== :: Rule a -> Rule a -> Bool
$c== :: forall a. Eq a => Rule a -> Rule a -> Bool
Eq, Eq (Rule a)
Eq (Rule a)
-> (Rule a -> Rule a -> Ordering)
-> (Rule a -> Rule a -> Bool)
-> (Rule a -> Rule a -> Bool)
-> (Rule a -> Rule a -> Bool)
-> (Rule a -> Rule a -> Bool)
-> (Rule a -> Rule a -> Rule a)
-> (Rule a -> Rule a -> Rule a)
-> Ord (Rule a)
Rule a -> Rule a -> Bool
Rule a -> Rule a -> Ordering
Rule a -> Rule a -> Rule a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Rule a)
forall a. Ord a => Rule a -> Rule a -> Bool
forall a. Ord a => Rule a -> Rule a -> Ordering
forall a. Ord a => Rule a -> Rule a -> Rule a
min :: Rule a -> Rule a -> Rule a
$cmin :: forall a. Ord a => Rule a -> Rule a -> Rule a
max :: Rule a -> Rule a -> Rule a
$cmax :: forall a. Ord a => Rule a -> Rule a -> Rule a
>= :: Rule a -> Rule a -> Bool
$c>= :: forall a. Ord a => Rule a -> Rule a -> Bool
> :: Rule a -> Rule a -> Bool
$c> :: forall a. Ord a => Rule a -> Rule a -> Bool
<= :: Rule a -> Rule a -> Bool
$c<= :: forall a. Ord a => Rule a -> Rule a -> Bool
< :: Rule a -> Rule a -> Bool
$c< :: forall a. Ord a => Rule a -> Rule a -> Bool
compare :: Rule a -> Rule a -> Ordering
$ccompare :: forall a. Ord a => Rule a -> Rule a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Rule a)
Ord, Typeable )

strict :: Rule a -> Bool
strict :: Rule a -> Bool
strict Rule a
u = case Rule a -> Relation
forall a. Rule a -> Relation
relation Rule a
u of Relation
Strict -> Bool
True ; Relation
_ -> Bool
False

weak :: Rule a -> Bool
weak :: Rule a -> Bool
weak Rule a
u = case Rule a -> Relation
forall a. Rule a -> Relation
relation Rule a
u of Relation
Weak -> Bool
True ; Relation
_ -> Bool
False

equal :: Rule a -> Bool
equal :: Rule a -> Bool
equal Rule a
u = case Rule a -> Relation
forall a. Rule a -> Relation
relation Rule a
u of Relation
Equal -> Bool
True ; Relation
_ -> Bool
False

instance Functor Rule where 
    fmap :: (a -> b) -> Rule a -> Rule b
fmap a -> b
f Rule a
u = Rule a
u { lhs :: b
lhs = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Rule a -> a
forall a. Rule a -> a
lhs Rule a
u, rhs :: b
rhs = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Rule a -> a
forall a. Rule a -> a
rhs Rule a
u }