git.iko.soy/project-m36
on master help sign in
cabal build completes successfully after some test sessionification
f25ce68AgentM
ProjectM36/Client.hs−1
compare with master
unifiedsplit
@@ -98,7 +98,6 @@ defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (c
98
98
99type Sessions = STMMap.Map SessionId Session
99type Sessions = STMMap.Map SessionId Session
100
100
101−
102data Connection = InProcessConnection PersistenceStrategy Sessions (TVar TransactionGraph) |
101data Connection = InProcessConnection PersistenceStrategy Sessions (TVar TransactionGraph) |
103 RemoteProcessConnection LocalNode ProcessId
102 RemoteProcessConnection LocalNode ProcessId
104
103
project-m36.cabal+2−2
@@ -258,7 +258,7 @@ Test-Suite test-persistent-driver
258 Default-Language: Haskell2010
258 Default-Language: Haskell2010
259 type: exitcode-stdio-1.0
259 type: exitcode-stdio-1.0
260 main-is: test/persistent-driver/test.hs
260 main-is: test/persistent-driver/test.hs
261− 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, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, persistent-template, conduit, persistent, either, path-pieces, http-api-data, stm-containers
261+ 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, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, persistent-template, conduit, persistent, either, path-pieces, http-api-data, stm-containers, list-t
262 GHC-Options: -Wall
262 GHC-Options: -Wall
263 C-sources: ProjectM36/DirectoryFsync.c
263 C-sources: ProjectM36/DirectoryFsync.c
264
264
@@ -273,7 +273,7 @@ Test-Suite test-server
273 Default-Language: Haskell2010
273 Default-Language: Haskell2010
274 type: exitcode-stdio-1.0
274 type: exitcode-stdio-1.0
275 main-is: test/Server/Main.hs
275 main-is: test/Server/Main.hs
276− 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, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers
276+ 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, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t
277 GHC-Options: -Wall
277 GHC-Options: -Wall
278 C-sources: ProjectM36/DirectoryFsync.c
278 C-sources: ProjectM36/DirectoryFsync.c
279
279
test/Server/Main.hs+47−39
@@ -13,16 +13,17 @@ import ProjectM36.TupleSet
13import System.Exit
13import System.Exit
14import Control.Concurrent
14import Control.Concurrent
15
15
16−testList :: Connection -> Test
16+testList :: SessionId -> Connection -> Test
17−testList conn = TestList $ map (\t -> t conn) [testRelationalExpr,
17+testList sessionId conn = TestList $ map (\t -> t sessionId conn) [
18+ testRelationalExpr,
18− testDatabaseContextExpr,
19+ testDatabaseContextExpr,
19− testGraphExpr,
20+ testGraphExpr,
20− testTypeForRelationalExpr,
21+ testTypeForRelationalExpr,
21− testPlanForDatabaseContextExpr,
22+ testPlanForDatabaseContextExpr,
22− testTransactionGraphAsRelation,
23+ testTransactionGraphAsRelation,
23− testHeadTransactionUUID,
24+ testHeadTransactionUUID,
24− testHeadName
25+ testHeadName
25− ]
26+ ]
26
27
27main :: IO ()
28main :: IO ()
28main = do
29main = do
@@ -30,17 +31,24 @@ main = do
30 eTestConn <- testConnection port
31 eTestConn <- testConnection port
31 case eTestConn of
32 case eTestConn of
32 Left err -> putStrLn (show err) >> exitFailure
33 Left err -> putStrLn (show err) >> exitFailure
33− Right testConn -> do
34+ Right (session, testConn) -> do
34− tcounts <- runTestTT (testList testConn)
35+ tcounts <- runTestTT (testList session testConn)
35 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
36 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
36
37
37testDatabaseName :: DatabaseName
38testDatabaseName :: DatabaseName
38testDatabaseName = "test"
39testDatabaseName = "test"
39
40
40−testConnection :: Port -> IO (Either ConnectionError Connection)
41+testConnection :: Port -> IO (Either ConnectionError (SessionId, Connection))
41testConnection port = do
42testConnection port = do
42 let connInfo = RemoteProcessConnectionInfo testDatabaseName (createNodeId "127.0.0.1" port)
43 let connInfo = RemoteProcessConnectionInfo testDatabaseName (createNodeId "127.0.0.1" port)
43− connectProjectM36 connInfo
44+ eConn <- connectProjectM36 connInfo
45+ case eConn of
46+ Left err -> pure $ Left err
47+ Right conn -> do
48+ eSessionId <- createSessionAtHead defaultHeadName conn
49+ case eSessionId of
50+ Left _ -> error "failed to create session"
51+ Right sessionId -> pure $ Right (sessionId, conn)
44
52
45-- | A version of 'launchServer' which returns the port on which the server is listening on a secondary thread
53-- | A version of 'launchServer' which returns the port on which the server is listening on a secondary thread
46launchTestServer :: IO (Port)
54launchTestServer :: IO (Port)
@@ -50,65 +58,65 @@ launchTestServer = do
50 _ <- forkIO $ launchServer config (Just portVar) >> pure ()
58 _ <- forkIO $ launchServer config (Just portVar) >> pure ()
51 takeMVar portVar
59 takeMVar portVar
52
60
53−testRelationalExpr :: Connection -> Test
61+testRelationalExpr :: SessionId -> Connection -> Test
54−testRelationalExpr conn = TestCase $ do
62+testRelationalExpr sessionId conn = TestCase $ do
55− relResult <- executeRelationalExpr conn (RelationVariable "true")
63+ relResult <- executeRelationalExpr sessionId conn (RelationVariable "true")
56 assertEqual "invalid relation result" (Right relationTrue) relResult
64 assertEqual "invalid relation result" (Right relationTrue) relResult
57
65
58−testDatabaseContextExpr :: Connection -> Test
66+testDatabaseContextExpr :: SessionId -> Connection -> Test
59−testDatabaseContextExpr conn = TestCase $ do
67+testDatabaseContextExpr sessionId conn = TestCase $ do
60 let attrs = attributesFromList [Attribute "x" intAtomType]
68 let attrs = attributesFromList [Attribute "x" intAtomType]
61 testrv = "testrv"
69 testrv = "testrv"
62− dbResult <- executeDatabaseContextExpr conn (Define testrv attrs)
70+ dbResult <- executeDatabaseContextExpr sessionId conn (Define testrv attrs)
63 case dbResult of
71 case dbResult of
64 Just err -> assertFailure (show err)
72 Just err -> assertFailure (show err)
65 Nothing -> do
73 Nothing -> do
66− eRel <- executeRelationalExpr conn (RelationVariable testrv)
74+ eRel <- executeRelationalExpr sessionId conn (RelationVariable testrv)
67 let expected = mkRelation attrs emptyTupleSet
75 let expected = mkRelation attrs emptyTupleSet
68 case eRel of
76 case eRel of
69 Left err -> assertFailure (show err)
77 Left err -> assertFailure (show err)
70 Right rel -> assertEqual "dbcontext definition failed" expected (Right rel)
78 Right rel -> assertEqual "dbcontext definition failed" expected (Right rel)
71
79
72−testGraphExpr :: Connection -> Test
80+testGraphExpr :: SessionId -> Connection -> Test
73−testGraphExpr conn = TestCase $ do
81+testGraphExpr sessionId conn = TestCase $ do
74− graphResult <- executeGraphExpr conn (JumpToHead "master")
82+ graphResult <- executeGraphExpr sessionId conn (JumpToHead "master")
75 case graphResult of
83 case graphResult of
76 Just err -> assertFailure (show err)
84 Just err -> assertFailure (show err)
77 Nothing -> pure ()
85 Nothing -> pure ()
78
86
79−testTypeForRelationalExpr :: Connection -> Test
87+testTypeForRelationalExpr :: SessionId -> Connection -> Test
80−testTypeForRelationalExpr conn = TestCase $ do
88+testTypeForRelationalExpr sessionId conn = TestCase $ do
81− relResult <- typeForRelationalExpr conn (RelationVariable "true")
89+ relResult <- typeForRelationalExpr sessionId conn (RelationVariable "true")
82 case relResult of
90 case relResult of
83 Left err -> assertFailure (show err)
91 Left err -> assertFailure (show err)
84 Right rel -> assertEqual "typeForRelationalExpr failure" relationFalse rel
92 Right rel -> assertEqual "typeForRelationalExpr failure" relationFalse rel
85
93
86−testPlanForDatabaseContextExpr :: Connection -> Test
94+testPlanForDatabaseContextExpr :: SessionId -> Connection -> Test
87−testPlanForDatabaseContextExpr conn = TestCase $ do
95+testPlanForDatabaseContextExpr sessionId conn = TestCase $ do
88 let attrs = attributesFromList [Attribute "x" intAtomType]
96 let attrs = attributesFromList [Attribute "x" intAtomType]
89 testrv = "testrv"
97 testrv = "testrv"
90 dbExpr = Define testrv attrs
98 dbExpr = Define testrv attrs
91− planResult <- planForDatabaseContextExpr conn dbExpr
99+ planResult <- planForDatabaseContextExpr sessionId conn dbExpr
92 case planResult of
100 case planResult of
93 Left err -> assertFailure (show err)
101 Left err -> assertFailure (show err)
94 Right plan -> assertEqual "planForDatabaseContextExpr failure" dbExpr plan
102 Right plan -> assertEqual "planForDatabaseContextExpr failure" dbExpr plan
95
103
96
104
97−testTransactionGraphAsRelation :: Connection -> Test
105+testTransactionGraphAsRelation :: SessionId -> Connection -> Test
98−testTransactionGraphAsRelation conn = TestCase $ do
106+testTransactionGraphAsRelation sessionId conn = TestCase $ do
99− eGraph <- transactionGraphAsRelation conn
107+ eGraph <- transactionGraphAsRelation sessionId conn
100 case eGraph of
108 case eGraph of
101 Left err -> assertFailure (show err)
109 Left err -> assertFailure (show err)
102 Right _ -> pure ()
110 Right _ -> pure ()
103
111
104−testHeadTransactionUUID :: Connection -> Test
112+testHeadTransactionUUID :: SessionId -> Connection -> Test
105−testHeadTransactionUUID conn = TestCase $ do
113+testHeadTransactionUUID sessionId conn = TestCase $ do
106− _ <- headTransactionUUID conn
114+ _ <- headTransactionUUID sessionId conn
107 pure ()
115 pure ()
108
116
109−testHeadName :: Connection -> Test
117+testHeadName :: SessionId -> Connection -> Test
110−testHeadName conn = TestCase $ do
118+testHeadName sessionId conn = TestCase $ do
111− mHeadName <- headName conn
119+ mHeadName <- headName sessionId conn
112 assertEqual "headName failure" (Just "master") mHeadName
120 assertEqual "headName failure" (Just "master") mHeadName
113
121
114
122
test/persistent-driver/test.hs+7−6
@@ -7,6 +7,7 @@
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE FlexibleInstances #-}
10import Test.HUnit
11import Test.HUnit
11import Database.Persist.ProjectM36
12import Database.Persist.ProjectM36
12import ProjectM36.Client
13import ProjectM36.Client
@@ -40,18 +41,18 @@ main = do
40inProcSettings :: ConnectionInfo
41inProcSettings :: ConnectionInfo
41inProcSettings = InProcessConnectionInfo NoPersistence
42inProcSettings = InProcessConnectionInfo NoPersistence
42
43
43−defPersonRel :: Connection -> IO ()
44+defPersonRel :: SessionId -> Connection -> IO ()
44−defPersonRel conn = do
45+defPersonRel sessionId conn = do
45− maybeErr <- C.executeDatabaseContextExpr conn (Define "person" (attributesFromList [Attribute "name" stringAtomType, Attribute "age" intAtomType, Attribute "id" stringAtomType]))
46+ maybeErr <- C.executeDatabaseContextExpr sessionId conn (Define "person" (attributesFromList [Attribute "name" stringAtomType, Attribute "age" intAtomType, Attribute "id" stringAtomType]))
46 case maybeErr of
47 case maybeErr of
47 Nothing -> return ()
48 Nothing -> return ()
48 Just err -> assertFailure $ "defPersonRel" ++ show err
49 Just err -> assertFailure $ "defPersonRel" ++ show err
49
50
50−mkInProcessTest :: ReaderT C.Connection IO () -> Test
51+mkInProcessTest :: ReaderT ProjectM36Backend IO () -> Test
51mkInProcessTest m = TestCase $ do
52mkInProcessTest m = TestCase $ do
52 withProjectM36Conn inProcSettings $ runProjectM36Conn $ do
53 withProjectM36Conn inProcSettings $ runProjectM36Conn $ do
53− conn <- ask
54+ (sessionId, conn) <- ask
54− liftIO (defPersonRel conn)
55+ liftIO (defPersonRel sessionId conn)
55 m
56 m
56
57
57entityFromMaybe :: (PersistEntity val) => Maybe (Entity val) -> IO (Entity val)
58entityFromMaybe :: (PersistEntity val) => Maybe (Entity val) -> IO (Entity val)