git.iko.soy/project-m36
on master help sign in
Merge branch '176_simple_client_update'
commit64ed2f04ed44fc94900f62270f8a86b22231d644 authorAgentM <agentm@themactionfaction.com> dateThu 18 Jan 2018, 10:44 (9 years ago) parent63fbef087c4e43
3 files changed+31−15
compare with master
unifiedsplit
src/lib/ProjectM36/Client.hs+16−6 src/lib/ProjectM36/Client/Simple.hs+1−1 test/Client/Simple.hs+14−8
src/lib/ProjectM36/Client.hs+16−6
@@ -582,7 +582,7 @@ executeDatabaseContextExpr sessionId (InProcessConnection conf) expr = excEither
582582 pure (Right ())
583583executeDatabaseContextExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)
584584
585−-- | Similar to a git rebase, 'autoMergeToHead' atomically creates a temporary branch and merges it to the latest commit of the branch referred to by the 'HeadName' and commits the merge. This is useful to reduce incidents of 'TransactionIsNotAHeadError's but at the risk of merge errors (thus making it similar to rebasing).
585+-- | Similar to a git rebase, 'autoMergeToHead' atomically creates a temporary branch and merges it to the latest commit of the branch referred to by the 'HeadName' and commits the merge. This is useful to reduce incidents of 'TransactionIsNotAHeadError's but at the risk of merge errors (thus making it similar to rebasing). Alternatively, as an optimization, if a simple commit is possible (meaning that the head has not changed), then a fast-forward commit takes place instead.
586586autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())
587587autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do
588588 let sessions = ipSessions conf
@@ -594,11 +594,21 @@ autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do
594594 eSession <- sessionForSessionId sessionId sessions
595595 case eSession of
596596 Left err -> pure (Left err)
597− Right session ->
598− case Graph.autoMergeToHead stamp (id1, id2, id3) (Sess.disconnectedTransaction session) headName' strat graph of
599− Left err -> pure (Left err)
600− Right (discon', graph') ->
601− pure (Right (discon', graph', [id1, id2, id3]))
597+ Right session ->
598+ case Graph.transactionForHead headName' graph of
599+ Nothing -> pure (Left (NoSuchHeadNameError headName'))
600+ Just headTrans -> do
601+ --attempt fast-forward commit, if possible
602+ let graphInfo = if Sess.parentId session == transactionId headTrans then do
603+ ret <- Graph.evalGraphOp stamp id1 (Sess.disconnectedTransaction session) graph Commit
604+ pure (ret, [id1])
605+ else do
606+ ret <- Graph.autoMergeToHead stamp (id1, id2, id3) (Sess.disconnectedTransaction session) headName' strat graph
607+ pure (ret, [id1,id2,id3])
608+ case graphInfo of
609+ Left err -> pure (Left err)
610+ Right ((discon', graph'), transactionIdsAdded) ->
611+ pure (Right (discon', graph', transactionIdsAdded))
602612autoMergeToHead sessionId conn@(RemoteProcessConnection _) strat headName' = remoteCall conn (ExecuteAutoMergeToHead sessionId strat headName')
603613
604614-- | Execute a database context IO-monad-based expression for the given session and connection. `DatabaseContextIOExpr`s modify the DatabaseContext but cannot be purely implemented.
src/lib/ProjectM36/Client/Simple.hs+1−1
@@ -72,7 +72,7 @@ close (_ , conn) = C.close conn
7272withTransaction :: DbConn -> Db a -> IO (Either DbError a)
7373withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
7474
75−-- | Same a 'withTransaction' except that the merge strategy can be specified.
75+-- | Same as 'withTransaction' except that the merge strategy can be specified.
7676withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
7777withTransactionUsing (sess, conn) strat dbm = do
7878 eHeadName <- C.headName sess conn
test/Client/Simple.hs+14−8
@@ -3,11 +3,14 @@ import Test.HUnit
33import System.Exit
44import ProjectM36.Relation
55import qualified ProjectM36.Client as C
6+import ProjectM36.DateExamples
7+import ProjectM36.DatabaseContext
68import System.IO.Temp
79import System.FilePath
810import ProjectM36.TupleSet
911import ProjectM36.Attribute
1012import qualified Data.Vector as V
13+import qualified Data.Map as M
1114
1215main :: IO ()
1316main = do
@@ -15,7 +18,7 @@ main = do
1518 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
1619
1720testList :: Test
18−testList = TestList [testSimpleCommitSuccess, testSimpleCommitFailure]
21+testList = TestList [testSimpleCommitSuccess, testSimpleCommitFailure, testSimpleUpdate]
1922
2023assertEither :: (Show a) => IO (Either a b) -> IO b
2124assertEither x = do
@@ -45,6 +48,7 @@ testSimpleCommitSuccess = TestCase $
4548 eRes <- C.executeRelationalExpr sess conn relExpr
4649 assertEqual "x and y" (Right relationTrue) eRes
4750
51+
4852testSimpleCommitFailure :: Test
4953testSimpleCommitFailure = TestCase $ do
5054 let failAttrs = attributesFromList [Attribute "fail" IntAtomType]
@@ -57,11 +61,13 @@ testSimpleCommitFailure = TestCase $ do
5761 execute $ Assign "x" (MakeStaticRelation failAttrs emptyTupleSet)
5862 let expectedErr = Left (RelError (RelationTypeMismatchError V.empty failAttrs))
5963 assertEqual "dbc error" expectedErr err
60−
61−
62−
6364
64−
65−
66−
67−
65+-- #176 default merge couldn't handle Update
66+testSimpleUpdate :: Test
67+testSimpleUpdate = TestCase $ do
68+ let connInfo = InProcessConnectionInfo NoPersistence emptyNotificationCallback []
69+ dbconn <- assertEither (simpleConnectProjectM36 connInfo)
70+ assertEither $ withTransaction dbconn $
71+ execute $ databaseContextAsDatabaseContextExpr dateExamples
72+ assertEither $ withTransaction dbconn $
73+ execute $ Update "s" (M.singleton "sname" (C.NakedAtomExpr (C.TextAtom "Blakey"))) (C.AttributeEqualityPredicate "sname" (C.NakedAtomExpr (C.TextAtom "Blake")))