git.iko.soy/project-m36
on 52182bc help sign in
project-m36/src/lib/ProjectM36/DataTypes/Maybe.hs
38 lines 2.2 kB history raw
1module ProjectM36.DataTypes.Maybe where
2import ProjectM36.Base
3import ProjectM36.DataTypes.Primitive
4import ProjectM36.AtomFunctionError
5import qualified Data.HashSet as HS
6import qualified Data.Map as M
8maybeAtomType :: AtomType -> AtomType
9maybeAtomType arg = ConstructedAtomType "Maybe" (M.singleton "a" arg)
11maybeTypeConstructorMapping :: TypeConstructorMapping
12maybeTypeConstructorMapping = [(ADTypeConstructorDef "Maybe" ["a"],
13 [DataConstructorDef "Nothing" [],
14 DataConstructorDef "Just" [DataConstructorDefTypeVarNameArg "a"]])
15 ]
17maybeAtomFunctions :: AtomFunctions
18maybeAtomFunctions = HS.fromList [
19 AtomFunction {
20 atomFuncName ="isJust",
21 atomFuncType = [maybeAtomType (TypeVariableType "a"), BoolAtomType],
22 atomFuncBody = AtomFunctionBody Nothing $ \(ConstructedAtom dConsName _ _:_) -> pure $ BoolAtom (dConsName /= "Nothing")
23 },
24 AtomFunction {
25 atomFuncName = "fromMaybe",
26 atomFuncType = [TypeVariableType "a", maybeAtomType (TypeVariableType "a"), TypeVariableType "a"],
27 atomFuncBody = AtomFunctionBody Nothing $ \(defaultAtom:ConstructedAtom dConsName _ (atomVal:_):_) -> if atomTypeForAtom defaultAtom /= atomTypeForAtom atomVal then Left AtomFunctionTypeMismatchError else if dConsName == "Nothing" then pure defaultAtom else pure atomVal
28 }
29 ]
31{- To create an inclusion dependency for uniqueness for "Just a" values only
32person := relation{name Text, boss Maybe Text}{tuple{name "Steve",boss Nothing}, tuple{name "Bob", boss Just "Steve"}}
33:showexpr ((relation{tuple{}}:{a:=person where ^isJust(@boss)}):{b:=count(@a)}){b}
34:showexpr ((relation{tuple{}}:{a:=person{boss} where ^isJust(@boss)}):{b:=count(@a)}){b}
35constraint 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}
36person := relation{name Text, boss Maybe Text}{tuple{name "Steve",boss Nothing}, tuple{name "Bob", boss Just "Steve"}, tuple{name "Jim", boss Just "Steve"}}
37ERR: InclusionDependencyCheckError "uniqueJust"
38-}