module ProjectM36.AtomFunctions.Primitive where
import ProjectM36.Base
import ProjectM36.Relation (relFold, oneTuple)
import ProjectM36.Tuple
import ProjectM36.AtomFunctionError
import ProjectM36.AtomFunction
import ProjectM36.AtomType
import qualified Data.HashSet as HS
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 = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [
  --match on any relation type
  Function { funcName :: FunctionName
funcName = FunctionName
"add",
             funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
IntegerAtomType],
             funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body (\case
                                 IntegerAtom Integer
i1:IntegerAtom Integer
i2:[Atom]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom (Integer
i1 forall a. Num a => a -> a -> a
+ Integer
i2))
                                 [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError)},
    Function { funcName :: FunctionName
funcName = FunctionName
"abs",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body (\case
                                   IntegerAtom Integer
i:[Atom]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Atom
IntegerAtom (forall a. Num a => a -> a
abs Integer
i)
                                   [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
                               )
             },
    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 = forall {a}. a -> FunctionBody a
body (\case
                                   Atom
x:[Atom]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom
x
                                   [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
                               )},
    Function { funcName :: FunctionName
funcName = FunctionName
"sum",
               funcType :: [AtomType]
funcType = AtomType -> AtomType -> [AtomType]
foldAtomFuncType AtomType
IntegerAtomType AtomType
IntegerAtomType,
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ forall {b}.
(Relation -> FunctionName -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationFoldFunc Relation -> FunctionName -> Either AtomFunctionError Atom
relationSum
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"count",
               funcType :: [AtomType]
funcType = [AtomType
anyRelationAtomType,
                           AtomType
IntegerAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ forall {b}.
(Relation -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationAtomFunc Relation -> Either AtomFunctionError Atom
relationCount
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"max",
               funcType :: [AtomType]
funcType = AtomType -> AtomType -> [AtomType]
foldAtomFuncType AtomType
IntegerAtomType AtomType
IntegerAtomType,
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ forall {b}.
(Relation -> FunctionName -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationFoldFunc Relation -> FunctionName -> Either AtomFunctionError Atom
relationMax 
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"min",
               funcType :: [AtomType]
funcType = AtomType -> AtomType -> [AtomType]
foldAtomFuncType AtomType
IntegerAtomType AtomType
IntegerAtomType,
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ forall {b}.
(Relation -> FunctionName -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationFoldFunc Relation -> FunctionName -> Either AtomFunctionError Atom
relationMin
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"mean",
               funcType :: [AtomType]
funcType = AtomType -> AtomType -> [AtomType]
foldAtomFuncType AtomType
IntegerAtomType AtomType
IntegerAtomType,
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ forall {b}.
(Relation -> FunctionName -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationFoldFunc Relation -> FunctionName -> Either AtomFunctionError Atom
relationMean
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"eq",
               funcType :: [AtomType]
funcType = [FunctionName -> AtomType
TypeVariableType FunctionName
"a", FunctionName -> AtomType
TypeVariableType FunctionName
"a", AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ \case
                                         [Atom
i1,Atom
i2] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Atom
BoolAtom (Atom
i1 forall a. Eq a => a -> a -> Bool
== Atom
i2))
                                         [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"lt",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan Bool
False},
    Function { funcName :: FunctionName
funcName = FunctionName
"lte",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan Bool
True},
    Function { funcName :: FunctionName
funcName = FunctionName
"gte",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan Bool
False forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Atom -> Either AtomFunctionError Atom
boolAtomNot},
    Function { funcName :: FunctionName
funcName = FunctionName
"gt",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ Bool -> [Atom] -> Either AtomFunctionError Atom
integerAtomFuncLessThan Bool
True forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Atom -> Either AtomFunctionError Atom
boolAtomNot},
    Function { funcName :: FunctionName
funcName = FunctionName
"not",
               funcType :: [AtomType]
funcType = [AtomType
BoolAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ \case
                                         [Atom
b] -> Atom -> Either AtomFunctionError Atom
boolAtomNot Atom
b
                                         [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"int",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody =
                 forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ \case
                                [IntegerAtom Integer
v] ->
                                  if Integer
v forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int) then
                                    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Atom
IntAtom (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v))
                                  else
                                    forall a b. a -> Either a b
Left AtomFunctionError
InvalidIntBoundError
                                [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"integer",
               funcType :: [AtomType]
funcType = [AtomType
IntAtomType, AtomType
IntegerAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ \case
                 [IntAtom Int
v] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Integer -> Atom
IntegerAtom forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
                 [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"uuid",
               funcType :: [AtomType]
funcType = [AtomType
TextAtomType, AtomType
UUIDAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UUID -> Atom
UUIDAtom UUID
u
                       Maybe UUID
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FunctionName -> AtomFunctionError
InvalidUUIDString FunctionName
v
                 [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"and",
               funcType :: [AtomType]
funcType = [AtomType
BoolAtomType, AtomType
BoolAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ \case
                 [BoolAtom Bool
b1, BoolAtom Bool
b2] ->
                   forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> Atom
BoolAtom (Bool
b1 Bool -> Bool -> Bool
&& Bool
b2)
                 [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"or",
               funcType :: [AtomType]
funcType = [AtomType
BoolAtomType, AtomType
BoolAtomType, AtomType
BoolAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ \case
                 [BoolAtom Bool
b1, BoolAtom Bool
b2] ->
                   forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> Atom
BoolAtom (Bool
b1 Bool -> Bool -> Bool
|| Bool
b2)
                 [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError                   
             },
    Function { funcName :: FunctionName
funcName = FunctionName
"increment",
               funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType],
               funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = forall {a}. a -> FunctionBody a
body forall a b. (a -> b) -> a -> b
$ \case
                 [IntegerAtom Integer
i] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom (Integer
iforall a. Num a => a -> a -> a
+Integer
1))
                 [Atom]
_ -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
             }
    
  ] forall a. Semigroup a => a -> a -> a
<> AtomFunctions
scientificAtomFunctions
  where
    body :: a -> FunctionBody a
body = forall {a}. a -> FunctionBody a
FunctionBuiltInBody
    relationAtomFunc :: (Relation -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationAtomFunc Relation -> Either AtomFunctionError b
f [RelationAtom Relation
rel] = Relation -> Either AtomFunctionError b
f Relation
rel
    relationAtomFunc Relation -> Either AtomFunctionError b
_ [Atom]
_ = forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
    relationFoldFunc :: (Relation -> FunctionName -> Either AtomFunctionError b)
-> [Atom] -> Either AtomFunctionError b
relationFoldFunc Relation -> FunctionName -> Either AtomFunctionError b
f [SubrelationFoldAtom Relation
rel FunctionName
subAttr] = Relation -> FunctionName -> Either AtomFunctionError b
f Relation
rel FunctionName
subAttr
    relationFoldFunc Relation -> FunctionName -> Either AtomFunctionError b
_ [Atom]
_ = 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]
_) = 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 forall a. Ord a => a -> a -> Bool
(<=) else forall a. Ord a => a -> a -> Bool
(<)
integerAtomFuncLessThan Bool
_ [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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Atom
BoolAtom (Bool -> Bool
not Bool
b))
boolAtomNot Atom
_ = forall a. HasCallStack => String -> a
error String
"boolAtomNot called on non-Bool atom"

--used by sum atom function
relationSum :: Relation -> AttributeName -> Either AtomFunctionError Atom
relationSum :: Relation -> FunctionName -> Either AtomFunctionError Atom
relationSum Relation
relIn FunctionName
subAttr = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom (forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold (\RelationTuple
tupIn Integer
acc -> Integer
acc 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 =
      case FunctionName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName FunctionName
subAttr RelationTuple
tupIn of
        Left RelationalError
err -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show RelationalError
err)
        Right Atom
atom -> Atom -> Integer
castInteger Atom
atom
    
relationCount :: Relation -> Either AtomFunctionError Atom
relationCount :: Relation -> Either AtomFunctionError Atom
relationCount Relation
relIn = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom (forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold (\RelationTuple
_ Integer
acc -> Integer
acc forall a. Num a => a -> a -> a
+ Integer
1) (Integer
0::Integer) Relation
relIn))

relationMax :: Relation -> AttributeName -> Either AtomFunctionError Atom
relationMax :: Relation -> FunctionName -> Either AtomFunctionError Atom
relationMax Relation
relIn FunctionName
subAttr = case Relation -> Maybe RelationTuple
oneTuple Relation
relIn of
    Maybe RelationTuple
Nothing -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionEmptyRelationError
    Just RelationTuple
oneTup -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom (forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold (\RelationTuple
tupIn Integer
acc -> 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 =
      case FunctionName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName FunctionName
subAttr RelationTuple
tupIn of
        Left RelationalError
err -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show RelationalError
err)
        Right Atom
atom -> Atom -> Integer
castInteger Atom
atom

relationMin :: Relation -> AttributeName -> Either AtomFunctionError Atom
relationMin :: Relation -> FunctionName -> Either AtomFunctionError Atom
relationMin Relation
relIn FunctionName
subAttr = case Relation -> Maybe RelationTuple
oneTuple Relation
relIn of 
  Maybe RelationTuple
Nothing -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionEmptyRelationError
  Just RelationTuple
oneTup -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom (forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold (\RelationTuple
tupIn Integer
acc -> 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 =
      case FunctionName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName FunctionName
subAttr RelationTuple
tupIn of
        Left RelationalError
err -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show RelationalError
err)
        Right Atom
atom -> Atom -> Integer
castInteger Atom
atom


relationMean :: Relation -> AttributeName -> Either AtomFunctionError Atom
relationMean :: Relation -> FunctionName -> Either AtomFunctionError Atom
relationMean Relation
relIn FunctionName
subAttr = case Relation -> Maybe RelationTuple
oneTuple Relation
relIn of
  Maybe RelationTuple
Nothing -> forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionEmptyRelationError
  Just RelationTuple
_oneTup -> do
    let (Integer
sum'', Integer
count') = forall a. (RelationTuple -> a -> a) -> a -> Relation -> a
relFold (\RelationTuple
tupIn (Integer
sum', Integer
count) -> (Integer
sum' forall a. Num a => a -> a -> a
+ RelationTuple -> Integer
newVal RelationTuple
tupIn, Integer
count forall a. Num a => a -> a -> a
+ Integer
1)) (Integer
0, Integer
0) Relation
relIn
        newVal :: RelationTuple -> Integer
newVal RelationTuple
tupIn =
          case FunctionName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName FunctionName
subAttr RelationTuple
tupIn of
            Left RelationalError
err -> forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show RelationalError
err)
            Right Atom
atom -> Atom -> Integer
castInteger Atom
atom
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Atom
IntegerAtom (Integer
sum'' forall a. Integral a => a -> a -> a
`div` Integer
count'))
    

castInt :: Atom -> Int
castInt :: Atom -> Int
castInt (IntAtom Int
i) = Int
i
castInt Atom
_ = 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
_ = forall a. HasCallStack => String -> a
error String
"attempted to cast non-IntegerAtom to Integer"


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