module ProjectM36.DataTypes.Day where
import ProjectM36.Base
import ProjectM36.AtomFunctionBody
import ProjectM36.AtomFunctionError
import qualified Data.HashSet as HS
import Data.Time.Calendar


dayAtomFunctions :: AtomFunctions
dayAtomFunctions :: AtomFunctions
dayAtomFunctions = [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
"fromGregorian",
                 funcType :: [AtomType]
funcType = [AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
IntegerAtomType, AtomType
DayAtomType],
                 funcBody :: FunctionBody AtomFunctionBodyType
funcBody = AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType
compiledAtomFunctionBody (AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType)
-> AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType
forall a b. (a -> b) -> a -> b
$
                            \case
                              IntegerAtom Integer
year:IntegerAtom Integer
month:IntegerAtom Integer
day:[Atom]
_ -> 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
$ Day -> Atom
DayAtom (Integer -> Int -> Int -> Day
fromGregorian (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
year) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
month) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
day))
                              [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
"dayEarlierThan",
                 funcType :: [AtomType]
funcType = [AtomType
DayAtomType, AtomType
DayAtomType, AtomType
BoolAtomType],
                 funcBody :: FunctionBody AtomFunctionBodyType
funcBody = AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType
compiledAtomFunctionBody (AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType)
-> AtomFunctionBodyType -> FunctionBody AtomFunctionBodyType
forall a b. (a -> b) -> a -> b
$
                            \case
                              ConstructedAtom FunctionName
_ AtomType
_ (IntAtom Int
dayA:[Atom]
_):ConstructedAtom FunctionName
_ AtomType
_ (IntAtom Int
dayB:[Atom]
_):[Atom]
_ -> Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Atom
BoolAtom (Int
dayA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dayB))
                              [Atom]
_ -> AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError
               }
  ]