module ProjectM36.DataTypes.DateTime where
import ProjectM36.Base
import ProjectM36.AtomFunctionBody
import qualified Data.HashSet as HS
import Data.Time.Clock.POSIX

dateTimeAtomFunctions :: AtomFunctions
dateTimeAtomFunctions :: AtomFunctions
dateTimeAtomFunctions = [Function AtomFunctionBodyType] -> 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
"dateTimeFromEpochSeconds",
                                     funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
DateTimeAtomType],
                                     funcBody :: FunctionBody AtomFunctionBodyType
funcBody = AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType
compiledAtomFunctionBody (AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType)
-> AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType
forall a b. (a -> b) -> a -> b
$ \(IntegerAtom Integer
epoch:[Atom]
_) -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> Atom
DateTimeAtom (POSIXTime -> UTCTime
posixSecondsToUTCTime (Integer -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
epoch)))
                                                                                                       }]