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
import qualified Data.Attoparsec.Text as APT
import Data.Scientific

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 (\case
                                 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))
                                 [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError)},
    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 (\case
                                   Atom
x:[Atom]
_ -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom
x
                                   [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
                               )},
    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 (([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
$ (Relation -> Either AtomFunctionError Atom)
-> [Atom] -> Either AtomFunctionError Atom
forall b.
(Relation -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationAtomFunc Relation -> Either AtomFunctionError Atom
relationSum
             },
    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 (([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
$ (Relation -> Either AtomFunctionError Atom)
-> [Atom] -> Either AtomFunctionError Atom
forall b.
(Relation -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationAtomFunc Relation -> Either AtomFunctionError Atom
relationCount
             },
    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 (([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
$ (Relation -> Either AtomFunctionError Atom)
-> [Atom] -> Either AtomFunctionError Atom
forall b.
(Relation -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationAtomFunc Relation -> Either AtomFunctionError Atom
relationMax 
             },
    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 (([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
$ (Relation -> Either AtomFunctionError Atom)
-> [Atom] -> Either AtomFunctionError Atom
forall b.
(Relation -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationAtomFunc Relation -> Either AtomFunctionError Atom
relationMin
             },
    Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"eq",
               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
$ \case
                                         [Atom
i1,Atom
i2] -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Atom
BoolAtom (Atom
i1 Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
i2))
                                         [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    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
$ \case
                                         [Atom
b] -> Atom -> Either AtomFunctionError Atom
boolAtomNot Atom
b
                                         [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    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
$ \case
                                [IntegerAtom Integer
v] ->
                                  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
                                [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    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
$ \case
                 [IntAtom Int
v] -> 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
                 [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    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
$ \case
                 [TextAtom FunctionName
v] ->
                   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
                 [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             }
  ] AtomFunctions -> AtomFunctions -> AtomFunctions
forall a. Semigroup a => a -> a -> a
<> AtomFunctions
scientificAtomFunctions
  where
    body :: a -> FunctionBody a
body = a -> FunctionBody a
forall a. a -> FunctionBody a
FunctionBuiltInBody
    relationAtomFunc :: (Relation -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationAtomFunc Relation -> Either AtomFunctionError b
f [RelationAtom Relation
x] = Relation -> Either AtomFunctionError b
f Relation
x
    relationAtomFunc Relation -> Either AtomFunctionError b
_ [Atom]
_ = AtomFunctionError -> Either AtomFunctionError b
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
                         
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"


scientificAtomFunctions :: AtomFunctions
scientificAtomFunctions :: AtomFunctions
scientificAtomFunctions = [Function ([Atom] -> Either AtomFunctionError Atom)]
-> AtomFunctions
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [
  Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"read_scientific",
             funcType :: [AtomType]
funcType = [AtomType
TextAtomType, AtomType
ScientificAtomType],
             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
$ \case
               TextAtom FunctionName
t:[Atom]
_ ->
                 case Parser Scientific -> FunctionName -> Either String Scientific
forall a. Parser a -> FunctionName -> Either String a
APT.parseOnly (Parser Scientific
APT.scientific Parser Scientific -> Parser FunctionName () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser FunctionName ()
forall t. Chunk t => Parser t ()
APT.endOfInput) FunctionName
t of
                   Left String
err -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left (String -> AtomFunctionError
AtomFunctionParseError String
err)
                   Right Scientific
sci -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Atom
ScientificAtom Scientific
sci)
               [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
           },
  Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"scientific",
             funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntAtomType, AtomType
ScientificAtomType],
             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
$ \case
               [IntegerAtom Integer
c,IntAtom Int
e] -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Atom
ScientificAtom (Scientific -> Atom) -> Scientific -> Atom
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific Integer
c Int
e)
               [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
           },
  Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"scientific_add",
             funcType :: [AtomType]
funcType = [AtomType]
binaryFuncType,
             funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = (Scientific -> Scientific -> Scientific)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
binaryFuncBody Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(+)
           },
  Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"scientific_subtract",
             funcType :: [AtomType]
funcType = [AtomType]
binaryFuncType,
             funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = (Scientific -> Scientific -> Scientific)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
binaryFuncBody (-)
           },
  Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"scientific_multiply",
             funcType :: [AtomType]
funcType = [AtomType]
binaryFuncType,
             funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = (Scientific -> Scientific -> Scientific)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
binaryFuncBody Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(*)
           },
  Function :: forall a.
FunctionName -> [AtomType] -> FunctionBody a -> Function a
Function { funcName :: FunctionName
funcName = FunctionName
"scientific_divide",
             funcType :: [AtomType]
funcType = [AtomType]
binaryFuncType,
             funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = (Scientific -> Scientific -> Scientific)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
binaryFuncBody Scientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
(/)
           }
  ]
  where body :: a -> FunctionBody a
body = a -> FunctionBody a
forall a. a -> FunctionBody a
FunctionBuiltInBody
        binaryFuncType :: [AtomType]
binaryFuncType = [AtomType
ScientificAtomType, AtomType
ScientificAtomType, AtomType
ScientificAtomType]
        binaryFuncBody :: (Scientific -> Scientific -> Scientific)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
binaryFuncBody Scientific -> Scientific -> Scientific
op = ([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
$ \case
          [ScientificAtom Scientific
s1, ScientificAtom Scientific
s2] -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Atom
ScientificAtom (Scientific
s1 Scientific -> Scientific -> Scientific
`op` Scientific
s2))
          [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError