git.iko.soy/project-m36
on master help sign in
WIP more test fixes

remove DisconnectedTransaction diff expr

commit170009a1f0f149a68a186c3c1ffa639d29af1c73 authorAgentM <agentm@themactionfaction.com> dateThu 6 Feb 2020, 21:17 (7 years ago) parent1d20536
10 files changed+26−31
compare with master
unifiedsplit
project-m36.cabal+7−7 src/bin/ProjectM36/Server/WebSocket.hs+1−1 src/lib/ProjectM36/Base.hs+1−1 src/lib/ProjectM36/Client.hs+4−4 src/lib/ProjectM36/DisconnectedTransaction.hs+2−6 src/lib/ProjectM36/TransactionGraph.hs+2−2 test/IsomorphicSchema.hs+1−3 test/Server/Main.hs+3−2 test/TransactionGraph/Persist.hs+1−1 test/TutorialD/Interpreter.hs+4−4
project-m36.cabal+7−7
@@ -1,5 +1,5 @@
11Name: project-m36
2−Version: 0.6
2+Version: 0.8
33License: PublicDomain
44Build-Type: Simple
55Homepage: https://github.com/agentm/project-m36
@@ -246,7 +246,7 @@ Test-Suite test-tutoriald
246246 Default-Extensions: OverloadedStrings
247247 type: exitcode-stdio-1.0
248248 main-is: test/TutorialD/Interpreter.hs
249− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t, project-m36, random, MonadRandom, semigroups
249+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t, project-m36, random, MonadRandom, semigroups, parser-combinators
250250 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, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.SchemaOperator
251251 GHC-Options: -Wall -threaded
252252 Hs-Source-Dirs: ./src/bin, ., test
@@ -390,14 +390,14 @@ Test-Suite test-scripts
390390 Default-Extensions: OverloadedStrings
391391 type: exitcode-stdio-1.0
392392 main-is: test/scripts.hs
393− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, project-m36, random, MonadRandom, semigroups
393+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, project-m36, random, MonadRandom, semigroups, parser-combinators
394394 Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.Import.BasicExamples
395395 GHC-Options: -Wall -threaded
396396 Hs-Source-Dirs: ., ./src/bin
397397
398398Executable project-m36-websocket-server
399399 Default-Language: Haskell2010
400− Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, websockets, aeson, optparse-applicative, project-m36, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring, random, MonadRandom, time, network-transport-tcp, semigroups, attoparsec
400+ Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, websockets, aeson, optparse-applicative, project-m36, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring, random, MonadRandom, time, network-transport-tcp, semigroups, attoparsec, parser-combinators
401401 Main-Is: ProjectM36/Server/WebSocket/websocket-server.hs
402402 Other-Modules: ProjectM36.Client.Json, ProjectM36.Server.RemoteCallTypes.Json, ProjectM36.Server.WebSocket, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.SchemaOperator
403403 GHC-Options: -Wall -threaded
@@ -427,7 +427,7 @@ Test-Suite test-atomable
427427 Default-Language: Haskell2010
428428 type: exitcode-stdio-1.0
429429 main-is: test/Relation/Atomable.hs
430− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, project-m36, random, MonadRandom, semigroups
430+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, project-m36, random, MonadRandom, semigroups, parser-combinators
431431 Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.SchemaOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types
432432 Default-Extensions: OverloadedStrings
433433 GHC-Options: -Wall -threaded
@@ -474,7 +474,7 @@ Test-Suite test-client-simple
474474Executable handles
475475 Default-Language: Haskell2010
476476 Default-Extensions: OverloadedStrings
477− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36, random, MonadRandom, semigroups
477+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36, random, MonadRandom, semigroups, parser-combinators
478478 main-is: benchmark/Handles.hs
479479 Other-Modules: TutorialD.Interpreter,
480480 TutorialD.Interpreter.Base,
@@ -503,7 +503,7 @@ Test-Suite test-dataframe
503503 Main-Is: test/DataFrame.hs
504504 type: exitcode-stdio-1.0
505505 Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.SchemaOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types
506− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, project-m36, random, MonadRandom, semigroups
506+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, project-m36, random, MonadRandom, semigroups, parser-combinators
507507 Default-Extensions: OverloadedStrings
508508 GHC-Options: -Wall -threaded
509509 Hs-Source-Dirs: ./src/bin, ., test/
src/bin/ProjectM36/Server/WebSocket.hs+1−1
@@ -1,4 +1,4 @@
1−{-# LANGUAGE LambdaCase #-}
1+{-# LANGUAGE LambdaCase, CPP #-}
22module ProjectM36.Server.WebSocket where
33-- while the tutd client performs TutorialD parsing on the client, the websocket server will pass tutd to be parsed and executed on the server- otherwise I have to pull in ghcjs as a dependency to allow client-side parsing- that's not appealing because then the frontend is not language-agnostic, but this could change in the future, perhaps by sending different messages over the websocket
44-- ideally, the wire protocol should not be exposed to a straight string-based API ala SQL, so we could make perhaps a javascript DSL which compiles to the necessary JSON- anaylyze tradeoffs
src/lib/ProjectM36/Base.hs+1−1
@@ -430,7 +430,7 @@ type TransactionId = UUID
430430data Transaction = Transaction TransactionId TransactionInfo Schemas
431431
432432-- | The disconnected transaction represents an in-progress workspace used by sessions before changes are committed. This is similar to git's "index". After a transaction is committed, it is "connected" in the transaction graph and can no longer be modified.
433−data DisconnectedTransaction = DisconnectedTransaction TransactionId Schemas DatabaseContextExpr
433+data DisconnectedTransaction = DisconnectedTransaction TransactionId Schemas DirtyFlag
434434--the database context expression represents a difference between the disconnected transaction and its immutable parent transaction- is this diff expr used at all?
435435
436436type DirtyFlag = Bool
src/lib/ProjectM36/Client.hs+4−4
@@ -419,7 +419,7 @@ createSessionAtCommit_ commitId newSessionId (InProcessConnection conf) = do
419419 case RE.transactionForId commitId graph of
420420 Left err -> pure (Left err)
421421 Right transaction -> do
422− let freshDiscon = DisconnectedTransaction commitId (Trans.schemas transaction) NoOperation
422+ let freshDiscon = DisconnectedTransaction commitId (Trans.schemas transaction) False
423423 keyDuplication <- StmMap.lookup newSessionId sessions
424424 case keyDuplication of
425425 Just _ -> pure $ Left (SessionIdInUseError newSessionId)
@@ -614,7 +614,7 @@ executeDatabaseContextExpr sessionId (InProcessConnection conf) expr = excEither
614614 if not (RE.dbc_dirty newState) then --nothing dirtied, nothing to do
615615 pure (Right ())
616616 else do
617− let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas NoOperation
617+ let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas False
618618 context' = RE.dbc_context newState
619619 newSubschemas = Schema.processDatabaseContextExprSchemasUpdate (Sess.subschemas session) expr
620620 newSchemas = Schemas context' newSubschemas
@@ -670,7 +670,7 @@ executeDatabaseContextIOExpr sessionId (InProcessConnection conf) expr = excEith
670670 case res of
671671 Left err -> pure (Left err)
672672 Right newState -> do
673− let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas NoOperation
673+ let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas False
674674 newSchemas = Schemas context' (Sess.subschemas session)
675675 newSession = Session newDiscon (Sess.schemaName session)
676676 context' = RE.dbc_context newState
@@ -834,7 +834,7 @@ executeSchemaExpr sessionId (InProcessConnection conf) schemaExpr = atomically $
834834 --hm- maybe we should start using lenses
835835 let discon = Sess.disconnectedTransaction session
836836 newSchemas = Schemas newContext newSubschemas
837− newSession = Session (DisconnectedTransaction (Discon.parentId discon) newSchemas NoOperation) (Sess.schemaName session)
837+ newSession = Session (DisconnectedTransaction (Discon.parentId discon) newSchemas False) (Sess.schemaName session)
838838 StmMap.insert newSession sessionId sessions
839839 pure (Right ())
840840executeSchemaExpr sessionId conn@(RemoteProcessConnection _) schemaExpr = remoteCall conn (ExecuteSchemaExpr sessionId schemaExpr)
src/lib/ProjectM36/DisconnectedTransaction.hs+2−6
@@ -11,11 +11,7 @@ parentId :: DisconnectedTransaction -> TransactionId
1111parentId (DisconnectedTransaction pid _ _) = pid
1212
1313isDirty :: DisconnectedTransaction -> Bool
14−isDirty (DisconnectedTransaction _ _ NoOperation) = False
15−isDirty _ = True
16−
17−diffExpr :: DisconnectedTransaction -> DatabaseContextExpr
18−diffExpr (DisconnectedTransaction _ _ expr) = expr
14+isDirty (DisconnectedTransaction _ _ flag) = flag
1915
2016freshTransaction :: TransactionId -> Schemas -> DisconnectedTransaction
21−freshTransaction tid schemas' = DisconnectedTransaction tid schemas' NoOperation
17+freshTransaction tid schemas' = DisconnectedTransaction tid schemas' False
src/lib/ProjectM36/TransactionGraph.hs+2−2
@@ -205,12 +205,12 @@ evalGraphOp _ _ _ graph (JumpToTransaction jumpId) = case transactionForId jumpI
205205 Left err -> Left err
206206 Right parentTrans -> Right (newTrans, graph)
207207 where
208− newTrans = DisconnectedTransaction jumpId (schemas parentTrans) NoOperation
208+ newTrans = DisconnectedTransaction jumpId (schemas parentTrans) False
209209
210210-- switch from one head to another
211211evalGraphOp _ _ _ graph (JumpToHead headName) =
212212 case transactionForHead headName graph of
213− Just newHeadTransaction -> let disconnectedTrans = DisconnectedTransaction (transactionId newHeadTransaction) (schemas newHeadTransaction) NoOperation in
213+ Just newHeadTransaction -> let disconnectedTrans = DisconnectedTransaction (transactionId newHeadTransaction) (schemas newHeadTransaction) False in
214214 Right (disconnectedTrans, graph)
215215 Nothing -> Left $ NoSuchHeadNameError headName
216216
test/IsomorphicSchema.hs+1−3
@@ -13,7 +13,7 @@ import qualified Data.Map as M
1313import qualified Data.Set as S
1414
1515testList :: Test
16−testList = TestList [testIsoRename, testIsoRestrict]--, testIsoUnion, testSchemaValidation]
16+testList = TestList [testIsoRename, testIsoRestrict, testIsoUnion, testSchemaValidation]
1717
1818main :: IO ()
1919main = do
@@ -77,7 +77,6 @@ testIsoRestrict = TestCase $ do
7777 let predicate = AttributeEqualityPredicate "boss" (NakedAtomExpr (TextAtom ""))
7878 reenv = mkRelationalExprEnv DBC.empty graph
7979 bossRel <- assertEither $ runRelationalExprM reenv (evalRelationalExpr (Restrict predicate (ExistingRelation emprel)))
80− print "spam1"
8180 nonBossRel <- assertEither $ runRelationalExprM reenv (evalRelationalExpr (Restrict (NotPredicate predicate) (ExistingRelation emprel)))
8281
8382 let schemaA = mkRelationalExprEnv baseContext graph
@@ -94,7 +93,6 @@ testIsoRestrict = TestCase $ do
9493 let empResult = evalRelExpr (evalRelationalExpr empExpr)
9594 unionResult = evalRelExpr (evalRelationalExpr unionq)
9695 evalRelExpr = runRelationalExprM schemaA
97− print "spam2"
9896 assertEqual "boss/nonboss isorestrict" unionResult empResult
9997 --execute database context expr
10098 bobRel <- assertEither (mkRelationFromList empattrs [[TextAtom "Bob", TextAtom ""]])
test/Server/Main.hs+3−2
@@ -146,10 +146,11 @@ testPlanForDatabaseContextExpr sessionId conn = TestCase $ do
146146 let attrExprs = [AttributeAndTypeNameExpr "x" (PrimitiveTypeConstructor "Int" IntAtomType) ()]
147147 testrv = "testrv"
148148 dbExpr = Define testrv attrExprs
149+ expected = Define testrv [AttributeAndTypeNameExpr "x" (PrimitiveTypeConstructor "Int" IntAtomType) UncommittedContextMarker]
149150 planResult <- planForDatabaseContextExpr sessionId conn dbExpr
150151 case planResult of
151152 Left err -> assertFailure (show err)
152− Right plan -> assertEqual "planForDatabaseContextExpr failure" dbExpr plan
153+ Right plan -> assertEqual "planForDatabaseContextExpr failure" expected plan
153154
154155testTransactionGraphAsRelation :: SessionId -> Connection -> Test
155156testTransactionGraphAsRelation sessionId conn = TestCase $ do
@@ -244,4 +245,4 @@ fdCount = do
244245#else
245246--pass on non-linux platforms
246247testFileDescriptorCount = TestCase (pure ())
247−#endif
248+#endif
test/TransactionGraph/Persist.hs+1−1
@@ -57,7 +57,7 @@ testDBSimplePersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \temp
5757 Left err -> assertFailure (show err)
5858 Right context' -> do
5959 freshId' <- nextRandom
60− let newdiscon = DisconnectedTransaction (transactionId headTrans) (Schemas context' M.empty) True
60+ let newdiscon = DisconnectedTransaction (transactionId headTrans) (Schemas context' M.empty) NoOperation
6161 addTrans = addDisconnectedTransaction stamp' freshId' "master" newdiscon graph
6262 --add a transaction to the graph
6363 case addTrans of
test/TutorialD/Interpreter.hs+4−4
@@ -41,8 +41,8 @@ main = do
4141 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
4242 where
4343 tests = [
44− simpleRelTests
45−{- dateExampleRelTests,
44+ simpleRelTests,
45+ dateExampleRelTests,
4646 transactionGraphBasicTest,
4747 transactionGraphAddCommitTest,
4848 transactionRollbackTest,
@@ -75,7 +75,7 @@ main = do
7575 testNonEmptyListType,
7676 testUnresolvedAtomTypes,
7777 testWithClause,
78− testAtomFunctionArgumentMismatch-}
78+ testAtomFunctionArgumentMismatch
7979 ]
8080
8181simpleRelTests :: Test
@@ -226,7 +226,7 @@ transactionGraphAddCommitTest = TestCase $ do
226226 commit sessionId dbconn >>= eitherFail
227227 discon <- disconnectedTransaction_ sessionId dbconn
228228 let context = Discon.concreteDatabaseContext discon
229− assertEqual "ensure x was added" (M.lookup "x" (relationVariables context)) (Just (ExistingRelation suppliersRel))
229+ assertEqual "ensure x was added" (M.lookup "x" (relationVariables context)) (Just (RelationVariable "s" UncommittedContextMarker))
230230
231231transactionRollbackTest :: Test
232232transactionRollbackTest = TestCase $ do