git.iko.soy/project-m36
on 3a76afa help sign in
project-m36/test/TutorialD/Interpreter.hs
236 lines 18 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2import TutorialD.Interpreter.DatabaseExpr
3import TutorialD.Interpreter
4import TutorialD.Interpreter.Base
5import Test.HUnit
6import ProjectM36.RelationalExpression
7import ProjectM36.Relation
8import ProjectM36.Tuple
9import ProjectM36.TupleSet
10import ProjectM36.Error
11import ProjectM36.Base
12import ProjectM36.TransactionGraph
13import ProjectM36.Client
14import ProjectM36.Atom
15import qualified ProjectM36.Attribute as A
16import qualified Data.Map as M
17import System.Exit
18import Data.Maybe (isJust)
19import System.IO
20import qualified Data.Vector as V
21import Data.Text.Encoding as TE
22import Data.Typeable (Proxy(..))
23import Data.Text (Text)
24import Data.Time.Clock (UTCTime(..))
25import Data.Time.Calendar (fromGregorian)
26import Data.Interval (interval, Interval, Extended(Finite))
28main :: IO ()
29main = do
30 tcounts <- runTestTT (TestList tests)
31 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
32 where
33 tests = map (\(tutd, expected) -> TestCase $ assertTutdEqual basicDatabaseContext expected tutd) simpleRelTests ++ map (\(tutd, expected) -> TestCase $ assertTutdEqual dateExamples expected tutd) dateExampleRelTests ++ [transactionGraphBasicTest, transactionGraphAddCommitTest, transactionRollbackTest, transactionJumpTest, transactionBranchTest, simpleJoinTest]
34 simpleRelTests = [("x:=true", Right relationTrue),
35 ("x:=false", Right relationFalse),
36 ("x:=true union false", Right relationTrue),
37 ("x:=true; x:=false", Right relationFalse),
38 ("x:=relation{a int}", mkRelation simpleAAttributes emptyTupleSet),
39 ("x:=relation{c int} rename {c as d}", mkRelation simpleBAttributes emptyTupleSet),
40 ("y:=relation{b int, c int}; x:=y{c}", mkRelation simpleProjectionAttributes emptyTupleSet),
41 ("x:=relation{tuple{a \"spam\", b 5}}", mkRelation simpleCAttributes $ RelationTupleSet [(RelationTuple simpleCAttributes) (V.fromList [stringAtom "spam", intAtom 5])]),
42 ("constraint failc true in false; x:=true", Left $ InclusionDependencyCheckError "failc"),
43 ("x:=y; x:=true", Left $ RelVarNotDefinedError "y"),
44 ("x:=true where true", Right relationTrue),
45 ("x:=true where false", Right relationFalse),
46 ("x:=true where true or false", Right relationTrue),
47 ("x:=true where false or false", Right relationFalse),
48 ("x:=true where true and false", Right relationFalse),
49 ("x:=true where true and true", Right relationTrue),
50 ("x:=true=true", Right relationTrue),
51 ("x:=true=false", Right relationFalse),
52 ("x:=true; undefine x", Left (RelVarNotDefinedError "x")),
53 ("x:=relation {b int, a char}; insert x relation{tuple{b 5, a \"spam\"}}", mkRelationFromTuples simpleCAttributes [RelationTuple simpleCAttributes $ V.fromList[stringAtom "spam", intAtom 5]]),
54 -- test nested relation constructor
55 ("x:=relation{tuple{a 5, b relation{tuple{a 6}}}}", mkRelation nestedRelationAttributes $ RelationTupleSet [RelationTuple nestedRelationAttributes (V.fromList [intAtom 5, Atom (Relation simpleAAttributes $ RelationTupleSet [RelationTuple simpleAAttributes $ V.fromList [intAtom 6]])])]),
56 ("x:=relation{tuple{b 5,a \"spam\"},tuple{b 6,a \"sam\"}}; delete x where b=6", mkRelation simpleCAttributes $ RelationTupleSet [RelationTuple simpleCAttributes (V.fromList [stringAtom "spam", intAtom 5])]),
57 ("x:=relation{tuple{a 5}} : {b:=@a}", mkRelation simpleDAttributes $ RelationTupleSet [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 5])]),
58 ("x:=relation{tuple{a 5}} : {b:=6}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 6])]),
59 ("x:=relation{tuple{a 5}} : {b:=add(@a,5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 10])]),
60 ("x:=relation{tuple{a 5}} : {b:=add(@a,\"spam\")}", Left (AtomFunctionTypeError "add" 2 intAtomType stringAtomType)),
61 ("x:=relation{tuple{a 5}} : {b:=add(add(@a,2),5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 12])])
62 ]
63 simpleAAttributes = A.attributesFromList [Attribute "a" intAtomType]
64 simpleBAttributes = A.attributesFromList [Attribute "d" intAtomType]
65 simpleCAttributes = A.attributesFromList [Attribute "a" stringAtomType, Attribute "b" intAtomType]
66 simpleDAttributes = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" intAtomType]
67 simpleMaybeTextAttributes = A.attributesFromList [Attribute "a" $ atomTypeForProxy (Proxy :: Proxy (Maybe Text))]
68 simpleMaybeIntAttributes = A.attributesFromList [Attribute "a" $ atomTypeForProxy (Proxy :: Proxy (Maybe Int))]
69 simpleIntervalDateTimeAttributes = A.attributesFromList [Attribute "a" $ atomTypeForProxy (Proxy :: Proxy (Interval UTCTime))]
70 simpleProjectionAttributes = A.attributesFromList [Attribute "c" intAtomType]
71 nestedRelationAttributes = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" (RelationAtomType $ A.attributesFromList [Attribute "a" intAtomType])]
72 extendTestAttributes = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" $ RelationAtomType (attributes suppliersRel)]
73 byteStringAttributes = A.attributesFromList [Attribute "y" byteStringAtomType]
74 groupCountAttrs = A.attributesFromList [Attribute "z" intAtomType]
75 minMaxAttrs = A.attributesFromList [Attribute "S#" stringAtomType, Attribute "z" intAtomType]
76 dateExampleRelTests = [("x:=S where true", Right suppliersRel),
77 ("x:=S where CITY = \"London\"", restrict (\tuple -> atomForAttributeName "CITY" tuple == (Right $ stringAtom "London")) suppliersRel),
78 ("x:=S where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),
79 ("x:=P where COLOR=\"Blue\" and CITY=\"Paris\"", mkRelationFromList (attributes productsRel) [[stringAtom "P5", stringAtom "Cam", stringAtom "Blue", intAtom 12, stringAtom "Paris"]]),
80 ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (A.attributesFromList [Attribute "STATUS" intAtomType]) (RelationTupleSet [mkRelationTuple (A.attributesFromList [Attribute "STATUS" intAtomType]) (V.fromList [intAtom 50])])),
81 --atom function tests
82 ("x:=((S : {STATUS2 := add(10,@STATUS)}) where STATUS2=add(10,@STATUS)){CITY,S#,SNAME,STATUS}", Right suppliersRel),
83 ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "SNAME" tuple == (Right $ stringAtom "Blake") then updateTuple (M.singleton "CITY" (stringAtom "Boston")) tuple else tuple) suppliersRel),
84 ("x:=relation{tuple{a 5}} : {b:=S}", mkRelation extendTestAttributes (RelationTupleSet [mkRelationTuple extendTestAttributes (V.fromList [intAtom 5, Atom suppliersRel])])),
85 --relatom function tests
86 ("x:=((S group ({CITY} as y)):{z:=count(@y)}){z}", mkRelation groupCountAttrs (RelationTupleSet [mkRelationTuple groupCountAttrs (V.singleton $ intAtom 1)])),
87 ("x:=(SP group ({S#} as y)) ungroup y", Right supplierProductsRel),
88 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=max(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [stringAtom s,intAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),
89 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=min(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [stringAtom s,intAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),
90 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=sum(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [stringAtom s,intAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),
91 --boolean function restriction
92 ("x:=S where ^lt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[stringAtom "S2", stringAtom "Jones", intAtom 10, stringAtom "Paris"]]),
93 ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[stringAtom "S3", stringAtom "Blake", intAtom 30, stringAtom "Paris"],
94 [stringAtom "S5", stringAtom "Adams", intAtom 30, stringAtom "Athens"]]),
95 ("x:=S where ^sum(@STATUS)", Left $ AtomTypeMismatchError intAtomType boolAtomType),
96 ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[stringAtom "S2", stringAtom "Jones", intAtom 10, stringAtom "Paris"]]),
97 --test "all but" attribute inversion syntax
98 ("x:=S{all but S#} = S{CITY,SNAME,STATUS}", Right $ relationTrue),
99 --test key syntax
100 ("x:=S; key testconstraint {S#,CITY} x; insert x relation{tuple{CITY \"London\", S# \"S1\", SNAME \"gonk\", STATUS 50}}", Left (InclusionDependencyCheckError "testconstraint")),
101 ("y:=S; key testconstraint {S#} y; insert y relation{tuple{CITY \"London\", S# \"S6\", SNAME \"gonk\", STATUS 50}}; x:=y{S#} = S{S#} union relation{tuple{S# \"S6\"}}", Right $ relationTrue),
102 --test binary bytestring data type
103 ("x:=relation{tuple{y \"dGVzdGRhdGE=\"::bytestring}}", mkRelationFromList byteStringAttributes [[Atom (TE.encodeUtf8 "testdata")]]),
104 --test Maybe Text
105 ("x:=relation{tuple{a Just \"spam\"::maybe char}}", mkRelationFromList simpleMaybeTextAttributes [[Atom (Just "spam" :: Maybe Text)]]),
106 --test Maybe Int
107 ("x:=relation{tuple{a Just 3::maybe int}}", mkRelationFromList simpleMaybeIntAttributes [[Atom (Just 3 :: Maybe Int)]]),
108 --test datetime interval
109 ("x:=relation{tuple{a interval_datetime((\"2015-01-01 00:00:00\",\"2016-01-01 00:00:00\"])}}", mkRelationFromList simpleIntervalDateTimeAttributes [
110 [Atom $ interval (Finite (UTCTime (fromGregorian 2015 1 1) 0), False)
111 (Finite (UTCTime (fromGregorian 2016 1 1) 0), True)]
112 ])
113 ]
115assertTutdEqual :: DatabaseContext -> Either RelationalError Relation -> String -> Assertion
116assertTutdEqual databaseContext expected tutd = assertEqual tutd expected interpreted
117 where
118 interpreted = case interpretDatabaseExpr databaseContext tutd of
119 Left err -> Left err
120 Right context -> case M.lookup "x" (relationVariables context) of
121 Nothing -> Left $ RelVarNotDefinedError "x"
122 Just rel -> Right rel
124transactionGraphBasicTest :: Test
125transactionGraphBasicTest = TestCase $ do
126 dbconn <- dateExamplesConnection
127 graph <- transactionGraph dbconn
128 assertEqual "validate bootstrapped graph" (validateGraph graph) Nothing
130--add a new transaction to the graph, validate it is in the graph
131transactionGraphAddCommitTest :: Test
132transactionGraphAddCommitTest = TestCase $ do
133 dbconn <- dateExamplesConnection
134 case parseTutorialD dbconn "x:=S" of
135 Left err -> assertFailure (show err)
136 Right parsed -> do
137 result <- evalTutorialD dbconn parsed
138 case result of
139 QuitResult -> assertFailure "quit?"
140 DisplayResult _ -> assertFailure "display?"
141 DisplayIOResult _ -> assertFailure "displayIO?"
142 DisplayErrorResult err -> assertFailure (show err)
143 QuietSuccessResult -> do
144 commit dbconn >>= maybeFail
145 (DisconnectedTransaction _ context) <- disconnectedTransaction dbconn
146 assertEqual "ensure x was added" (M.lookup "x" (relationVariables context)) (Just suppliersRel)
148transactionRollbackTest :: Test
149transactionRollbackTest = TestCase $ do
150 dbconn <- dateExamplesConnection
151 graph <- transactionGraph dbconn
152 maybeErr <- executeDatabaseContextExpr dbconn (Assign "x" (RelationVariable "S"))
153 case maybeErr of
154 Just err -> assertFailure (show err)
155 Nothing -> do
156 rollback dbconn >>= maybeFail
157 (DisconnectedTransaction _ context') <- disconnectedTransaction dbconn
158 graph' <- transactionGraph dbconn
159 assertEqual "validate context" Nothing (M.lookup "x" (relationVariables context'))
160 assertEqual "validate graph" graph graph'
162--commit a new transaction with "x" relation, jump to first transaction, verify that "x" is not present
163transactionJumpTest :: Test
164transactionJumpTest = TestCase $ do
165 dbconn <- dateExamplesConnection
166 (DisconnectedTransaction firstUUID _) <- disconnectedTransaction dbconn
167 maybeErr <- executeDatabaseContextExpr dbconn (Assign "x" (RelationVariable "S"))
168 case maybeErr of
169 Just err -> assertFailure (show err)
170 Nothing -> do
171 commit dbconn >>= maybeFail
172 --perform the jump
173 maybeErr2 <- executeGraphExpr dbconn (JumpToTransaction firstUUID)
174 case maybeErr2 of
175 Just err -> assertFailure (show err)
176 Nothing -> do
177 --check that the disconnected transaction does not include "x"
178 (DisconnectedTransaction _ context') <- disconnectedTransaction dbconn
179 assertEqual "ensure x is not present" Nothing (M.lookup "x" (relationVariables context'))
181maybeFail :: (Show a) => Maybe a -> IO ()
182maybeFail (Just err) = assertFailure (show err)
183maybeFail Nothing = return ()
185--branch from the first transaction and verify that there are two heads
186transactionBranchTest :: Test
187transactionBranchTest = TestCase $ do
188 dbconn <- dateExamplesConnection
189 mapM_ (\x -> x >>= maybeFail) [executeGraphExpr dbconn (Branch "test"),
190 executeDatabaseContextExpr dbconn (Assign "x" (RelationVariable "S")),
191 commit dbconn,
192 executeGraphExpr dbconn (JumpToHead "master"),
193 executeDatabaseContextExpr dbconn (Assign "y" (RelationVariable "S"))
194 ]
195 graph <- transactionGraph dbconn
196 assertBool "master branch exists" $ isJust (transactionForHead "master" graph)
197 assertBool "test branch exists" $ isJust (transactionForHead "test" graph)
199simpleJoinTest :: Test
200simpleJoinTest = TestCase $ assertTutdEqual dateExamples joinedRel "x:=S join SP"
201 where
202 attrs = A.attributesFromList [Attribute "CITY" stringAtomType,
203 Attribute "QTY" intAtomType,
204 Attribute "P#" stringAtomType,
205 Attribute "S#" stringAtomType,
206 Attribute "SNAME" stringAtomType,
207 Attribute "STATUS" intAtomType]
208 joinedRel = mkRelationFromList attrs [[stringAtom "London", intAtom 100, stringAtom "P6", stringAtom "S1", stringAtom "Smith", intAtom 20],
209 [stringAtom "London", intAtom 400, stringAtom "P3", stringAtom "S1", stringAtom "Smith", intAtom 20],
210 [stringAtom "London", intAtom 400, stringAtom "P5", stringAtom "S4", stringAtom "Clark", intAtom 20],
211 [stringAtom "London", intAtom 300, stringAtom "P1", stringAtom "S1", stringAtom "Smith", intAtom 20],
212 [stringAtom "Paris", intAtom 200, stringAtom "P2", stringAtom "S3", stringAtom "Blake", intAtom 30],
213 [stringAtom "Paris", intAtom 300, stringAtom "P1", stringAtom "S2", stringAtom "Jones", intAtom 10],
214 [stringAtom "London", intAtom 100, stringAtom "P5", stringAtom "S1", stringAtom "Smith", intAtom 20],
215 [stringAtom "London", intAtom 300, stringAtom "P4", stringAtom "S4", stringAtom "Clark", intAtom 20],
216 [stringAtom "Paris", intAtom 400, stringAtom "P2", stringAtom "S2", stringAtom "Jones", intAtom 10],
217 [stringAtom "London", intAtom 200, stringAtom "P2", stringAtom "S1", stringAtom "Smith", intAtom 20],
218 [stringAtom "London", intAtom 200, stringAtom "P4", stringAtom "S1", stringAtom "Smith", intAtom 20],
219 [stringAtom "London", intAtom 200, stringAtom "P2", stringAtom "S4", stringAtom "Clark", intAtom 20]
220 ]
222dateExamplesConnection :: IO (Connection)
223dateExamplesConnection = do
224 dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence)
225 case dbconn of
226 Left err -> do
227 hPutStrLn stderr (show err)
228 exitFailure
229 Right conn -> do
230 mapM_ (\(rvName,rvRel) -> executeDatabaseContextExpr conn (Assign rvName (ExistingRelation rvRel))) (M.toList (relationVariables dateExamples))
231 mapM_ (\(idName,incDep) -> executeDatabaseContextExpr conn (AddInclusionDependency idName incDep)) (M.toList (inclusionDependencies dateExamples))
232 --skipping atom functions for now- there are no atom function manipulation operators yet
233 commit conn >>= maybeFail
234 return conn