{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
module ProjectM36.Shortcuts where
-- users need OverloadedLabels, OverloadedLists, and default(Int,Text) to use these shortcuts.
import Data.Text hiding (foldl, map)
import ProjectM36.Base
import ProjectM36.Relation
import ProjectM36.Atomable
import Prelude hiding ((!!))
import Data.Proxy
import GHC.OverloadedLabels
import GHC.TypeLits hiding (Text)
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Data.Set as S
import GHC.Exts (IsList(..))
import Data.Convertible

default (Text)

instance IsList (AttributeNamesBase ()) where
  type Item (AttributeNamesBase ()) = AttributeName
  fromList :: [Item (AttributeNamesBase ())] -> AttributeNamesBase ()
fromList = Set AttributeName -> AttributeNamesBase ()
forall a. Set AttributeName -> AttributeNamesBase a
AttributeNames (Set AttributeName -> AttributeNamesBase ())
-> ([AttributeName] -> Set AttributeName)
-> [AttributeName]
-> AttributeNamesBase ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AttributeName] -> Set AttributeName
forall a. Ord a => [a] -> Set a
S.fromList 
  toList :: AttributeNamesBase () -> [Item (AttributeNamesBase ())]
toList (AttributeNames Set AttributeName
ns) = Set AttributeName -> [AttributeName]
forall a. Set a -> [a]
S.toList Set AttributeName
ns
  toList AttributeNamesBase ()
_ = [Char] -> [AttributeName]
forall a. HasCallStack => [Char] -> a
error [Char]
"needs AttributeNames"

instance IsList (TupleExprsBase ()) where
  type Item TupleExprs = TupleExpr
  fromList :: [Item (TupleExprsBase ())] -> TupleExprsBase ()
fromList = () -> [TupleExprBase ()] -> TupleExprsBase ()
forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs ()
  toList :: TupleExprsBase () -> [Item (TupleExprsBase ())]
toList (TupleExprs ()
_ [TupleExprBase ()]
ts) = [Item (TupleExprsBase ())]
[TupleExprBase ()]
ts

instance IsList TupleExpr where
  type Item TupleExpr = (AttributeName, AtomExpr) 
  fromList :: [Item (TupleExprBase ())] -> TupleExprBase ()
fromList [Item (TupleExprBase ())]
attributeValues = Map AttributeName (AtomExprBase ()) -> TupleExprBase ()
forall a. Map AttributeName (AtomExprBase a) -> TupleExprBase a
TupleExpr ([(AttributeName, AtomExprBase ())]
-> Map AttributeName (AtomExprBase ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(AttributeName, AtomExprBase ())]
[Item (TupleExprBase ())]
attributeValues)
  toList :: TupleExprBase () -> [Item (TupleExprBase ())]
toList (TupleExpr Map AttributeName (AtomExprBase ())
attributeValues) = Map AttributeName (AtomExprBase ())
-> [(AttributeName, AtomExprBase ())]
forall k a. Map k a -> [(k, a)]
M.toList Map AttributeName (AtomExprBase ())
attributeValues


-- #xxx :: Text
instance KnownSymbol x => IsLabel x Text where
  fromLabel :: AttributeName
fromLabel = [Char] -> AttributeName
T.pack ([Char] -> AttributeName) -> [Char] -> AttributeName
forall a b. (a -> b) -> a -> b
$ Proxy x -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x Proxy x
forall k (t :: k). Proxy t
Proxy

-- #relvarName :: RelationalExpr
instance KnownSymbol x => IsLabel x RelationalExpr where
  fromLabel :: RelationalExpr
fromLabel = AttributeName -> () -> RelationalExpr
forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable ([Char] -> AttributeName
T.pack ([Char] -> AttributeName) -> [Char] -> AttributeName
forall a b. (a -> b) -> a -> b
$ Proxy x -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x Proxy x
forall k (t :: k). Proxy t
Proxy) ()

-- *Main> #a Int :: AttributeExpr
-- NakedAttributeExpr (Attribute "a" IntAtomType)
-- *Main> #a (Attr @[Int]) :: AttributeExpr
-- NakedAttributeExpr (Attribute "a" (ConstructedAtomType "List" (fromList [("a",IntAtomType)])))
-- can't offer a Relation atomtype -- don't know how to express a Relation type in haskell type. Maybe something a HList of (Text, a) ?
--
-- ps. I don't understand the usage of "AttributeAndTypeNameExpr AttributeName TypeConstructor a"
instance (KnownSymbol x, Atomable a)=> IsLabel x (HaskAtomType a -> AttributeExpr) where
  fromLabel :: HaskAtomType a -> AttributeExpr
fromLabel = (Attribute -> AttributeExpr
forall a. Attribute -> AttributeExprBase a
NakedAttributeExpr (Attribute -> AttributeExpr)
-> (AtomType -> Attribute) -> AtomType -> AttributeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeName -> AtomType -> Attribute
Attribute AttributeName
name) (AtomType -> AttributeExpr)
-> (HaskAtomType a -> AtomType) -> HaskAtomType a -> AttributeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HaskAtomType a -> AtomType
forall a. Atomable a => HaskAtomType a -> AtomType
toAtomType''
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack ([Char] -> AttributeName) -> [Char] -> AttributeName
forall a b. (a -> b) -> a -> b
$ Proxy x -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x Proxy x
forall k (t :: k). Proxy t
Proxy

-- (#a 1) :: ExtendTupleExpr
-- no need for :=
instance (Convertible a AtomExpr, KnownSymbol x) => IsLabel x (a -> ExtendTupleExpr) where
  fromLabel :: a -> ExtendTupleExpr
fromLabel a
x = AttributeName -> AtomExprBase () -> ExtendTupleExpr
forall a. AttributeName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr AttributeName
name (a -> AtomExprBase ()
forall a b. Convertible a b => a -> b
convert a
x) 
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack ([Char] -> AttributeName) -> [Char] -> AttributeName
forall a b. (a -> b) -> a -> b
$ Proxy x -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x Proxy x
forall k (t :: k). Proxy t
Proxy

-- #name AtomExpr 
-- ex. tuple [ #name 3 ]
-- default(Text) is needed in client code to avoid `no Atomable Char`
instance (Convertible a AtomExpr, KnownSymbol x) => IsLabel x (a -> (AttributeName, AtomExpr)) where
  fromLabel :: a -> (AttributeName, AtomExprBase ())
fromLabel = \a
x -> (AttributeName
name, a -> AtomExprBase ()
forall a b. Convertible a b => a -> b
convert a
x)
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack ([Char] -> AttributeName) -> [Char] -> AttributeName
forall a b. (a -> b) -> a -> b
$ Proxy x -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x Proxy x
forall k (t :: k). Proxy t
Proxy

-- *Main> #a [1] :: AtomExpr
-- FunctionAtomExpr "a" [NakedAtomExpr (IntegerAtom 1)] ()
--
-- This usage is not working in RestrictionPredicateExpr and AttributeExtendTupleExpr. Use f "a" [1] instead.
instance (KnownSymbol x, Convertible a AtomExpr) => IsLabel x ([a] -> AtomExpr) where
  fromLabel :: [a] -> AtomExprBase ()
fromLabel = \[a]
as' -> AttributeName -> [AtomExprBase ()] -> () -> AtomExprBase ()
forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr AttributeName
name ((a -> AtomExprBase ()) -> [a] -> [AtomExprBase ()]
forall a b. (a -> b) -> [a] -> [b]
map a -> AtomExprBase ()
forall a b. Convertible a b => a -> b
convert [a]
as') ()
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack ([Char] -> AttributeName) -> [Char] -> AttributeName
forall a b. (a -> b) -> a -> b
$ Proxy x -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x Proxy x
forall k (t :: k). Proxy t
Proxy

instance (KnownSymbol x) => IsLabel x AtomExpr where
  fromLabel :: AtomExprBase ()
fromLabel = AttributeName -> AtomExprBase ()
forall a. AttributeName -> AtomExprBase a
AttributeAtomExpr AttributeName
name
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack ([Char] -> AttributeName) -> [Char] -> AttributeName
forall a b. (a -> b) -> a -> b
$ Proxy x -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x Proxy x
forall k (t :: k). Proxy t
Proxy


data HaskAtomType a where
  Int :: HaskAtomType Int
  Integer :: HaskAtomType Integer
  Double :: HaskAtomType Double
  Text :: HaskAtomType Text
--  Day :: HaskAtomType Day
--  DateTime :: HaskAtomType DateTime
--  ByteString :: HaskAtomType ByteString
  Bool :: HaskAtomType Bool
  Attr :: Atomable a => HaskAtomType a  -- a Proxy-like value for type application.

toAtomType'' :: Atomable a => HaskAtomType a -> AtomType
toAtomType'' :: HaskAtomType a -> AtomType
toAtomType'' (HaskAtomType a
_ :: HaskAtomType a) = Proxy a -> AtomType
forall a (proxy :: * -> *). Atomable a => proxy a -> AtomType
toAtomType (Proxy a
forall k (t :: k). Proxy t
Proxy @a)

-- usage: relation [tuple [#a 1, #b "b"], tuple [#a 2, #b "b"]]
relation :: [TupleExpr] -> RelationalExpr
relation :: [TupleExprBase ()] -> RelationalExpr
relation [TupleExprBase ()]
ts = Maybe [AttributeExpr] -> TupleExprsBase () -> RelationalExpr
forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs Maybe [AttributeExpr]
forall a. Maybe a
Nothing (() -> [TupleExprBase ()] -> TupleExprsBase ()
forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs () [TupleExprBase ()]
ts)

relation' :: [AttributeExprBase ()] -> [TupleExpr] -> RelationalExpr
relation' :: [AttributeExpr] -> [TupleExprBase ()] -> RelationalExpr
relation' [AttributeExpr]
as' [TupleExprBase ()]
ts = Maybe [AttributeExpr] -> TupleExprsBase () -> RelationalExpr
forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs ([AttributeExpr] -> Maybe [AttributeExpr]
forall a. a -> Maybe a
Just [AttributeExpr]
as') (() -> [TupleExprBase ()] -> TupleExprsBase ()
forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs () [TupleExprBase ()]
ts)

-- usage: tuple [#name "Mike",#age 6]
tuple :: [(AttributeName, AtomExpr)] -> TupleExprBase ()
tuple :: [(AttributeName, AtomExprBase ())] -> TupleExprBase ()
tuple [(AttributeName, AtomExprBase ())]
as' = Map AttributeName (AtomExprBase ()) -> TupleExprBase ()
forall a. Map AttributeName (AtomExprBase a) -> TupleExprBase a
TupleExpr ([(AttributeName, AtomExprBase ())]
-> Map AttributeName (AtomExprBase ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(AttributeName, AtomExprBase ())]
as')

-- #a rename  [#b `as` #c]
rename :: RelationalExpr -> [(AttributeName,AttributeName)] -> RelationalExpr 
rename :: RelationalExpr
-> [(AttributeName, AttributeName)] -> RelationalExpr
rename RelationalExpr
relExpr [(AttributeName, AttributeName)]
renameList = case [(AttributeName, AttributeName)]
renameList of 
  [] -> RestrictionPredicateExprBase () -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict RestrictionPredicateExprBase ()
forall a. RestrictionPredicateExprBase a
TruePredicate RelationalExpr
relExpr
  [(AttributeName, AttributeName)]
renames -> 
    (RelationalExpr
 -> (AttributeName, AttributeName) -> RelationalExpr)
-> RelationalExpr
-> [(AttributeName, AttributeName)]
-> RelationalExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\RelationalExpr
acc (AttributeName
old,AttributeName
new) -> AttributeName -> AttributeName -> RelationalExpr -> RelationalExpr
forall a.
AttributeName
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Rename AttributeName
old AttributeName
new  RelationalExpr
acc) RelationalExpr
relExpr [(AttributeName, AttributeName)]
renames 

--project !!
-- #a !! [#b,#c]
infix 9 !!
(!!) :: RelationalExpr -> AttributeNames -> RelationalExpr  
RelationalExpr
relExpr !! :: RelationalExpr -> AttributeNamesBase () -> RelationalExpr
!! AttributeNamesBase ()
xs = AttributeNamesBase () -> RelationalExpr -> RelationalExpr
forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNamesBase ()
xs RelationalExpr
relExpr

--join ><
-- #a >< #b
(><) :: RelationalExpr -> RelationalExpr -> RelationalExpr
RelationalExpr
a >< :: RelationalExpr -> RelationalExpr -> RelationalExpr
>< RelationalExpr
b = RelationalExpr -> RelationalExpr -> RelationalExpr
forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join RelationalExpr
a RelationalExpr
b

allBut :: AttributeNames -> AttributeNames
allBut :: AttributeNamesBase () -> AttributeNamesBase ()
allBut (AttributeNames Set AttributeName
ns) = Set AttributeName -> AttributeNamesBase ()
forall a. Set AttributeName -> AttributeNamesBase a
InvertedAttributeNames Set AttributeName
ns
allBut AttributeNamesBase ()
_ = [Char] -> AttributeNamesBase ()
forall a. HasCallStack => [Char] -> a
error [Char]
"give allBut something other than attribute names."

allFrom :: RelationalExpr -> AttributeNames
allFrom :: RelationalExpr -> AttributeNamesBase ()
allFrom = RelationalExpr -> AttributeNamesBase ()
forall a. RelationalExprBase a -> AttributeNamesBase a
RelationalExprAttributeNames 

as :: AttributeNames -> AttributeName -> (AttributeNames, AttributeName)
as :: AttributeNamesBase ()
-> AttributeName -> (AttributeNamesBase (), AttributeName)
as = (,)

-- #a `group` ([#b,#c] `as` #d)
group :: RelationalExpr -> (AttributeNames, AttributeName) -> RelationalExpr
group :: RelationalExpr
-> (AttributeNamesBase (), AttributeName) -> RelationalExpr
group RelationalExpr
relExpr (AttributeNamesBase ()
aNames, AttributeName
aName) = AttributeNamesBase ()
-> AttributeName -> RelationalExpr -> RelationalExpr
forall a.
AttributeNamesBase a
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Group AttributeNamesBase ()
aNames AttributeName
aName RelationalExpr
relExpr

-- #a `ungroup` #b
ungroup :: RelationalExpr -> AttributeName -> RelationalExpr
ungroup :: RelationalExpr -> AttributeName -> RelationalExpr
ungroup RelationalExpr
relExpr AttributeName
aName = AttributeName -> RelationalExpr -> RelationalExpr
forall a.
AttributeName -> RelationalExprBase a -> RelationalExprBase a
Ungroup AttributeName
aName RelationalExpr
relExpr

-- *Main> #a #:= true #: ( #b (f "count" [1,2]))
-- Assign "a" (Extend (AttributeExtendTupleExpr "b" (FunctionAtomExpr "count" [NakedAtomExpr (IntegerAtom 1),NakedAtomExpr (IntegerAtom 2)] ())) (ExistingRelation (Relation attributesFromList [] (RelationTupleSet {asList = [RelationTuple attributesFromList [] []]}))))
(#:) :: RelationalExpr -> ExtendTupleExpr -> RelationalExpr
RelationalExpr
a #: :: RelationalExpr -> ExtendTupleExpr -> RelationalExpr
#: ExtendTupleExpr
b = ExtendTupleExpr -> RelationalExpr -> RelationalExpr
forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend ExtendTupleExpr
b RelationalExpr
a
infix 8 #:

instance Convertible AtomExpr AtomExpr where
  safeConvert :: AtomExprBase () -> ConvertResult (AtomExprBase ())
safeConvert = AtomExprBase () -> ConvertResult (AtomExprBase ())
forall a b. b -> Either a b
Right

instance Convertible RelVarName AtomExpr where
  safeConvert :: AttributeName -> ConvertResult (AtomExprBase ())
safeConvert AttributeName
n = AtomExprBase () -> ConvertResult (AtomExprBase ())
forall a b. b -> Either a b
Right (AtomExprBase () -> ConvertResult (AtomExprBase ()))
-> AtomExprBase () -> ConvertResult (AtomExprBase ())
forall a b. (a -> b) -> a -> b
$ RelationalExpr -> AtomExprBase ()
forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr (AttributeName -> () -> RelationalExpr
forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable AttributeName
n ()) 

instance Convertible RelationalExpr AtomExpr where
  safeConvert :: RelationalExpr -> ConvertResult (AtomExprBase ())
safeConvert RelationalExpr
relExpr = AtomExprBase () -> ConvertResult (AtomExprBase ())
forall a b. b -> Either a b
Right (AtomExprBase () -> ConvertResult (AtomExprBase ()))
-> AtomExprBase () -> ConvertResult (AtomExprBase ())
forall a b. (a -> b) -> a -> b
$ RelationalExpr -> AtomExprBase ()
forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr RelationalExpr
relExpr

instance Convertible RelVarName RelationalExpr where
  safeConvert :: AttributeName -> ConvertResult RelationalExpr
safeConvert AttributeName
n = RelationalExpr -> ConvertResult RelationalExpr
forall a b. b -> Either a b
Right (RelationalExpr -> ConvertResult RelationalExpr)
-> RelationalExpr -> ConvertResult RelationalExpr
forall a b. (a -> b) -> a -> b
$ AttributeName -> () -> RelationalExpr
forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable AttributeName
n ()

-- @ in tutd
-- (@@) "aaa"
(@@) :: AttributeName -> AtomExpr
@@ :: AttributeName -> AtomExprBase ()
(@@) = AttributeName -> AtomExprBase ()
forall a. AttributeName -> AtomExprBase a
AttributeAtomExpr 

-- works in RestrictedPredicateExpr and AttributeExtendTupleExpr 
-- usage: f "gte" [1]
f :: Convertible a AtomExpr => FunctionName -> [a] -> AtomExpr
f :: AttributeName -> [a] -> AtomExprBase ()
f AttributeName
n [a]
as' = AttributeName -> [AtomExprBase ()] -> () -> AtomExprBase ()
forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr AttributeName
n ((a -> AtomExprBase ()) -> [a] -> [AtomExprBase ()]
forall a b. (a -> b) -> [a] -> [b]
map a -> AtomExprBase ()
forall a b. Convertible a b => a -> b
convert [a]
as') ()

-- DatabaseContextExpr
-- define
(#::) :: RelVarName -> [AttributeExpr] -> DatabaseContextExpr
AttributeName
s #:: :: AttributeName -> [AttributeExpr] -> DatabaseContextExpr
#:: [AttributeExpr]
xs =  AttributeName -> [AttributeExpr] -> DatabaseContextExpr
forall a.
AttributeName -> [AttributeExprBase a] -> DatabaseContextExprBase a
Define AttributeName
s [AttributeExpr]
xs
infix 5 #::

-- assign
(#:=) :: RelVarName -> RelationalExpr -> DatabaseContextExpr 
AttributeName
s #:= :: AttributeName -> RelationalExpr -> DatabaseContextExpr
#:= RelationalExpr
r = AttributeName -> RelationalExpr -> DatabaseContextExpr
forall a.
AttributeName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign AttributeName
s RelationalExpr
r
infix 5 #:=

class Boolean a b where
  (&&&) :: a -> b -> RestrictionPredicateExpr
  infixl 6 &&&
  (|||) :: a -> b -> RestrictionPredicateExpr
  infixl 5 |||

-- where: @~ mimics the restriction symbol in algebra  
-- usage: true #: (#a 1) @~ #a ?= 1 &&& not' false ||| (f "gte" [1])
(@~) :: Convertible a RestrictionPredicateExpr => RelationalExpr -> a -> RelationalExpr
@~ :: RelationalExpr -> a -> RelationalExpr
(@~) RelationalExpr
relExpr a
resPreExpr = RestrictionPredicateExprBase () -> RelationalExpr -> RelationalExpr
forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (a -> RestrictionPredicateExprBase ()
forall a b. Convertible a b => a -> b
convert a
resPreExpr) RelationalExpr
relExpr
infix 4 @~

true :: RelationalExpr
true :: RelationalExpr
true = Relation -> RelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationTrue

false :: RelationalExpr
false :: RelationalExpr
false = Relation -> RelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationFalse

trueP :: RestrictionPredicateExprBase a
trueP :: RestrictionPredicateExprBase a
trueP = RestrictionPredicateExprBase a
forall a. RestrictionPredicateExprBase a
TruePredicate

falseP :: RestrictionPredicateExprBase a
falseP :: RestrictionPredicateExprBase a
falseP = RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate RestrictionPredicateExprBase a
forall a. RestrictionPredicateExprBase a
TruePredicate

(?=) :: Convertible a AtomExpr => AttributeName -> a -> RestrictionPredicateExpr
?= :: AttributeName -> a -> RestrictionPredicateExprBase ()
(?=) AttributeName
name a
a = AttributeName -> AtomExprBase () -> RestrictionPredicateExprBase ()
forall a.
AttributeName -> AtomExprBase a -> RestrictionPredicateExprBase a
AttributeEqualityPredicate AttributeName
name (a -> AtomExprBase ()
forall a b. Convertible a b => a -> b
convert a
a)
infix 9 ?=

not' :: Convertible a RestrictionPredicateExpr => a -> RestrictionPredicateExpr
not' :: a -> RestrictionPredicateExprBase ()
not' = RestrictionPredicateExprBase () -> RestrictionPredicateExprBase ()
forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate (RestrictionPredicateExprBase ()
 -> RestrictionPredicateExprBase ())
-> (a -> RestrictionPredicateExprBase ())
-> a
-> RestrictionPredicateExprBase ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RestrictionPredicateExprBase ()
forall a b. Convertible a b => a -> b
convert

instance (Convertible a RestrictionPredicateExpr, Convertible b RestrictionPredicateExpr) => Boolean a b where
  a
a &&& :: a -> b -> RestrictionPredicateExprBase ()
&&& b
b = RestrictionPredicateExprBase ()
-> RestrictionPredicateExprBase ()
-> RestrictionPredicateExprBase ()
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate (a -> RestrictionPredicateExprBase ()
forall a b. Convertible a b => a -> b
convert a
a) (b -> RestrictionPredicateExprBase ()
forall a b. Convertible a b => a -> b
convert b
b) 
  a
a ||| :: a -> b -> RestrictionPredicateExprBase ()
||| b
b = RestrictionPredicateExprBase ()
-> RestrictionPredicateExprBase ()
-> RestrictionPredicateExprBase ()
forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
OrPredicate (a -> RestrictionPredicateExprBase ()
forall a b. Convertible a b => a -> b
convert a
a) (b -> RestrictionPredicateExprBase ()
forall a b. Convertible a b => a -> b
convert b
b)

instance {-# Incoherent #-} Atomable a => Convertible a RestrictionPredicateExpr where
  safeConvert :: a -> ConvertResult (RestrictionPredicateExprBase ())
safeConvert a
n = RestrictionPredicateExprBase ()
-> ConvertResult (RestrictionPredicateExprBase ())
forall a b. b -> Either a b
Right (RestrictionPredicateExprBase ()
 -> ConvertResult (RestrictionPredicateExprBase ()))
-> RestrictionPredicateExprBase ()
-> ConvertResult (RestrictionPredicateExprBase ())
forall a b. (a -> b) -> a -> b
$ AtomExprBase () -> RestrictionPredicateExprBase ()
forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate (AtomExprBase () -> RestrictionPredicateExprBase ())
-> AtomExprBase () -> RestrictionPredicateExprBase ()
forall a b. (a -> b) -> a -> b
$ Atom -> AtomExprBase ()
toAtomExpr (Atom -> AtomExprBase ()) -> (a -> Atom) -> a -> AtomExprBase ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Atom
forall a. Atomable a => a -> Atom
toAtom (a -> AtomExprBase ()) -> a -> AtomExprBase ()
forall a b. (a -> b) -> a -> b
$ a
n 

instance {-# Incoherent #-} Convertible RelationalExpr RestrictionPredicateExpr where
  safeConvert :: RelationalExpr -> ConvertResult (RestrictionPredicateExprBase ())
safeConvert RelationalExpr
a = RestrictionPredicateExprBase ()
-> ConvertResult (RestrictionPredicateExprBase ())
forall a b. b -> Either a b
Right (RestrictionPredicateExprBase ()
 -> ConvertResult (RestrictionPredicateExprBase ()))
-> RestrictionPredicateExprBase ()
-> ConvertResult (RestrictionPredicateExprBase ())
forall a b. (a -> b) -> a -> b
$ RelationalExpr -> RestrictionPredicateExprBase ()
forall a. RelationalExprBase a -> RestrictionPredicateExprBase a
RelationalExprPredicate RelationalExpr
a
 
instance {-# Incoherent #-} Convertible AtomExpr RestrictionPredicateExpr where
  safeConvert :: AtomExprBase () -> ConvertResult (RestrictionPredicateExprBase ())
safeConvert AtomExprBase ()
a = RestrictionPredicateExprBase ()
-> ConvertResult (RestrictionPredicateExprBase ())
forall a b. b -> Either a b
Right (RestrictionPredicateExprBase ()
 -> ConvertResult (RestrictionPredicateExprBase ()))
-> RestrictionPredicateExprBase ()
-> ConvertResult (RestrictionPredicateExprBase ())
forall a b. (a -> b) -> a -> b
$ AtomExprBase () -> RestrictionPredicateExprBase ()
forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate AtomExprBase ()
a

instance {-# Incoherent #-} Convertible RestrictionPredicateExpr RestrictionPredicateExpr where
  safeConvert :: RestrictionPredicateExprBase ()
-> ConvertResult (RestrictionPredicateExprBase ())
safeConvert = RestrictionPredicateExprBase ()
-> ConvertResult (RestrictionPredicateExprBase ())
forall a b. b -> Either a b
Right

instance {-# Incoherent #-} Atomable a => Convertible a AtomExpr where
  safeConvert :: a -> ConvertResult (AtomExprBase ())
safeConvert a
n = AtomExprBase () -> ConvertResult (AtomExprBase ())
forall a b. b -> Either a b
Right (AtomExprBase () -> ConvertResult (AtomExprBase ()))
-> AtomExprBase () -> ConvertResult (AtomExprBase ())
forall a b. (a -> b) -> a -> b
$ Atom -> AtomExprBase ()
toAtomExpr (Atom -> AtomExprBase ()) -> (a -> Atom) -> a -> AtomExprBase ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Atom
forall a. Atomable a => a -> Atom
toAtom (a -> AtomExprBase ()) -> a -> AtomExprBase ()
forall a b. (a -> b) -> a -> b
$ a
n 

toAtomExpr :: Atom -> AtomExpr
toAtomExpr :: Atom -> AtomExprBase ()
toAtomExpr (ConstructedAtom AttributeName
n AtomType
_ [Atom]
xs) = AttributeName -> [AtomExprBase ()] -> () -> AtomExprBase ()
forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr AttributeName
n (Atom -> AtomExprBase ()
toAtomExpr (Atom -> AtomExprBase ()) -> [Atom] -> [AtomExprBase ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Atom]
xs) () 
toAtomExpr Atom
a = Atom -> AtomExprBase ()
forall a. Atom -> AtomExprBase a
NakedAtomExpr Atom
a