git.iko.soy/project-m36
on 52182bc help sign in
project-m36/test/TutorialD/Interpreter/AtomFunctionScript.hs
114 lines 7.2 kB history raw
1import TutorialD.Interpreter.TestBase
2import System.Exit
3import Test.HUnit
4import ProjectM36.Client
5import ProjectM36.Relation
6import ProjectM36.DataTypes.Maybe
7import qualified Data.Vector as V
8import qualified Data.Map as M
10{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
11main :: IO ()
12main = do
13 tcounts <- runTestTT (TestList [testBasicAtomFunction,
14 testExceptionAtomFunction,
15 testErrorAtomFunction,
16 testNoArgumentAtomFunction,
17 testArgumentTypeMismatch,
18 testPolymorphicReturnType,
19 testScriptedTypeVariable
20 ])
21 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
23--add an atom function and run it
24testBasicAtomFunction :: Test
25testBasicAtomFunction = TestCase $ do
26 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
27 executeTutorialD sess conn "addatomfunction \"mkTest\" Integer -> Either AtomFunctionError Integer \"(\\\\(IntegerAtom x:xs) -> pure (IntegerAtom x)) :: [Atom] -> Either AtomFunctionError Atom\""
28 let attrs = [Attribute "x" IntegerAtomType]
29 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntegerAtom 3)] ()
30 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
31 expectedResult = mkRelationFromList (V.fromList attrs) [[IntegerAtom 3]]
32 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
34 assertEqual "simple atom function equality" expectedResult result
36--add an atom function which bombs out
37testExceptionAtomFunction :: Test
38testExceptionAtomFunction = TestCase $ do
39 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
40 executeTutorialD sess conn "addatomfunction \"mkTest\" Integer -> Either AtomFunctionError Integer \"\"\"(\\(IntegerAtom x:xs) -> (error (show 1))) :: [Atom] -> Either AtomFunctionError Atom\"\"\""
41 let attrs = [Attribute "x" IntegerAtomType]
42 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntegerAtom 3)] ()
43 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
44 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
45 assertBool "catch error exception from script" (case result of
46 Left (UnhandledExceptionError _) -> True
47 _ -> False)
49testErrorAtomFunction :: Test
50testErrorAtomFunction = TestCase $ do
51 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
52 executeTutorialD sess conn "addatomfunction \"errorAtom\" Integer -> Either AtomFunctionError Integer \"\"\"(\\(IntegerAtom x:xs) -> Left (AtomFunctionUserError \"user\")) :: [Atom] -> Either AtomFunctionError Atom\"\"\""
54testNoArgumentAtomFunction :: Test
55testNoArgumentAtomFunction = TestCase $ do
56 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
57 executeTutorialD sess conn "addatomfunction \"mkTest\" Either AtomFunctionError Integer \"\"\"(\\x -> pure (IntegerAtom 5)) :: [Atom] -> Either AtomFunctionError Atom\"\"\""
58 let attrs = [Attribute "x" IntegerAtomType]
59 funcAtomExpr = FunctionAtomExpr "mkTest" [] ()
60 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
61 expectedResult = mkRelationFromList (V.fromList attrs) [[IntegerAtom 5]]
62 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
63 assertEqual "no argument scripted function" expectedResult result
65testArgumentTypeMismatch :: Test
66testArgumentTypeMismatch = TestCase $ do
67 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
68 executeTutorialD sess conn "addatomfunction \"mkTest\" Integer -> Either AtomFunctionError Integer \"\"\"(\\(IntegerAtom x:_) -> pure $ TextAtom \"wrong type\") :: [Atom] -> Either AtomFunctionError Atom\"\"\""
69 let tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
70 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntegerAtom 3)] ()
71 attrs = [Attribute "x" IntegerAtomType]
72 expectedResult = Left (AtomTypeMismatchError IntegerAtomType TextAtomType)
73 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
74 assertEqual "type mismatch not detected" expectedResult result
76testPolymorphicReturnType :: Test
77testPolymorphicReturnType = TestCase $ do
78 --test that polymorphic function return type resolves to concrete type using fromMaybe builtin atom function
79 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
80 let funcAtomExpr = FunctionAtomExpr "fromMaybe" [NakedAtomExpr (IntegerAtom 5),
81 NakedAtomExpr maybeAtom] ()
82 maybeAtom = ConstructedAtom "Just" (maybeAtomType IntegerAtomType) [IntegerAtom 3]
83 relExpr = MakeRelationFromExprs Nothing [TupleExpr (M.singleton "x" funcAtomExpr)]
84 mRelType <- typeForRelationalExpr sess conn relExpr
85 case mRelType of
86 Left err -> assertFailure (show err)
87 Right relType -> do
88 let expectedRetAttrs = V.fromList [Attribute "x" IntegerAtomType]
89 assertEqual "fromMaybe type" expectedRetAttrs (attributes relType)
90 mRes <- executeRelationalExpr sess conn relExpr
91 let expectedRel = mkRelationFromList (V.fromList [Attribute "x" IntegerAtomType]) [[IntegerAtom 3]]
92 assertEqual "fromMaybe result" expectedRel mRes
93 --test that type mismatch occurs for different types appearing in same type variable
94 let failFuncAtomExpr = FunctionAtomExpr "fromMaybe" [NakedAtomExpr (IntegerAtom 5),
95 NakedAtomExpr mismatchAtom] ()
96 mismatchAtom = ConstructedAtom "Just" (maybeAtomType TextAtomType) [TextAtom "fail"]
97 failRelExpr = MakeRelationFromExprs Nothing [TupleExpr (M.singleton "x" failFuncAtomExpr)]
98 mFailRes <- executeRelationalExpr sess conn failRelExpr
99 let expectedErr = Left (AtomFunctionTypeVariableMismatch "a" IntegerAtomType TextAtomType)
100 assertEqual "expected type variable mismatch" expectedErr mFailRes
102--test that a user can create a function with a type variable argument
103testScriptedTypeVariable :: Test
104testScriptedTypeVariable = TestCase $ do
105 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
106 executeTutorialD sess conn "addatomfunction \"idTest\" a -> Either AtomFunctionError a \"(\\\\(x:_) -> pure x) :: [Atom] -> Either AtomFunctionError Atom\""
107 let attrs = [Attribute "x" IntegerAtomType]
108 funcAtomExpr = FunctionAtomExpr "idTest" [NakedAtomExpr (IntegerAtom 3)] ()
109 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
110 expectedResult = mkRelationFromList (V.fromList attrs) [[IntegerAtom 3]]
111 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
113 assertEqual "id function equality" expectedResult result