git.iko.soy/project-m36
on master help sign in
add atom function script test

fix import warnings

commitd620fd056d7db2fa79b62cf3ab772dd9395a2623 authorAgentM <agentm@themactionfaction.com> dateSun 21 Aug 2016, 19:09 (10 years ago) parentf667ac5
8 files changed+81−43
compare with master
unifiedsplit
project-m36.cabal+11−1 test/Relation/Import/CSV.hs−2 test/TransactionGraph/Merge.hs−1 test/TutorialD/Interpreter.hs+2−37 test/TutorialD/Interpreter/AtomFunctionScript.hs+26 test/TutorialD/Interpreter/Import/TutorialD.hs−1 test/TutorialD/Interpreter/TestBase.hs+42 test/persistent-driver/test.hs−1
project-m36.cabal+11−1
@@ -269,7 +269,17 @@ Test-Suite test-tutoriald
269269 Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t, project-m36 == 0.1
270270 Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.Import.BasicExamples
271271 GHC-Options: -Wall
272− Hs-Source-Dirs: ./src/bin, .
272+ Hs-Source-Dirs: ./src/bin, ., test
273+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
274+
275+Test-Suite test-atomfunctionbody
276+ Default-Language: Haskell2010
277+ Default-Extensions: OverloadedStrings
278+ type: exitcode-stdio-1.0
279+ main-is: test/TutorialD/Interpreter/AtomFunctionScript.hs
280+ Build-Depends: base, HUnit, project-m36 == 0.1, uuid, containers, parsec, text, vector, directory, bytestring, mtl, haskeline
281+ GHC-Options: -Wall
282+ Hs-Source-Dirs: ./src/bin, ./test, .
273283 CPP-Options: -DPROJECTM36_VERSION="v0.1"
274284
275285Test-Suite test-relation
test/Relation/Import/CSV.hs−2
@@ -2,8 +2,6 @@ import Test.HUnit
22import ProjectM36.Base
33import ProjectM36.Relation.Parse.CSV
44import ProjectM36.Relation
5−import ProjectM36.Atom
6−import ProjectM36.DataTypes.Primitive
75import qualified ProjectM36.Attribute as A
86import System.Exit
97import qualified Data.Text.Lazy as T
test/TransactionGraph/Merge.hs−1
@@ -3,7 +3,6 @@ import Test.HUnit
33import ProjectM36.Base
44import ProjectM36.Attribute
55import ProjectM36.Relation
6−import ProjectM36.DataTypes.Primitive
76import ProjectM36.Transaction
87import ProjectM36.TransactionGraph
98import ProjectM36.Error
test/TutorialD/Interpreter.hs+2−37
@@ -1,4 +1,5 @@
11import TutorialD.Interpreter.DatabaseContextExpr
2+import TutorialD.Interpreter.TestBase
23import TutorialD.Interpreter
34import TutorialD.Interpreter.Base
45import Test.HUnit
@@ -11,7 +12,6 @@ import ProjectM36.AtomFunctions.Primitive
1112import ProjectM36.DataTypes.Either
1213import ProjectM36.DateExamples
1314import ProjectM36.Base hiding (Finite)
14−import qualified ProjectM36.Base as Base
1515import ProjectM36.TransactionGraph
1616import ProjectM36.Client
1717import ProjectM36.Session
@@ -191,11 +191,6 @@ transactionJumpTest = TestCase $ do
191191 --check that the disconnected transaction does not include "x"
192192 (DisconnectedTransaction _ context') <- disconnectedTransaction sessionId dbconn
193193 assertEqual "ensure x is not present" Nothing (M.lookup "x" (relationVariables context'))
194−
195−maybeFail :: (Show a) => Maybe a -> IO ()
196−maybeFail (Just err) = assertFailure (show err)
197−maybeFail Nothing = return ()
198−
199194--branch from the first transaction and verify that there are two heads
200195transactionBranchTest :: Test
201196transactionBranchTest = TestCase $ do
@@ -251,23 +246,6 @@ inclusionDependencies (InProcessConnection (DisconnectedTransaction _ context))
251246inclusionDependencies _ = error "remote connection used"
252247-}
253248
254−dateExamplesConnection :: NotificationCallback -> IO (SessionId, Connection)
255−dateExamplesConnection callback = do
256− dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence callback)
257− let incDeps = Base.inclusionDependencies dateExamples
258− case dbconn of
259− Left err -> error (show err)
260− Right conn -> do
261− eSessionId <- createSessionAtHead "master" conn
262− case eSessionId of
263− Left err -> error (show err)
264− Right sessionId -> do
265− mapM_ (\(rvName,rvRel) -> executeDatabaseContextExpr sessionId conn (Assign rvName (ExistingRelation rvRel))) (M.toList (relationVariables dateExamples))
266− mapM_ (\(idName,incDep) -> executeDatabaseContextExpr sessionId conn (AddInclusionDependency idName incDep)) (M.toList incDeps)
267− --skipping atom functions for now- there are no atom function manipulation operators yet
268− commit sessionId conn >>= maybeFail
269− pure (sessionId, conn)
270−
271249-- test notifications over the InProcessConnection
272250testNotification :: Test
273251testNotification = TestCase $ do
@@ -282,20 +260,7 @@ testNotification = TestCase $ do
282260 check' $ executeDatabaseContextExpr sess conn (Assign "x" (ExistingRelation relationFalse))
283261 check' $ commit sess conn
284262 takeMVar notifmvar
285−
286−executeTutorialD :: SessionId -> Connection -> String -> IO ()
287−executeTutorialD sessionId conn tutd = case parseTutorialD tutd of
288− Left err -> assertFailure (show tutd ++ ": " ++ show err)
289− Right parsed -> do
290− result <- evalTutorialD sessionId conn UnsafeEvaluation parsed
291− case result of
292− QuitResult -> assertFailure "quit?"
293− DisplayResult _ -> assertFailure "display?"
294− DisplayIOResult _ -> assertFailure "displayIO?"
295− DisplayRelationResult _ -> assertFailure "displayrelation?"
296− DisplayErrorResult err -> assertFailure (show err)
297− QuietSuccessResult -> pure ()
298−
263+
299264testTypeConstructors :: Test
300265testTypeConstructors = TestCase $ do
301266 (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback
test/TutorialD/Interpreter/AtomFunctionScript.hsnew file+26
@@ -0,0 +1,26 @@
1+import TutorialD.Interpreter.TestBase
2+import System.Exit
3+import Test.HUnit
4+import ProjectM36.Client
5+import ProjectM36.Relation
6+import ProjectM36.Base
7+import qualified Data.Vector as V
8+import qualified Data.Map as M
9+
10+main :: IO ()
11+main = do
12+ tcounts <- runTestTT (TestList [testBasicAtomFunction])
13+ if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
14+
15+testBasicAtomFunction :: Test
16+testBasicAtomFunction = TestCase $ do
17+ --add an atom function and run it
18+ (sess, conn) <- dateExamplesConnection emptyNotificationCallback
19+ executeTutorialD sess conn "addatomfunction \"mkTest\" Int -> Int \"\\(IntAtom x:xs) -> IntAtom x\""
20+ let attrs = [Attribute "x" IntAtomType]
21+ funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntAtom 3)]
22+ tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
23+ expectedResult = mkRelationFromList (V.fromList attrs) [[IntAtom 3]]
24+ result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
25+
26+ assertEqual "simple atom function equality" expectedResult result
test/TutorialD/Interpreter/Import/TutorialD.hs−1
@@ -1,6 +1,5 @@
11import Test.HUnit
22import ProjectM36.Base
3−import ProjectM36.Atom
43import TutorialD.Interpreter.Import.TutorialD
54import System.Exit
65import System.IO.Temp
test/TutorialD/Interpreter/TestBase.hsnew file+42
@@ -0,0 +1,42 @@
1+module TutorialD.Interpreter.TestBase where
2+import ProjectM36.Client
3+import TutorialD.Interpreter
4+import TutorialD.Interpreter.Base
5+import qualified ProjectM36.Base as Base
6+import ProjectM36.DateExamples
7+import Test.HUnit
8+import qualified Data.Map as M
9+
10+dateExamplesConnection :: NotificationCallback -> IO (SessionId, Connection)
11+dateExamplesConnection callback = do
12+ dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence callback)
13+ let incDeps = Base.inclusionDependencies dateExamples
14+ case dbconn of
15+ Left err -> error (show err)
16+ Right conn -> do
17+ eSessionId <- createSessionAtHead "master" conn
18+ case eSessionId of
19+ Left err -> error (show err)
20+ Right sessionId -> do
21+ mapM_ (\(rvName,rvRel) -> executeDatabaseContextExpr sessionId conn (Assign rvName (ExistingRelation rvRel))) (M.toList (Base.relationVariables dateExamples))
22+ mapM_ (\(idName,incDep) -> executeDatabaseContextExpr sessionId conn (AddInclusionDependency idName incDep)) (M.toList incDeps)
23+ --skipping atom functions for now- there are no atom function manipulation operators yet
24+ commit sessionId conn >>= maybeFail
25+ pure (sessionId, conn)
26+
27+executeTutorialD :: SessionId -> Connection -> String -> IO ()
28+executeTutorialD sessionId conn tutd = case parseTutorialD tutd of
29+ Left err -> assertFailure (show tutd ++ ": " ++ show err)
30+ Right parsed -> do
31+ result <- evalTutorialD sessionId conn UnsafeEvaluation parsed
32+ case result of
33+ QuitResult -> assertFailure "quit?"
34+ DisplayResult _ -> assertFailure "display?"
35+ DisplayIOResult _ -> assertFailure "displayIO?"
36+ DisplayRelationResult _ -> assertFailure "displayrelation?"
37+ DisplayErrorResult err -> assertFailure (show err)
38+ QuietSuccessResult -> pure ()
39+
40+maybeFail :: (Show a) => Maybe a -> IO ()
41+maybeFail (Just err) = assertFailure (show err)
42+maybeFail Nothing = return ()
test/persistent-driver/test.hs−1
@@ -10,7 +10,6 @@
1010import Test.HUnit
1111import Database.Persist.ProjectM36
1212import ProjectM36.Client
13−import ProjectM36.DataTypes.Primitive
1413import qualified ProjectM36.Client as C
1514import System.Exit
1615import Database.Persist