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