module ProjectM36.AtomFunctions.Primitive where
import ProjectM36.Base
import ProjectM36.Relation (relFold, oneTuple)
import ProjectM36.Tuple
import ProjectM36.AtomFunctionError
import ProjectM36.AtomFunction
import qualified Data.HashSet as HS
import qualified Data.Vector as V
import Control.Monad
import qualified Data.UUID as U
import qualified Data.Text as T

primitiveAtomFunctions :: AtomFunctions
primitiveAtomFunctions :: AtomFunctions
primitiveAtomFunctions = [Function ([Atom] -> Either AtomFunctionError Atom)]
-> AtomFunctions
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [
  --match on any relation type
  Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"add",
             funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
IntegerAtomType],
             funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (\(IntegerAtom Integer
i1:IntegerAtom Integer
i2:[Atom]
_) -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom (Integer
i1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i2)))},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"id",
               funcType :: [AtomType]
funcType = [FunctionName -> AtomType
TypeVariableType FunctionName
"a", FunctionName -> AtomType
TypeVariableType FunctionName
"a"],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (\(Atom
x:[Atom]
_) -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom
x)},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"sum",
               funcType :: [AtomType]
funcType = AtomType -> AtomType -> [AtomType]
foldAtomFuncType AtomType
IntegerAtomType AtomType
IntegerAtomType,
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (\(RelationAtom Relation
rel:[Atom]
_) -> Relation -> Either AtomFunctionError Atom
relationSum Relation
rel)},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"count",
               funcType :: [AtomType]
funcType = AtomType -> AtomType -> [AtomType]
foldAtomFuncType (FunctionName -> AtomType
TypeVariableType FunctionName
"a") AtomType
IntegerAtomType,
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (\(RelationAtom Relation
relIn:[Atom]
_) -> Relation -> Either AtomFunctionError Atom
relationCount Relation
relIn)},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"max",
               funcType :: [AtomType]
funcType = AtomType -> AtomType -> [AtomType]
foldAtomFuncType AtomType
IntegerAtomType AtomType
IntegerAtomType,
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (\(RelationAtom Relation
relIn:[Atom]
_) -> Relation -> Either AtomFunctionError Atom
relationMax Relation
relIn)},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"min",
               funcType :: [AtomType]
funcType = AtomType -> AtomType -> [AtomType]
foldAtomFuncType AtomType
IntegerAtomType AtomType
IntegerAtomType,
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (\(RelationAtom Relation
relIn:[Atom]
_) -> Relation -> Either AtomFunctionError Atom
relationMin Relation
relIn)},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"lt",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan Bool
False},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"lte",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan Bool
True},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"gte",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan Bool
False ([Atom] -> Either AtomFunctionError Atom)
-> (Atom -> Either AtomFunctionError Atom)
-> [Atom]
-> Either AtomFunctionError Atom
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Atom -> Either AtomFunctionError Atom
boolAtomNot},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"gt",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan Bool
True ([Atom] -> Either AtomFunctionError Atom)
-> (Atom -> Either AtomFunctionError Atom)
-> [Atom]
-> Either AtomFunctionError Atom
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Atom -> Either AtomFunctionError Atom
boolAtomNot},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"not",
               funcType :: [AtomType]
funcType = [AtomType
BoolAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ \(Atom
b:[Atom]
_) -> Atom -> Either AtomFunctionError Atom
boolAtomNot Atom
b },
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"int",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody =
                 ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ \(IntegerAtom Integer
v:[Atom]
_) ->
                          if Integer
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int) then
                            
                            Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Atom
IntAtom (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v))
                          else
                            AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
InvalidIntBoundError
             },
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"integer",
               funcType :: [AtomType]
funcType = [AtomType
IntAtomType, AtomType
IntegerAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ \(IntAtom Int
v:[Atom]
_) -> Atom -> Either AtomFunctionError Atom
forall a b. b -> Either a b
Right (Atom -> Either AtomFunctionError Atom)
-> Atom -> Either AtomFunctionError Atom
forall a b. (a -> b) -> a -> b
$ Integer -> Atom
IntegerAtom (Integer -> Atom) -> Integer -> Atom
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v},
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"uuid",
               funcType :: [AtomType]
funcType = [AtomType
TextAtomType, AtomType
UUIDAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
body (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ \(TextAtom FunctionName
v:[Atom]
_) ->
                 let mUUID :: Maybe UUID
mUUID = String -> Maybe UUID
U.fromString (FunctionName -> String
T.unpack FunctionName
v) in
                   case Maybe UUID
mUUID of
                     Just UUID
u -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either AtomFunctionError Atom)
-> Atom -> Either AtomFunctionError Atom
forall a b. (a -> b) -> a -> b
$ UUID -> Atom
UUIDAtom UUID
u
                     Maybe UUID
Nothing -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left (AtomFunctionError -> Either AtomFunctionError Atom)
-> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. (a -> b) -> a -> b
$ FunctionName -> AtomFunctionError
InvalidUUIDString FunctionName
v
             }
  ]
  where
    body :: a -> FunctionBody a
body = a -> FunctionBody a
forall a. a -> FunctionBody a
FunctionBuiltInBody
                         
integerAtomFuncLessThan :: Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan :: Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan Bool
equality (IntegerAtom Integer
i1:IntegerAtom Integer
i2:[Atom]
_) = Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Atom
BoolAtom (Integer
i1 Integer -> Integer -> Bool
`op` Integer
i2))
  where
    op :: Integer -> Integer -> Bool
op = if Bool
equality then Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=) else Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<)
integerAtomFuncLessThan Bool
_ [Atom]
_= Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Atom
BoolAtom Bool
False)

boolAtomNot :: Atom -> Either AtomFunctionError Atom
boolAtomNot :: Atom -> Either AtomFunctionError Atom
boolAtomNot (BoolAtom Bool
b) = Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Atom
BoolAtom (Bool -> Bool
not Bool
b))
boolAtomNot Atom
_ = String -> Either AtomFunctionError Atom
forall a. HasCallStack => String -> a
error String
"boolAtomNot called on non-Bool atom"

--used by sum atom function
relationSum :: Relation -> Either AtomFunctionError Atom
relationSum :: Relation -> Either AtomFunctionError Atom
relationSum Relation
relIn = Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom ((RelationTuple -> Integer -> Integer)
-> Integer -> Relation -> Integer
forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold (\RelationTuple
tupIn Integer
acc -> Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ RelationTuple -> Integer
newVal RelationTuple
tupIn) Integer
0 Relation
relIn))
  where
    --extract Integer from Atom
    newVal :: RelationTuple -> Integer
newVal RelationTuple
tupIn = Atom -> Integer
castInteger (RelationTuple -> Vector Atom
tupleAtoms RelationTuple
tupIn Vector Atom -> Int -> Atom
forall a. Vector a -> Int -> a
V.! Int
0)
    
relationCount :: Relation -> Either AtomFunctionError Atom
relationCount :: Relation -> Either AtomFunctionError Atom
relationCount Relation
relIn = Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom ((RelationTuple -> Integer -> Integer)
-> Integer -> Relation -> Integer
forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold (\RelationTuple
_ Integer
acc -> Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) (Integer
0::Integer) Relation
relIn))

relationMax :: Relation -> Either AtomFunctionError Atom
relationMax :: Relation -> Either AtomFunctionError Atom
relationMax Relation
relIn = case Relation -> Maybe RelationTuple
oneTuple Relation
relIn of
    Maybe RelationTuple
Nothing -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionEmptyRelationError
    Just RelationTuple
oneTup -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom ((RelationTuple -> Integer -> Integer)
-> Integer -> Relation -> Integer
forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold (\RelationTuple
tupIn Integer
acc -> Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
acc (RelationTuple -> Integer
newVal RelationTuple
tupIn)) (RelationTuple -> Integer
newVal RelationTuple
oneTup) Relation
relIn))
  where
    newVal :: RelationTuple -> Integer
newVal RelationTuple
tupIn = Atom -> Integer
castInteger (RelationTuple -> Vector Atom
tupleAtoms RelationTuple
tupIn Vector Atom -> Int -> Atom
forall a. Vector a -> Int -> a
V.! Int
0)

relationMin :: Relation -> Either AtomFunctionError Atom
relationMin :: Relation -> Either AtomFunctionError Atom
relationMin Relation
relIn = case Relation -> Maybe RelationTuple
oneTuple Relation
relIn of 
  Maybe RelationTuple
Nothing -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionEmptyRelationError
  Just RelationTuple
oneTup -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom ((RelationTuple -> Integer -> Integer)
-> Integer -> Relation -> Integer
forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold (\RelationTuple
tupIn Integer
acc -> Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
acc (RelationTuple -> Integer
newVal RelationTuple
tupIn)) (RelationTuple -> Integer
newVal RelationTuple
oneTup) Relation
relIn))
  where
    newVal :: RelationTuple -> Integer
newVal RelationTuple
tupIn = Atom -> Integer
castInteger (RelationTuple -> Vector Atom
tupleAtoms RelationTuple
tupIn Vector Atom -> Int -> Atom
forall a. Vector a -> Int -> a
V.! Int
0)

castInt :: Atom -> Int
castInt :: Atom -> Int
castInt (IntAtom Int
i) = Int
i
castInt Atom
_ = String -> Int
forall a. HasCallStack => String -> a
error String
"attempted to cast non-IntAtom to Int"

castInteger :: Atom -> Integer
castInteger :: Atom -> Integer
castInteger (IntegerAtom Integer
i) = Integer
i 
castInteger Atom
_ = String -> Integer
forall a. HasCallStack => String -> a
error String
"attempted to cast non-IntegerAtom to Int"