module ProjectM36.DataTypes.Maybe where
import ProjectM36.Base
import ProjectM36.DataTypes.Primitive
import ProjectM36.AtomFunctionError
import qualified Data.HashSet as HS
import qualified Data.Map as M

maybeAtomType :: AtomType -> AtomType
maybeAtomType :: AtomType -> AtomType
maybeAtomType AtomType
arg = TypeConstructorName -> TypeVarMap -> AtomType
ConstructedAtomType TypeConstructorName
"Maybe" (TypeConstructorName -> AtomType -> TypeVarMap
forall k a. k -> a -> Map k a
M.singleton TypeConstructorName
"a" AtomType
arg)
  
maybeTypeConstructorMapping :: TypeConstructorMapping
maybeTypeConstructorMapping :: TypeConstructorMapping
maybeTypeConstructorMapping = [(TypeConstructorName -> [TypeConstructorName] -> TypeConstructorDef
ADTypeConstructorDef TypeConstructorName
"Maybe" [TypeConstructorName
"a"],
                                [TypeConstructorName
-> [DataConstructorDefArg] -> DataConstructorDef
DataConstructorDef TypeConstructorName
"Nothing" [],
                                 TypeConstructorName
-> [DataConstructorDefArg] -> DataConstructorDef
DataConstructorDef TypeConstructorName
"Just" [TypeConstructorName -> DataConstructorDefArg
DataConstructorDefTypeVarNameArg TypeConstructorName
"a"]])
                              ]

maybeAtomFunctions :: AtomFunctions
maybeAtomFunctions :: AtomFunctions
maybeAtomFunctions = [Function ([Atom] -> Either AtomFunctionError Atom)]
-> AtomFunctions
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [
  Function :: forall a.
TypeConstructorName -> [AtomType] -> FunctionBody a -> Function a
Function {
     funcName :: TypeConstructorName
funcName =TypeConstructorName
"isJust",
     funcType :: [AtomType]
funcType = [AtomType -> AtomType
maybeAtomType (TypeConstructorName -> AtomType
TypeVariableType TypeConstructorName
"a"), AtomType
BoolAtomType],
     funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
FunctionBuiltInBody (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ \(ConstructedAtom TypeConstructorName
dConsName AtomType
_ [Atom]
_:[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
$ Bool -> Atom
BoolAtom (TypeConstructorName
dConsName TypeConstructorName -> TypeConstructorName -> Bool
forall a. Eq a => a -> a -> Bool
/= TypeConstructorName
"Nothing")
     },
  Function :: forall a.
TypeConstructorName -> [AtomType] -> FunctionBody a -> Function a
Function {
     funcName :: TypeConstructorName
funcName = TypeConstructorName
"fromMaybe",
     funcType :: [AtomType]
funcType = [TypeConstructorName -> AtomType
TypeVariableType TypeConstructorName
"a", AtomType -> AtomType
maybeAtomType (TypeConstructorName -> AtomType
TypeVariableType TypeConstructorName
"a"), TypeConstructorName -> AtomType
TypeVariableType TypeConstructorName
"a"],
     funcBody :: FunctionBody ([Atom] -> Either AtomFunctionError Atom)
funcBody = ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a. a -> FunctionBody a
FunctionBuiltInBody (([Atom] -> Either AtomFunctionError Atom)
 -> FunctionBody ([Atom] -> Either AtomFunctionError Atom))
-> ([Atom] -> Either AtomFunctionError Atom)
-> FunctionBody ([Atom] -> Either AtomFunctionError Atom)
forall a b. (a -> b) -> a -> b
$ \(Atom
defaultAtom:ConstructedAtom TypeConstructorName
dConsName AtomType
_ (Atom
atomVal:[Atom]
_):[Atom]
_) -> if Atom -> AtomType
atomTypeForAtom Atom
defaultAtom AtomType -> AtomType -> Bool
forall a. Eq a => a -> a -> Bool
/= Atom -> AtomType
atomTypeForAtom Atom
atomVal then AtomFunctionError -> Either AtomFunctionError Atom
forall a b. a -> Either a b
Left AtomFunctionError
AtomFunctionTypeMismatchError else if TypeConstructorName
dConsName TypeConstructorName -> TypeConstructorName -> Bool
forall a. Eq a => a -> a -> Bool
== TypeConstructorName
"Nothing" then Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom
defaultAtom else Atom -> Either AtomFunctionError Atom
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom
atomVal
     }
  ]

{- To create an inclusion dependency for uniqueness for "Just a" values only 
person := relation{name Text, boss Maybe Text}{tuple{name "Steve",boss Nothing}, tuple{name "Bob", boss Just "Steve"}}
:showexpr ((relation{tuple{}}:{a:=person where ^isJust(@boss)}):{b:=count(@a)}){b}
:showexpr ((relation{tuple{}}:{a:=person{boss} where ^isJust(@boss)}):{b:=count(@a)}){b}
constraint uniqueJust ((relation{tuple{}}:{a:=person where ^isJust(@boss)}):{b:=count(@a)}){b} in ((relation{tuple{}}:{a:=person{boss} where ^isJust(@boss)}):{b:=count(@a)}){b}
person := relation{name Text, boss Maybe Text}{tuple{name "Steve",boss Nothing}, tuple{name "Bob", boss Just "Steve"}, tuple{name "Jim", boss Just "Steve"}} 
ERR: InclusionDependencyCheckError "uniqueJust"
-}