170009a · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

WIP more test fixes

170009aAgentM7 years ago

project-m36.cabal+7−7

compare with master

unifiedsplit

@@ -1,5 +1,5 @@

1Name: project-m36

2−Version: 0.6

2+Version: 0.8

3License: PublicDomain

4Build-Type: Simple

5Homepage: https://github.com/agentm/project-m36

@@ -246,7 +246,7 @@ Test-Suite test-tutoriald

246 Default-Extensions: OverloadedStrings

247 type: exitcode-stdio-1.0

248 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

250 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

251 GHC-Options: -Wall -threaded

252 Hs-Source-Dirs: ./src/bin, ., test

@@ -390,14 +390,14 @@ Test-Suite test-scripts

390 Default-Extensions: OverloadedStrings

391 type: exitcode-stdio-1.0

392 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

394 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

395 GHC-Options: -Wall -threaded

396 Hs-Source-Dirs: ., ./src/bin

397

398Executable project-m36-websocket-server

399 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

401 Main-Is: ProjectM36/Server/WebSocket/websocket-server.hs

402 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

403 GHC-Options: -Wall -threaded

@@ -427,7 +427,7 @@ Test-Suite test-atomable

427 Default-Language: Haskell2010

428 type: exitcode-stdio-1.0

429 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

431 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

432 Default-Extensions: OverloadedStrings

433 GHC-Options: -Wall -threaded

@@ -474,7 +474,7 @@ Test-Suite test-client-simple

474Executable handles

475 Default-Language: Haskell2010

476 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

478 main-is: benchmark/Handles.hs

479 Other-Modules: TutorialD.Interpreter,

480 TutorialD.Interpreter.Base,

@@ -503,7 +503,7 @@ Test-Suite test-dataframe

503 Main-Is: test/DataFrame.hs

504 type: exitcode-stdio-1.0

505 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

507 Default-Extensions: OverloadedStrings

508 GHC-Options: -Wall -threaded

509 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 #-}

2module ProjectM36.Server.WebSocket where

3-- 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

4-- 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

430data Transaction = Transaction TransactionId TransactionInfo Schemas

431

432-- | 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

434--the database context expression represents a difference between the disconnected transaction and its immutable parent transaction- is this diff expr used at all?

435

436type DirtyFlag = Bool

src/lib/ProjectM36/Client.hs+4−4

@@ -419,7 +419,7 @@ createSessionAtCommit_ commitId newSessionId (InProcessConnection conf) = do

419 case RE.transactionForId commitId graph of

420 Left err -> pure (Left err)

421 Right transaction -> do

422− let freshDiscon = DisconnectedTransaction commitId (Trans.schemas transaction) NoOperation

422+ let freshDiscon = DisconnectedTransaction commitId (Trans.schemas transaction) False

423 keyDuplication <- StmMap.lookup newSessionId sessions

424 case keyDuplication of

425 Just _ -> pure $ Left (SessionIdInUseError newSessionId)

@@ -614,7 +614,7 @@ executeDatabaseContextExpr sessionId (InProcessConnection conf) expr = excEither

614 if not (RE.dbc_dirty newState) then --nothing dirtied, nothing to do

615 pure (Right ())

616 else do

617− let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas NoOperation

617+ let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas False

618 context' = RE.dbc_context newState

619 newSubschemas = Schema.processDatabaseContextExprSchemasUpdate (Sess.subschemas session) expr

620 newSchemas = Schemas context' newSubschemas

@@ -670,7 +670,7 @@ executeDatabaseContextIOExpr sessionId (InProcessConnection conf) expr = excEith

670 case res of

671 Left err -> pure (Left err)

672 Right newState -> do

673− let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas NoOperation

673+ let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas False

674 newSchemas = Schemas context' (Sess.subschemas session)

675 newSession = Session newDiscon (Sess.schemaName session)

676 context' = RE.dbc_context newState

@@ -834,7 +834,7 @@ executeSchemaExpr sessionId (InProcessConnection conf) schemaExpr = atomically $

834 --hm- maybe we should start using lenses

835 let discon = Sess.disconnectedTransaction session

836 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)

838 StmMap.insert newSession sessionId sessions

839 pure (Right ())

840executeSchemaExpr sessionId conn@(RemoteProcessConnection _) schemaExpr = remoteCall conn (ExecuteSchemaExpr sessionId schemaExpr)

src/lib/ProjectM36/DisconnectedTransaction.hs+2−6

@@ -11,11 +11,7 @@ parentId :: DisconnectedTransaction -> TransactionId

11parentId (DisconnectedTransaction pid _ _) = pid

13isDirty :: DisconnectedTransaction -> Bool

14−isDirty (DisconnectedTransaction _ _ NoOperation) = False

14+isDirty (DisconnectedTransaction _ _ flag) = flag

15−isDirty _ = True

16−

17−diffExpr :: DisconnectedTransaction -> DatabaseContextExpr

18−diffExpr (DisconnectedTransaction _ _ expr) = expr

20freshTransaction :: TransactionId -> Schemas -> DisconnectedTransaction

16freshTransaction :: 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

205 Left err -> Left err

206 Right parentTrans -> Right (newTrans, graph)

207 where

208− newTrans = DisconnectedTransaction jumpId (schemas parentTrans) NoOperation

208+ newTrans = DisconnectedTransaction jumpId (schemas parentTrans) False

209

210-- switch from one head to another

211evalGraphOp _ _ _ graph (JumpToHead headName) =

212 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

214 Right (disconnectedTrans, graph)

215 Nothing -> Left $ NoSuchHeadNameError headName

216

test/IsomorphicSchema.hs+1−3

@@ -13,7 +13,7 @@ import qualified Data.Map as M

13import qualified Data.Set as S

15testList :: Test

16−testList = TestList [testIsoRename, testIsoRestrict]--, testIsoUnion, testSchemaValidation]

16+testList = TestList [testIsoRename, testIsoRestrict, testIsoUnion, testSchemaValidation]

18main :: IO ()

19main = do

@@ -77,7 +77,6 @@ testIsoRestrict = TestCase $ do

77 let predicate = AttributeEqualityPredicate "boss" (NakedAtomExpr (TextAtom ""))

78 reenv = mkRelationalExprEnv DBC.empty graph

79 bossRel <- assertEither $ runRelationalExprM reenv (evalRelationalExpr (Restrict predicate (ExistingRelation emprel)))

80− print "spam1"

81 nonBossRel <- assertEither $ runRelationalExprM reenv (evalRelationalExpr (Restrict (NotPredicate predicate) (ExistingRelation emprel)))

80 nonBossRel <- assertEither $ runRelationalExprM reenv (evalRelationalExpr (Restrict (NotPredicate predicate) (ExistingRelation emprel)))

83 let schemaA = mkRelationalExprEnv baseContext graph

82 let schemaA = mkRelationalExprEnv baseContext graph

@@ -94,7 +93,6 @@ testIsoRestrict = TestCase $ do

94 let empResult = evalRelExpr (evalRelationalExpr empExpr)

93 let empResult = evalRelExpr (evalRelationalExpr empExpr)

95 unionResult = evalRelExpr (evalRelationalExpr unionq)

94 unionResult = evalRelExpr (evalRelationalExpr unionq)

96 evalRelExpr = runRelationalExprM schemaA

95 evalRelExpr = runRelationalExprM schemaA

97− print "spam2"

98 assertEqual "boss/nonboss isorestrict" unionResult empResult

96 assertEqual "boss/nonboss isorestrict" unionResult empResult

99 --execute database context expr

97 --execute database context expr

100 bobRel <- assertEither (mkRelationFromList empattrs [[TextAtom "Bob", TextAtom ""]])

98 bobRel <- assertEither (mkRelationFromList empattrs [[TextAtom "Bob", TextAtom ""]])

test/Server/Main.hs+3−2

@@ -146,10 +146,11 @@ testPlanForDatabaseContextExpr sessionId conn = TestCase $ do

146 let attrExprs = [AttributeAndTypeNameExpr "x" (PrimitiveTypeConstructor "Int" IntAtomType) ()]

147 testrv = "testrv"

148 dbExpr = Define testrv attrExprs

149+ expected = Define testrv [AttributeAndTypeNameExpr "x" (PrimitiveTypeConstructor "Int" IntAtomType) UncommittedContextMarker]

149 planResult <- planForDatabaseContextExpr sessionId conn dbExpr

150 planResult <- planForDatabaseContextExpr sessionId conn dbExpr

150 case planResult of

151 case planResult of

151 Left err -> assertFailure (show err)

152 Left err -> assertFailure (show err)

152− Right plan -> assertEqual "planForDatabaseContextExpr failure" dbExpr plan

153+ Right plan -> assertEqual "planForDatabaseContextExpr failure" expected plan

153

154

154testTransactionGraphAsRelation :: SessionId -> Connection -> Test

155testTransactionGraphAsRelation :: SessionId -> Connection -> Test

155testTransactionGraphAsRelation sessionId conn = TestCase $ do

156testTransactionGraphAsRelation sessionId conn = TestCase $ do

@@ -244,4 +245,4 @@ fdCount = do

244#else

245#else

245--pass on non-linux platforms

246--pass on non-linux platforms

246testFileDescriptorCount = TestCase (pure ())

247testFileDescriptorCount = TestCase (pure ())

247−#endif

248+#endif

test/TransactionGraph/Persist.hs+1−1

@@ -57,7 +57,7 @@ testDBSimplePersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \temp

57 Left err -> assertFailure (show err)

58 Right context' -> do

59 freshId' <- nextRandom

60− let newdiscon = DisconnectedTransaction (transactionId headTrans) (Schemas context' M.empty) True

60+ let newdiscon = DisconnectedTransaction (transactionId headTrans) (Schemas context' M.empty) NoOperation

61 addTrans = addDisconnectedTransaction stamp' freshId' "master" newdiscon graph

62 --add a transaction to the graph

63 case addTrans of

test/TutorialD/Interpreter.hs+4−4

@@ -41,8 +41,8 @@ main = do

41 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess

42 where

43 tests = [

44− simpleRelTests

44+ simpleRelTests,

45−{- dateExampleRelTests,

45+ dateExampleRelTests,

46 transactionGraphBasicTest,

47 transactionGraphAddCommitTest,

48 transactionRollbackTest,

@@ -75,7 +75,7 @@ main = do

75 testNonEmptyListType,

76 testUnresolvedAtomTypes,

77 testWithClause,

78− testAtomFunctionArgumentMismatch-}

78+ testAtomFunctionArgumentMismatch

79 ]

81simpleRelTests :: Test

@@ -226,7 +226,7 @@ transactionGraphAddCommitTest = TestCase $ do

226 commit sessionId dbconn >>= eitherFail

227 discon <- disconnectedTransaction_ sessionId dbconn

228 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))

230

231transactionRollbackTest :: Test

232transactionRollbackTest = TestCase $ do