module ProjectM36.DataTypes.Primitive where
import ProjectM36.Base

primitiveTypeConstructorMapping :: TypeConstructorMapping
primitiveTypeConstructorMapping :: TypeConstructorMapping
primitiveTypeConstructorMapping = (TypeConstructorDef, [DataConstructorDef])
boolMapping forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\(TypeConstructorName
name, AtomType
aType) ->
                                  (TypeConstructorName -> AtomType -> TypeConstructorDef
PrimitiveTypeConstructorDef TypeConstructorName
name AtomType
aType, [])) [(TypeConstructorName, AtomType)]
prims
  where
    prims :: [(TypeConstructorName, AtomType)]
prims = [(TypeConstructorName
"Integer", AtomType
IntegerAtomType),
             (TypeConstructorName
"Int", AtomType
IntAtomType),
             (TypeConstructorName
"Text", AtomType
TextAtomType),
             (TypeConstructorName
"Double", AtomType
DoubleAtomType),
             (TypeConstructorName
"UUID", AtomType
UUIDAtomType),
             (TypeConstructorName
"ByteString", AtomType
ByteStringAtomType),
             (TypeConstructorName
"DateTime", AtomType
DateTimeAtomType),
             (TypeConstructorName
"Day", AtomType
DayAtomType)
            ]
    boolMapping :: (TypeConstructorDef, [DataConstructorDef])
boolMapping = (TypeConstructorName -> AtomType -> TypeConstructorDef
PrimitiveTypeConstructorDef TypeConstructorName
"Bool" AtomType
BoolAtomType,
                   [TypeConstructorName
-> [DataConstructorDefArg] -> DataConstructorDef
DataConstructorDef TypeConstructorName
"True" [],
                    TypeConstructorName
-> [DataConstructorDefArg] -> DataConstructorDef
DataConstructorDef TypeConstructorName
"False" []])
            
intTypeConstructor :: TypeConstructor            
intTypeConstructor :: TypeConstructor
intTypeConstructor = forall a. TypeConstructorName -> AtomType -> TypeConstructorBase a
PrimitiveTypeConstructor TypeConstructorName
"Int" AtomType
IntAtomType

doubleTypeConstructor :: TypeConstructor
doubleTypeConstructor :: TypeConstructor
doubleTypeConstructor = forall a. TypeConstructorName -> AtomType -> TypeConstructorBase a
PrimitiveTypeConstructor TypeConstructorName
"Double" AtomType
DoubleAtomType

textTypeConstructor :: TypeConstructor
textTypeConstructor :: TypeConstructor
textTypeConstructor = forall a. TypeConstructorName -> AtomType -> TypeConstructorBase a
PrimitiveTypeConstructor TypeConstructorName
"Text" AtomType
TextAtomType

dayTypeConstructor :: TypeConstructor
dayTypeConstructor :: TypeConstructor
dayTypeConstructor = forall a. TypeConstructorName -> AtomType -> TypeConstructorBase a
PrimitiveTypeConstructor TypeConstructorName
"Day" AtomType
DayAtomType

dateTimeTypeConstructor :: TypeConstructor
dateTimeTypeConstructor :: TypeConstructor
dateTimeTypeConstructor = forall a. TypeConstructorName -> AtomType -> TypeConstructorBase a
PrimitiveTypeConstructor TypeConstructorName
"DateTime" AtomType
DayAtomType

uUIDTypeConstructor :: TypeConstructor
uUIDTypeConstructor :: TypeConstructor
uUIDTypeConstructor = forall a. TypeConstructorName -> AtomType -> TypeConstructorBase a
PrimitiveTypeConstructor TypeConstructorName
"UUID" AtomType
UUIDAtomType

-- | Return the type of an 'Atom'.
atomTypeForAtom :: Atom -> AtomType
atomTypeForAtom :: Atom -> AtomType
atomTypeForAtom (IntAtom Int
_) = AtomType
IntAtomType
atomTypeForAtom (IntegerAtom Integer
_) = AtomType
IntegerAtomType
atomTypeForAtom (ScientificAtom Scientific
_) = AtomType
ScientificAtomType
atomTypeForAtom (DoubleAtom Double
_) = AtomType
DoubleAtomType
atomTypeForAtom (TextAtom TypeConstructorName
_) = AtomType
TextAtomType
atomTypeForAtom (DayAtom Day
_) = AtomType
DayAtomType
atomTypeForAtom (DateTimeAtom UTCTime
_) = AtomType
DateTimeAtomType
atomTypeForAtom (ByteStringAtom ByteString
_) = AtomType
ByteStringAtomType
atomTypeForAtom (BoolAtom Bool
_) = AtomType
BoolAtomType
atomTypeForAtom (UUIDAtom UUID
_) = AtomType
UUIDAtomType
atomTypeForAtom (RelationAtom (Relation Attributes
attrs RelationTupleSet
_)) = Attributes -> AtomType
RelationAtomType Attributes
attrs
atomTypeForAtom (ConstructedAtom TypeConstructorName
_ AtomType
aType [Atom]
_) = AtomType
aType
atomTypeForAtom (RelationalExprAtom RelationalExpr
_) = AtomType
RelationalExprAtomType