git.iko.soy/project-m36
on master help sign in
shuffle pretty printer around to use it exclusively from the tutd console
commitf5e3e65d3bc7619e87ba4acdcc30f9cf48c96a39 authorAgentM <agentm@themactionfaction.com> dateSat 21 Nov 2020, 14:47 (6 years ago) parenta77fba2
16 files changed+256−120
compare with master
unifiedsplit
project-m36.cabal+32−27 src/bin/TutorialD/Interpreter/Base.hs+1−1 src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+22−5 src/lib/ProjectM36/PrettyPrinter.hs → src/bin/TutorialD/Printer.hs+72−32 src/lib/ProjectM36/Arbitrary.hs+5 src/lib/ProjectM36/Atom.hs+1 src/lib/ProjectM36/AtomType.hs+1 src/lib/ProjectM36/Atomable.hs+1 src/lib/ProjectM36/Base.hs+61−26 src/lib/ProjectM36/DataTypes/Interval.hs+2 src/lib/ProjectM36/DataTypes/Primitive.hs+1 src/lib/ProjectM36/DataTypes/Sorting.hs+1 src/lib/ProjectM36/InclusionDependency.hs+4−7 src/lib/ProjectM36/Relation/Parse/CSV.hs+5 test/PrettyPrinter.hs−22 test/TutorialD/Printer.hs+47
project-m36.cabal+32−27
@@ -34,7 +34,7 @@ Flag haskell-scripting
3434 Default: True
3535
3636Library
37− Build-Depends: base>=4.8 && < 4.15, ghc-paths, mtl, containers, unordered-containers, hashable, haskeline, directory, MonadRandom, random-shuffle, uuid >= 1.3.12, cassava >= 0.4.5.1 && < 0.6, text, bytestring, deepseq, deepseq-generics, vector, parallel, monad-parallel, exceptions, transformers, gnuplot, binary, filepath, zlib, directory, vector-binary-instances, temporary, stm, time, hashable-time, old-locale, rset, attoparsec, either, base64-bytestring, data-interval, extended-reals, network-transport, aeson >= 1.1, path-pieces, conduit, resourcet, http-api-data, semigroups, QuickCheck, quickcheck-instances, distributed-process-client-server >= 0.2.3, distributed-process >= 0.7.4, distributed-process-extras >= 0.3.2, distributed-process-async >= 0.2.4.1, network-transport-tcp >= 0.6.0, network-transport, list-t, stm-containers >= 0.2.15, foldl, optparse-applicative, Glob, cryptohash-sha256, text-manipulate >= 0.2.0.1 && < 0.3, prettyprinter
37+ Build-Depends: base>=4.8 && < 4.15, ghc-paths, mtl, containers, unordered-containers, hashable, haskeline, directory, MonadRandom, random-shuffle, uuid >= 1.3.12, cassava >= 0.4.5.1 && < 0.6, text, bytestring, deepseq, deepseq-generics, vector, parallel, monad-parallel, exceptions, transformers, gnuplot, binary, filepath, zlib, directory, vector-binary-instances, temporary, stm, time, hashable-time, old-locale, rset, attoparsec, either, base64-bytestring, data-interval, extended-reals, network-transport, aeson >= 1.1, path-pieces, conduit, resourcet, http-api-data, semigroups, QuickCheck, quickcheck-instances, distributed-process-client-server >= 0.2.3, distributed-process >= 0.7.4, distributed-process-extras >= 0.3.2, distributed-process-async >= 0.2.4.1, network-transport-tcp >= 0.6.0, network-transport, list-t, stm-containers >= 0.2.15, foldl, optparse-applicative, Glob, cryptohash-sha256, text-manipulate >= 0.2.0.1 && < 0.3, vector-instances
3838 if flag(haskell-scripting)
3939 Build-Depends: ghc >= 8.2 && < 8.11
4040 CPP-Options: -DPM36_HASKELL_SCRIPTING
@@ -121,8 +121,7 @@ Library
121121 ProjectM36.GraphRefRelationalExpr,
122122 ProjectM36.NormalizeExpr,
123123 ProjectM36.TransactionInfo,
124− ProjectM36.WithNameExpr,
125− ProjectM36.PrettyPrinter
124+ ProjectM36.WithNameExpr
126125 GHC-Options: -Wall -rdynamic
127126 if os(windows)
128127 Build-Depends: Win32 >= 2.5.4.1
@@ -178,7 +177,8 @@ Executable tutd
178177 attoparsec,
179178 stm-containers >= 1.0.0,
180179 list-t,
181− parser-combinators
180+ parser-combinators,
181+ prettyprinter
182182 Other-Modules: TutorialD.Interpreter,
183183 TutorialD.Interpreter.Base,
184184 TutorialD.Interpreter.DatabaseContextExpr,
@@ -197,6 +197,7 @@ Executable tutd
197197 TutorialD.Interpreter.SchemaOperator,
198198 TutorialD.Interpreter.TransGraphRelationalOperator,
199199 TutorialD.Interpreter.SchemaOperator
200+ TutorialD.Printer
200201 main-is: TutorialD/tutd.hs
201202 CC-Options: -fPIC
202203 GHC-Options: -Wall -threaded
@@ -273,8 +274,8 @@ Test-Suite test-tutoriald
273274 Default-Extensions: OverloadedStrings
274275 type: exitcode-stdio-1.0
275276 main-is: test/TutorialD/Interpreter.hs
276− 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
277− 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
277+ 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, prettyprinter
278+ 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, TutorialD.Printer
278279 GHC-Options: -Wall -threaded
279280 Hs-Source-Dirs: ./src/bin, ., test
280281
@@ -282,9 +283,9 @@ Test-Suite test-tutoriald-atomfunctionscript
282283 Default-Language: Haskell2010
283284 Default-Extensions: OverloadedStrings
284285 type: exitcode-stdio-1.0
285− 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.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.SchemaOperator
286+ 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.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer
286287 main-is: test/TutorialD/Interpreter/AtomFunctionScript.hs
287− Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time, parser-combinators
288+ Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time, parser-combinators, prettyprinter, base64-bytestring
288289 GHC-Options: -Wall -threaded
289290 Hs-Source-Dirs: ./src/bin, ./test, .
290291
@@ -292,9 +293,9 @@ Test-Suite test-tutoriald-databasecontextfunctionscript
292293 Default-Language: Haskell2010
293294 Default-Extensions: OverloadedStrings
294295 type: exitcode-stdio-1.0
295− 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.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.SchemaOperator
296+ 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.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer
296297 main-is: test/TutorialD/Interpreter/DatabaseContextFunctionScript.hs
297− Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time, parser-combinators
298+ Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time, parser-combinators, prettyprinter, base64-bytestring
298299 GHC-Options: -Wall -threaded
299300 Hs-Source-Dirs: ./src/bin, ./test, .
300301
@@ -319,8 +320,8 @@ Test-Suite test-transactiongraph-persist
319320 Default-Extensions: OverloadedStrings
320321 type: exitcode-stdio-1.0
321322 main-is: test/TransactionGraph/Persist.hs
322− 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, project-m36, random, MonadRandom, semigroups, parser-combinators
323− Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples
323+ 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, project-m36, random, MonadRandom, semigroups, parser-combinators, prettyprinter
324+ Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Printer
324325 Hs-Source-Dirs: ., ./src/bin
325326 GHC-Options: -Wall -threaded
326327
@@ -329,7 +330,7 @@ Test-Suite test-relation-import-csv
329330 Default-Extensions: OverloadedStrings
330331 type: exitcode-stdio-1.0
331332 main-is: test/Relation/Import/CSV.hs
332− 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, project-m36
333+ 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, project-m36, prettyprinter
333334 GHC-Options: -Wall -threaded
334335
335336Test-Suite test-tutoriald-import-tutoriald
@@ -337,8 +338,8 @@ Test-Suite test-tutoriald-import-tutoriald
337338 Default-Extensions: OverloadedStrings
338339 type: exitcode-stdio-1.0
339340 main-is: test/TutorialD/Interpreter/Import/TutorialD.hs
340− 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, project-m36, random, MonadRandom, semigroups, parser-combinators
341− Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples
341+ 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, project-m36, random, MonadRandom, semigroups, parser-combinators, prettyprinter
342+ Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Printer
342343 GHC-Options: -Wall -threaded
343344 Hs-Source-Dirs: ., ./src/bin
344345
@@ -347,7 +348,7 @@ Test-Suite test-relation-export-csv
347348 Default-Extensions: OverloadedStrings
348349 type: exitcode-stdio-1.0
349350 main-is: test/Relation/Export/CSV.hs
350− 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, project-m36
351+ 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, project-m36, prettyprinter
351352 GHC-Options: -Wall -threaded
352353
353354Test-Suite test-transactiongraph-merge
@@ -362,9 +363,11 @@ Test-Suite test-prettyprinter
362363 Default-Language: Haskell2010
363364 Default-Extensions: OverloadedStrings
364365 type: exitcode-stdio-1.0
365− main-is: test/PrettyPrinter.hs
366− 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, template-haskell, transformers, aeson, conduit, either, path-pieces, http-api-data, stm-containers, list-t, project-m36
366+ main-is: test/TutorialD/Printer.hs
367+ 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, template-haskell, transformers, aeson, conduit, either, path-pieces, http-api-data, stm-containers, list-t, project-m36, prettyprinter, random, MonadRandom, parser-combinators, base64-bytestring
367368 GHC-Options: -Wall -threaded
369+ Other-Modules: TutorialD.Printer, TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types
370+ Hs-Source-Dirs: ., ./src/bin
368371
369372benchmark bench
370373 Default-Language: Haskell2010
@@ -453,7 +456,7 @@ Test-Suite test-websocket-server
453456 Default-Language: Haskell2010
454457 type: exitcode-stdio-1.0
455458 main-is: test/Server/WebSocket.hs
456− 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, network-transport-tcp, semigroups, parser-combinators
459+ 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, network-transport-tcp, semigroups, parser-combinators, prettyprinter
457460 Other-Modules: TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.TransactionGraphOperator, ProjectM36.Client.Json, ProjectM36.Server.RemoteCallTypes.Json, ProjectM36.Server.WebSocket, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.SchemaOperator
458461 Default-Extensions: OverloadedStrings
459462 GHC-Options: -Wall -threaded
@@ -463,17 +466,18 @@ Test-Suite test-isomorphic-schemas
463466 Default-Language: Haskell2010
464467 type: exitcode-stdio-1.0
465468 main-is: test/IsomorphicSchema.hs
466− 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
469+ 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, prettyprinter
467470 Default-Extensions: OverloadedStrings
468471 GHC-Options: -Wall -threaded
469472 Hs-Source-Dirs: ./src/bin, .
473+ Other-Modules: TutorialD.Printer
470474
471475Test-Suite test-atomable
472476 Default-Language: Haskell2010
473477 type: exitcode-stdio-1.0
474478 main-is: test/Relation/Atomable.hs
475− 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
476− 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
479+ 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, prettyprinter
480+ 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, TutorialD.Printer
477481 Default-Extensions: OverloadedStrings
478482 GHC-Options: -Wall -threaded
479483 Hs-Source-Dirs: ./src/bin, ., test/
@@ -491,7 +495,7 @@ Test-Suite test-transactiongraph-automerge
491495 Default-Language: Haskell2010
492496 type: exitcode-stdio-1.0
493497 main-is: test/TransactionGraph/Automerge.hs
494− 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
498+ 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, prettyprinter
495499 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
496500 Default-Extensions: OverloadedStrings
497501 GHC-Options: -Wall -threaded
@@ -501,7 +505,7 @@ Test-Suite test-tupleable
501505 Default-Language: Haskell2010
502506 type: exitcode-stdio-1.0
503507 main-is: test/Relation/Tupleable.hs
504− 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
508+ 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, prettyprinter
505509 Default-Extensions: OverloadedStrings
506510 GHC-Options: -Wall -threaded
507511 Hs-Source-Dirs: ./src/bin, ., test/
@@ -510,10 +514,11 @@ Test-Suite test-client-simple
510514 Default-Language: Haskell2010
511515 Main-Is: test/Client/Simple.hs
512516 type: exitcode-stdio-1.0
513− 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
517+ 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, prettyprinter
514518 Default-Extensions: OverloadedStrings
515519 GHC-Options: -Wall -threaded
516520 Hs-Source-Dirs: ./src/bin, ., test/
521+ Other-Modules: TutorialD.Printer
517522
518523-- test for file handle leaks
519524Executable handles
@@ -547,8 +552,8 @@ Test-Suite test-dataframe
547552 Default-Language: Haskell2010
548553 Main-Is: test/DataFrame.hs
549554 type: exitcode-stdio-1.0
550− 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
551− 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
555+ 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, TutorialD.Printer
556+ 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, prettyprinter
552557 Default-Extensions: OverloadedStrings
553558 GHC-Options: -Wall -threaded
554559 Hs-Source-Dirs: ./src/bin, ., test/
src/bin/TutorialD/Interpreter/Base.hs+1−1
@@ -226,5 +226,5 @@ utcTimeP = do
226226
227227colonOp :: Text -> Parser ()
228228colonOp opStr = do
229− _ <- string opStr <* spaceChar <* spaceConsumer
229+ _ <- string opStr <* (void spaceChar <|> eof) <* spaceConsumer
230230 pure ()
src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+22−5
@@ -1,13 +1,16 @@
11{-# LANGUAGE GADTs #-}
22module TutorialD.Interpreter.RODatabaseContextOperator where
33import ProjectM36.Base
4+import ProjectM36.Relation
45import qualified ProjectM36.DataFrame as DF
56import ProjectM36.Error
7+import ProjectM36.Tuple
68import ProjectM36.InclusionDependency
79import qualified ProjectM36.Client as C
810import TutorialD.Interpreter.Base
911import TutorialD.Interpreter.RelationalExpr
1012import TutorialD.Interpreter.DatabaseContextExpr
13+import TutorialD.Printer
1114import Control.Monad.State
1215import qualified Data.Text as T
1316import ProjectM36.Relation.Show.Gnuplot
@@ -19,7 +22,7 @@ data RODatabaseContextOperator where
1922 ShowRelation :: RelationalExpr -> RODatabaseContextOperator
2023 PlotRelation :: RelationalExpr -> RODatabaseContextOperator
2124 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator
22− ShowConstraint :: StringType -> RODatabaseContextOperator
25+ ShowConstraints :: StringType -> RODatabaseContextOperator
2326 ShowPlan :: DatabaseContextExpr -> RODatabaseContextOperator
2427 ShowTypes :: RODatabaseContextOperator
2528 ShowRelationVariables :: RODatabaseContextOperator
@@ -64,7 +67,7 @@ quitP = do
6467showConstraintsP :: Parser RODatabaseContextOperator
6568showConstraintsP = do
6669 colonOp ":constraints"
67− ShowConstraint <$> option "" identifier
70+ ShowConstraints <$> option "" identifier
6871
6972plotRelExprP :: Parser RODatabaseContextOperator
7073plotRelExprP = do
@@ -106,15 +109,16 @@ evalRODatabaseContextOp sessionId conn (PlotRelation expr) = do
106109 err <- plotRelation rel
107110 when (isJust err) $ print err
108111
109−evalRODatabaseContextOp sessionId conn (ShowConstraint name) = do
112+evalRODatabaseContextOp sessionId conn (ShowConstraints name) = do
110113 eIncDeps <- C.inclusionDependencies sessionId conn
111114 let val = case eIncDeps of
112115 Left err -> Left err
113116 Right incDeps -> case name of
114− "" -> inclusionDependenciesAsRelation incDeps
117+ "" -> inclusionDependenciesAsRelation incDeps >>= renderRelExprsInIncDeps
115118 depName -> case M.lookup depName incDeps of
116119 Nothing -> Left (InclusionDependencyNameNotInUseError depName)
117− Just dep -> inclusionDependenciesAsRelation (M.singleton depName dep)
120+ Just dep ->
121+ inclusionDependenciesAsRelation (M.singleton depName dep) >>= renderRelExprsInIncDeps
118122 pure $ case val of
119123 Left err -> DisplayErrorResult (T.pack (show err))
120124 Right rel -> DisplayRelationResult rel
@@ -191,3 +195,16 @@ attrOrderExprP = DF.AttributeOrderExpr <$> identifier <*> orderP
191195
192196orderP :: Parser DF.Order
193197orderP = try (reservedOp "ascending" >> pure DF.AscendingOrder) <|> try (reservedOp "descending" >> pure DF.DescendingOrder) <|> pure DF.AscendingOrder
198+
199+-- render RelationalExprAtoms as TutorialD
200+renderRelExprsInIncDeps :: Relation -> Either RelationalError Relation
201+renderRelExprsInIncDeps = relMogrify tupMapper attrs
202+ where
203+ tupMapper tup = pure $ mkRelationTupleFromMap (M.map mapper (tupleToMap tup))
204+ mapper (RelationalExprAtom expr) = TextAtom (T.pack (show (prettyRelationalExpr expr)))
205+ mapper atom = atom
206+ attrs = C.attributesFromList [Attribute "name" TextAtomType,
207+ Attribute "sub" TextAtomType,
208+ Attribute "super" TextAtomType
209+ ]
210+
src/lib/ProjectM36/PrettyPrinter.hs → src/bin/TutorialD/Printer.hsrenamed+72−32
@@ -1,52 +1,67 @@
1−{-# LANGUAGE TypeSynonymInstances #-}
1+{-# OPTIONS_GHC -fno-warn-orphans #-}
22{-# LANGUAGE FlexibleInstances #-}
33{-# LANGUAGE OverloadedStrings #-}
44{-# LANGUAGE ScopedTypeVariables #-}
5−module ProjectM36.PrettyPrinter where
5+{-# LANGUAGE TypeApplications #-}
6+module TutorialD.Printer where
67import ProjectM36.Base
7−import ProjectM36.Atomable
8−import ProjectM36.Attribute
8+import ProjectM36.Attribute hiding (null)
99import Data.Text.Prettyprint.Doc
1010import qualified Data.Set as S hiding (fromList)
11−import qualified Data.Text as T
1211import qualified Data.Vector as V
1312import qualified Data.Map.Strict as M
14−import Data.Foldable as F
13+import Data.Time.Calendar
14+import Data.Time.Clock.POSIX
15+import qualified Data.ByteString.Base64 as B64
16+import qualified Data.Text.Encoding as TE
1517
1618instance Pretty Atom where
1719 pretty (IntegerAtom x) = pretty x
18− pretty (IntAtom x) = pretty x
20+ pretty (IntAtom x) = "int" <> parensList [pretty x]
1921 pretty (DoubleAtom x) = pretty x
20− pretty (TextAtom x) = pretty x
21− pretty (DayAtom x) = pretty $ show x
22− pretty (DateTimeAtom x) = pretty $ show x
23− pretty (ByteStringAtom x) = pretty $ show x
24− pretty (BoolAtom x) = pretty x
22+ pretty (TextAtom x) = dquotes (pretty x)
23+ pretty (DayAtom x) = "fromGregorian" <> parensList [pretty a, pretty b, pretty c]
24+ where
25+ (a,b,c) = toGregorian x
26+ pretty (DateTimeAtom time) = "dateTimeFromEpochSeconds" <> parensList [pretty @Integer (round (utcTimeToPOSIXSeconds time))]
27+ pretty (ByteStringAtom bs) = "bytestring" <> parensList [dquotes (pretty (TE.decodeUtf8 (B64.encode bs)))]
28+ pretty (BoolAtom x) = if x then "t" else "f"
2529 pretty (RelationAtom x) = pretty x
26− pretty (ConstructedAtom n ty as) = pretty n <+> prettyList as
30+ pretty (RelationalExprAtom re) = pretty re
31+ pretty (ConstructedAtom n _ as) = pretty n <+> prettyList as
2732
2833instance Pretty AtomExpr where
2934 pretty (AttributeAtomExpr attrName) = pretty attrName
3035 pretty (NakedAtomExpr atom) = pretty atom
31− pretty (FunctionAtomExpr atomFuncName atomExprs _) = pretty atomFuncName <> prettyAtomExprsAsArguments atomExprs
32− pretty (RelationAtomExpr relExpr) = pretty relExpr
33− pretty (ConstructedAtomExpr dName atomExprs _) = pretty dName <+> prettyList atomExprs
34−
36+ pretty (FunctionAtomExpr atomFuncName' atomExprs _) = pretty atomFuncName' <> prettyAtomExprsAsArguments atomExprs
37+ pretty (RelationAtomExpr relExpr) = pretty relExpr
38+ pretty (ConstructedAtomExpr dName [] _) = pretty dName
39+ pretty (ConstructedAtomExpr dName atomExprs _) = pretty dName <+> hsep (map prettyAtomExpr atomExprs)
40+
41+prettyAtomExpr :: AtomExpr -> Doc ann
42+prettyAtomExpr atomExpr =
43+ case atomExpr of
44+ AttributeAtomExpr attrName -> "@" <> pretty attrName
45+ ConstructedAtomExpr dConsName [] () -> pretty dConsName
46+ ConstructedAtomExpr dConsName atomExprs () -> parens (pretty dConsName <+> hsep (map prettyAtomExpr atomExprs))
47+ _ -> pretty atomExpr
48+
3549prettyAtomExprsAsArguments :: [AtomExpr] -> Doc ann
3650prettyAtomExprsAsArguments = align . parensList . map addAt
37− where addAt (atomExpr :: AtomExpr) = case atomExpr of
38− AttributeAtomExpr attrName -> "@" <> pretty attrName
39− otherwise -> pretty atomExpr
51+ where addAt (atomExpr :: AtomExpr) =
52+ case atomExpr of
53+ AttributeAtomExpr attrName -> "@" <> pretty attrName
54+ _ -> pretty atomExpr
4055
4156instance Pretty TupleExpr where
42− pretty (TupleExpr map) = "tuple" <> bracesList (Prelude.map (\(attrName,atom)-> pretty attrName <+> pretty atom) (M.toList map))
57+ pretty (TupleExpr map') = "tuple" <> bracesList (Prelude.map (\(attrName,atom)-> pretty attrName <+> pretty atom) (M.toList map'))
4358
4459instance Pretty RelationTuple where
4560 pretty (RelationTuple attrs atoms) = "tuple" <> bracesList (zipWith (\x y-> pretty x <+> pretty y) (V.toList (attributeNames attrs)) (V.toList atoms))
4661
4762instance Pretty Relation where
48− pretty (Relation attrs tupSet) | attrs == V.empty && (asList tupSet) == [] = "false"
49− pretty (Relation attrs tupSet) | attrs == V.empty && (asList tupSet) == [RelationTuple V.empty (V.empty)] = "true"
63+ pretty (Relation attrs tupSet) | attrs == V.empty && null (asList tupSet) = "false"
64+ pretty (Relation attrs tupSet) | attrs == V.empty && asList tupSet == [RelationTuple V.empty V.empty] = "true"
5065 pretty (Relation attrs tupSet) = "relation" <> prettyBracesList (V.toList attrs) <> prettyBracesList (asList tupSet)
5166
5267instance Pretty Attribute where
@@ -59,34 +74,38 @@ instance Pretty RelationalExpr where
5974 pretty (Equals a b) = pretty' a <+> "==" <+> pretty' b
6075 pretty (Project ns r) = pretty' (ignoreProjects r) <> pretty ns
6176 pretty (Extend ext r) = collectExtends r <> pretty ext <> "}"
62− pretty (MakeRelationFromExprs (Just attrExprs) tupExprs) = "relation" <> (prettyBracesList attrExprs) <> prettyBracesList (F.toList tupExprs)
77+ pretty (MakeRelationFromExprs Nothing (TupleExprs () tupExprs)) = "relation" <> prettyBracesList tupExprs
78+ pretty (MakeRelationFromExprs (Just attrExprs) (TupleExprs () tupExprs)) = "relation" <> prettyBracesList attrExprs <> prettyBracesList tupExprs
6379 pretty (MakeStaticRelation attrs tupSet) = "relation" <> prettyBracesList (V.toList attrs) <> prettyBracesList (asList tupSet)
6480 pretty (Union a b) = parens $ pretty' a <+> "union" <+> pretty' b
6581 pretty (Join a b) = parens $ pretty' a <+> "join" <+> pretty' b
6682 pretty (Rename n1 n2 relExpr) = parens $ pretty relExpr <+> "rename" <+> braces (pretty n1 <+> "as" <+> pretty n2)
6783 pretty (Difference a b) = parens $ pretty' a <+> "minus" <+> pretty' b
68− pretty (Group attrNames attrName relExpr) = parens $ pretty relExpr <+> "group" <+> parens ((pretty attrNames) <+> "as" <+> pretty attrName)
84+ pretty (Group attrNames attrName relExpr) = parens $ pretty relExpr <+> "group" <+> parens (pretty attrNames <+> "as" <+> pretty attrName)
6985 pretty (Ungroup attrName relExpr) = parens $ pretty' relExpr <+> "ungroup" <+> pretty attrName
7086 pretty (Restrict resPreExpr relExpr) = parens $ pretty' relExpr <+> "where" <+> pretty resPreExpr
7187 pretty (With pairs a) = "with" <+> parensList (map (\(name,expr)-> pretty name <+> "as" <+> pretty expr) pairs) <+> pretty' a
7288
7389-- relvar:{a:=?}:{b:=?}:... in ADTs => relvar:{a:=?, b:=?, ...} in Doc ann
7490collectExtends :: RelationalExpr -> Doc ann
75−collectExtends (Extend ext r) = (collectExtends r) <> (pretty ext) <> ", "
91+collectExtends (Extend ext r) = collectExtends r <> pretty ext <> ", "
7692collectExtends r = pretty r <> ":{"
7793
7894--relvar{a,b,c,...}{a,b,...}..{a} => relvar{a}
7995ignoreProjects :: RelationalExpr -> RelationalExpr
80−ignoreProjects (Project ns r) = ignoreProjects r
96+ignoreProjects (Project _ r) = ignoreProjects r
8197ignoreProjects r = r
8298
99+prettyRelationalExpr :: RelationalExpr -> Doc n
100+prettyRelationalExpr (RelationVariable n _) = pretty n
101+prettyRelationalExpr r = parens (pretty r)
102+
83103pretty' :: RelationalExpr -> Doc n
84−pretty' (RelationVariable n _) = pretty n
85−pretty' r = parens (pretty r)
104+pretty' = prettyRelationalExpr
86105
87106instance Pretty AttributeNames where
88107 pretty (AttributeNames attrNames) = prettyBracesList (S.toList attrNames)
89− pretty (InvertedAttributeNames attrNames) = braces $ "all but" <+> (concatWith (surround ", ") (map pretty (S.toList attrNames)))
108+ pretty (InvertedAttributeNames attrNames) = braces $ "all but" <+> concatWith (surround ", ") (map pretty (S.toList attrNames))
90109 pretty (RelationalExprAttributeNames relExpr) = braces $ "all from" <+> pretty relExpr
91110 pretty a = error $ show a ++ " is not implemented yet."
92111-- YuMing L.: I guess these two are used in evaluating relational expressions. So we won't be using them in pretty printer.
@@ -95,8 +114,29 @@ instance Pretty AttributeNames where
95114
96115instance Pretty AttributeExpr where
97116 pretty (NakedAttributeExpr attr) = pretty attr
98− pretty (AttributeAndTypeNameExpr name typeCons _) = pretty name <+> pretty (show typeCons) -- workaround
99−
117+ pretty (AttributeAndTypeNameExpr name typeCons _) = pretty name <+> pretty typeCons
118+
119+instance Pretty TypeConstructor where
120+ pretty (ADTypeConstructor tcName []) = pretty tcName
121+ pretty (ADTypeConstructor tcName tConsArgs) = pretty tcName <+> hsep (map pretty tConsArgs)
122+ pretty (PrimitiveTypeConstructor tcName atomType') = pretty tcName <+> pretty atomType'
123+ pretty (RelationAtomTypeConstructor attrExprs) = "relation" <> prettyBracesList attrExprs
124+ pretty (TypeVariable x) = pretty x
125+
126+instance Pretty AtomType where
127+ pretty IntAtomType = "Int"
128+ pretty IntegerAtomType = "Integer"
129+ pretty DoubleAtomType = "Double"
130+ pretty TextAtomType = "Text"
131+ pretty DayAtomType = "Day"
132+ pretty DateTimeAtomType = "DateTime"
133+ pretty ByteStringAtomType = "ByteString"
134+ pretty BoolAtomType = "Bool"
135+ pretty (RelationAtomType attrs) = "relation " <+> prettyBracesList (V.toList attrs)
136+ pretty (ConstructedAtomType tcName tvMap) = pretty tcName <+> hsep (map pretty (M.toList tvMap)) --order matters
137+ pretty RelationalExprAtomType = "RelationalExpr"
138+ pretty (TypeVariableType x) = pretty x
139+
100140instance Pretty ExtendTupleExpr where
101141 pretty (AttributeExtendTupleExpr attrName atomExpr) = pretty attrName <> ":=" <> pretty atomExpr
102142
src/lib/ProjectM36/Arbitrary.hs+5
@@ -9,6 +9,7 @@ import ProjectM36.AtomType
99import ProjectM36.Attribute (atomType)
1010import ProjectM36.DataConstructorDef as DCD
1111import ProjectM36.DataTypes.Interval
12+import ProjectM36.Relation
1213import qualified Data.Vector as V
1314import Data.Text (Text)
1415import Test.QuickCheck
@@ -48,6 +49,10 @@ arbitrary' ByteStringAtomType =
4849
4950arbitrary' BoolAtomType =
5051 Right . BoolAtom <$> lift (arbitrary :: Gen Bool)
52+
53+arbitrary' RelationalExprAtomType =
54+ pure (Right (RelationalExprAtom (ExistingRelation relationTrue))) -- don't bother with arbitrary relational expressions
55+
5156arbitrary' constructedAtomType@(ConstructedAtomType tcName tvMap)
5257 --special-casing for Interval type
5358 | isIntervalAtomType constructedAtomType = createArbitraryInterval (intervalSubType constructedAtomType)
src/lib/ProjectM36/Atom.hs+1
@@ -20,6 +20,7 @@ atomToText (DayAtom i) = (T.pack . show) i
2020atomToText (DateTimeAtom i) = (T.pack . show) i
2121atomToText (ByteStringAtom i) = (T.pack . show) i
2222atomToText (BoolAtom i) = (T.pack . show) i
23+atomToText (RelationalExprAtom re) = (T.pack . show) re
2324
2425atomToText (RelationAtom i) = (T.pack . show) i
2526atomToText (ConstructedAtom dConsName typ atoms)
src/lib/ProjectM36/AtomType.hs+1
@@ -442,6 +442,7 @@ isResolvedType typ =
442442 DateTimeAtomType -> True
443443 ByteStringAtomType -> True
444444 BoolAtomType -> True
445+ RelationalExprAtomType -> True
445446 RelationAtomType attrs -> isResolvedAttributes attrs
446447 ConstructedAtomType _ tvMap -> all isResolvedType (M.elems tvMap)
447448 TypeVariableType _ -> False
src/lib/ProjectM36/Atomable.hs+1
@@ -252,6 +252,7 @@ typeToTypeConstructor x@DayAtomType = PrimitiveTypeConstructor "Day" x
252252typeToTypeConstructor x@DateTimeAtomType = PrimitiveTypeConstructor "DateTime" x
253253typeToTypeConstructor x@ByteStringAtomType = PrimitiveTypeConstructor "ByteString" x
254254typeToTypeConstructor x@BoolAtomType = PrimitiveTypeConstructor "Bool" x
255+typeToTypeConstructor x@RelationalExprAtomType = PrimitiveTypeConstructor "RelationalExpr" x
255256typeToTypeConstructor (RelationAtomType attrs)
256257 = RelationAtomTypeConstructor $ map attrToAttrExpr $ V.toList attrs
257258 where
src/lib/ProjectM36/Base.hs+61−26
@@ -27,6 +27,9 @@ import Data.Hashable.Time ()
2727import Data.Typeable
2828import Data.ByteString (ByteString)
2929import qualified Data.List.NonEmpty as NE
30+import Data.Vector.Instances ()
31+import Data.Hashable.Generic
32+
3033type StringType = Text
3134
3235-- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.
@@ -39,8 +42,9 @@ data Atom = IntegerAtom Integer |
3942 ByteStringAtom ByteString |
4043 BoolAtom Bool |
4144 RelationAtom Relation |
45+ RelationalExprAtom RelationalExpr | --used for returning inc deps
4246 ConstructedAtom DataConstructorName AtomType [Atom]
43− deriving (Eq, Show, Binary, Typeable, NFData, Generic)
47+ deriving (Eq, Show, Binary, Typeable, NFData, Generic, Read)
4448
4549instance Hashable Atom where
4650 hashWithSalt salt (ConstructedAtom dConsName _ atoms) = salt `hashWithSalt` atoms
@@ -54,6 +58,7 @@ instance Hashable Atom where
5458 hashWithSalt salt (ByteStringAtom bs) = salt `hashWithSalt` bs
5559 hashWithSalt salt (BoolAtom b) = salt `hashWithSalt` b
5660 hashWithSalt salt (RelationAtom r) = salt `hashWithSalt` r
61+ hashWithSalt salt (RelationalExprAtom re) = salt `hashWithSalt` re
5762
5863instance Binary UTCTime where
5964 put utc = put $ toRational (utcTimeToPOSIXSeconds utc)
@@ -77,13 +82,15 @@ data AtomType = IntAtomType |
7782 BoolAtomType |
7883 RelationAtomType Attributes |
7984 ConstructedAtomType TypeConstructorName TypeVarMap |
85+ RelationalExprAtomType |
8086 TypeVariableType TypeVarName
8187 --wildcard used in Atom Functions and tuples for data constructors which don't provide all arguments to the type constructor
82− deriving (Eq, NFData, Generic, Binary, Show)
88+ deriving (Eq, NFData, Generic, Binary, Show, Read, Hashable)
8389
8490instance Ord AtomType where
8591 compare = undefined
86−
92+
93+-- this should probably be an ordered dictionary in order to be able to round-trip these arguments
8794type TypeVarMap = M.Map TypeVarName AtomType
8895
8996instance Hashable TypeVarMap where
@@ -98,7 +105,7 @@ isRelationAtomType _ = False
98105type AttributeName = StringType
99106
100107-- | A relation's type is composed of attribute names and types.
101−data Attribute = Attribute AttributeName AtomType deriving (Eq, Show, Generic, NFData, Binary)
108+data Attribute = Attribute AttributeName AtomType deriving (Eq, Show, Read, Generic, NFData, Binary)
102109
103110instance Hashable Attribute where
104111 hashWithSalt salt (Attribute attrName _) = hashWithSalt salt attrName
@@ -116,7 +123,7 @@ sortedAttributesIndices :: Attributes -> [(Int, Attribute)]
116123sortedAttributesIndices attrs = L.sortBy (\(_, Attribute name1 _) (_,Attribute name2 _) -> compare name1 name2) $ V.toList (V.indexed attrs)
117124
118125-- | The relation's tuple set is the body of the relation.
119−newtype RelationTupleSet = RelationTupleSet { asList :: [RelationTuple] } deriving (Hashable, Show, Generic, Binary)
126+newtype RelationTupleSet = RelationTupleSet { asList :: [RelationTuple] } deriving (Hashable, Show, Generic, Binary, Read)
120127
121128instance Read Relation where
122129 readsPrec = error "relation read not supported"
@@ -144,7 +151,7 @@ instance Hashable RelationTuple where
144151 sortedTupVec = V.map (\(index, _) -> tupVec V.! index) $ V.fromList sortedAttrsIndices
145152
146153-- | A tuple is a set of attributes mapped to their 'Atom' values.
147−data RelationTuple = RelationTuple Attributes (V.Vector Atom) deriving (Show, Generic)
154+data RelationTuple = RelationTuple Attributes (V.Vector Atom) deriving (Show, Read, Generic)
148155
149156instance Binary RelationTuple
150157
@@ -219,12 +226,15 @@ data RelationalExprBase a =
219226 --Summarize :: AtomExpr -> AttributeName -> RelationalExpr -> RelationalExpr -> RelationalExpr -- a special case of Extend
220227 --Evaluate relationalExpr with scoped views
221228 With [(WithNameExprBase a, RelationalExprBase a)] (RelationalExprBase a)
222− deriving (Show, Eq, Generic, NFData, Foldable, Functor, Traversable)
223−
229+ deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable)
230+
231+instance Hashable RelationalExpr where
232+ hashWithSalt = genericHashWithSalt
233+
224234instance Binary RelationalExpr
225235
226236data WithNameExprBase a = WithNameExpr RelVarName a
227− deriving (Show, Eq, Generic, NFData, Foldable, Functor, Traversable)
237+ deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable, Hashable)
228238
229239type WithNameExpr = WithNameExprBase ()
230240
@@ -248,15 +258,15 @@ type TypeVarName = StringType
248258-- | Metadata definition for type constructors such as @data Either a b@.
249259data TypeConstructorDef = ADTypeConstructorDef TypeConstructorName [TypeVarName] |
250260 PrimitiveTypeConstructorDef TypeConstructorName AtomType
251− deriving (Show, Generic, Binary, Eq, NFData)
261+ deriving (Show, Generic, Binary, Eq, NFData, Hashable, Read)
252262
253263-- | Found in data constructors and type declarations: Left (Either Int Text) | Right Int
254264type TypeConstructor = TypeConstructorBase ()
255265data TypeConstructorBase a = ADTypeConstructor TypeConstructorName [TypeConstructor] |
256− PrimitiveTypeConstructor TypeConstructorName AtomType |
257− RelationAtomTypeConstructor [AttributeExprBase a] |
258− TypeVariable TypeVarName
259− deriving (Show, Generic, Binary, Eq, NFData)
266+ PrimitiveTypeConstructor TypeConstructorName AtomType |
267+ RelationAtomTypeConstructor [AttributeExprBase a] |
268+ TypeVariable TypeVarName
269+ deriving (Show, Generic, Binary, Eq, NFData, Hashable, Read)
260270
261271type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)]
262272
@@ -266,13 +276,13 @@ type DataConstructorName = StringType
266276type AtomTypeName = StringType
267277
268278-- | Used to define a data constructor in a type constructor context such as @Left a | Right b@
269−data DataConstructorDef = DataConstructorDef DataConstructorName [DataConstructorDefArg] deriving (Eq, Show, Binary, Generic, NFData)
279+data DataConstructorDef = DataConstructorDef DataConstructorName [DataConstructorDefArg] deriving (Eq, Show, Binary, Generic, NFData, Hashable, Read)
270280
271281type DataConstructorDefs = [DataConstructorDef]
272282
273283data DataConstructorDefArg = DataConstructorDefTypeConstructorArg TypeConstructor |
274284 DataConstructorDefTypeVarNameArg TypeVarName
275− deriving (Show, Generic, Binary, Eq, NFData)
285+ deriving (Show, Generic, Binary, Eq, NFData, Hashable, Read)
276286
277287type InclusionDependencies = M.Map IncDepName InclusionDependency
278288type RelationVariables = M.Map RelVarName GraphRefRelationalExpr
@@ -316,7 +326,7 @@ data DatabaseContext = DatabaseContext {
316326type IncDepName = StringType
317327
318328-- | Inclusion dependencies represent every possible database constraint. Constraints enforce specific, arbitrarily-complex rules to which the database context's relation variables must adhere unconditionally.
319−data InclusionDependency = InclusionDependency RelationalExpr RelationalExpr deriving (Show, Eq, Generic, NFData)
329+data InclusionDependency = InclusionDependency RelationalExpr RelationalExpr deriving (Show, Eq, Generic, NFData, Hashable, Read)
320330
321331instance Binary InclusionDependency
322332
@@ -327,6 +337,9 @@ type DatabaseContextExprName = StringType
327337
328338type DatabaseContextExpr = DatabaseContextExprBase ()
329339
340+instance Hashable DatabaseContextExpr where
341+ hashWithSalt = genericHashWithSalt
342+
330343type GraphRefDatabaseContextExpr = DatabaseContextExprBase GraphRefTransactionMarker
331344
332345instance Binary GraphRefDatabaseContextExpr
@@ -358,7 +371,10 @@ data DatabaseContextExprBase a =
358371 ExecuteDatabaseContextFunction DatabaseContextFunctionName [AtomExprBase a] |
359372
360373 MultipleExpr [DatabaseContextExprBase a]
361− deriving (Show, Eq, Generic)
374+ deriving (Show, Read, Eq, Generic, NFData)
375+
376+instance Hashable (M.Map AttributeName AtomExpr) where
377+ hashWithSalt salt m = salt `hashWithSalt` M.toList m
362378
363379instance Binary DatabaseContextExpr
364380
@@ -380,6 +396,8 @@ type DatabaseContextIOExpr = DatabaseContextIOExprBase ()
380396
381397type RestrictionPredicateExpr = RestrictionPredicateExprBase ()
382398
399+instance Hashable RestrictionPredicateExpr
400+
383401type GraphRefRestrictionPredicateExpr = RestrictionPredicateExprBase GraphRefTransactionMarker
384402
385403-- | Restriction predicates are boolean algebra components which, when composed, indicate whether or not a tuple should be retained during a restriction (filtering) operation.
@@ -391,7 +409,7 @@ data RestrictionPredicateExprBase a =
391409 RelationalExprPredicate (RelationalExprBase a) | --type must be same as true and false relations (no attributes)
392410 AtomExprPredicate (AtomExprBase a) | --atom must evaluate to boolean
393411 AttributeEqualityPredicate AttributeName (AtomExprBase a) -- relationalexpr must result in relation with single tuple
394− deriving (Show, Eq, Generic, NFData, Foldable, Functor, Traversable)
412+ deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable)
395413
396414instance Binary RestrictionPredicateExpr
397415
@@ -454,6 +472,8 @@ instance Ord Transaction where
454472
455473type AtomExpr = AtomExprBase ()
456474
475+instance Hashable AtomExpr
476+
457477type GraphRefAtomExpr = AtomExprBase GraphRefTransactionMarker
458478
459479-- | An atom expression represents an action to take when extending a relation or when statically defining a relation or a new tuple.
@@ -462,15 +482,18 @@ data AtomExprBase a = AttributeAtomExpr AttributeName |
462482 FunctionAtomExpr AtomFunctionName [AtomExprBase a] a |
463483 RelationAtomExpr (RelationalExprBase a) |
464484 ConstructedAtomExpr DataConstructorName [AtomExprBase a] a
465− deriving (Eq,Show,Generic, NFData, Foldable, Functor, Traversable)
485+ deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)
466486
467487instance Binary AtomExpr
468488
469489-- | Used in tuple creation when creating a relation.
470490data ExtendTupleExprBase a = AttributeExtendTupleExpr AttributeName (AtomExprBase a)
471− deriving (Show, Eq, Generic, NFData, Foldable, Functor, Traversable)
491+ deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable)
472492
473493type ExtendTupleExpr = ExtendTupleExprBase ()
494+
495+instance Hashable ExtendTupleExpr
496+
474497type GraphRefExtendTupleExpr = ExtendTupleExprBase GraphRefTransactionMarker
475498
476499instance Binary ExtendTupleExpr
@@ -519,7 +542,12 @@ data AttributeNamesBase a = AttributeNames (S.Set AttributeName) |
519542 UnionAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |
520543 IntersectAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |
521544 RelationalExprAttributeNames (RelationalExprBase a) -- use attribute names from the relational expression's type
522− deriving (Eq, Show, Generic, NFData, Foldable, Functor, Traversable)
545+ deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)
546+
547+instance Hashable AttributeNames
548+
549+instance Hashable (S.Set AttributeName) where
550+ hashWithSalt salt s = salt `hashWithSalt` S.toList s
523551
524552type AttributeNames = AttributeNamesBase ()
525553
@@ -539,12 +567,14 @@ type GraphRefAttributeExpr = AttributeExprBase GraphRefTransactionMarker
539567-- | Create attributes dynamically.
540568data AttributeExprBase a = AttributeAndTypeNameExpr AttributeName TypeConstructor a |
541569 NakedAttributeExpr Attribute
542− deriving (Eq, Show, Generic, Binary, NFData, Foldable, Functor, Traversable)
570+ deriving (Eq, Show, Read, Generic, Binary, NFData, Foldable, Functor, Traversable, Hashable)
543571
544572-- | Dynamically create a tuple from attribute names and 'AtomExpr's.
545573newtype TupleExprBase a = TupleExpr (M.Map AttributeName (AtomExprBase a))
546− deriving (Eq, Show, Generic, NFData, Foldable, Functor, Traversable)
547−
574+ deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)
575+
576+instance Hashable TupleExpr
577+
548578instance Binary TupleExpr
549579
550580type TupleExpr = TupleExprBase ()
@@ -552,7 +582,10 @@ type TupleExpr = TupleExprBase ()
552582type GraphRefTupleExpr = TupleExprBase GraphRefTransactionMarker
553583
554584data TupleExprsBase a = TupleExprs a [TupleExprBase a]
555− deriving (Eq, Show, Generic, NFData, Foldable, Functor, Traversable)
585+ deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)
586+
587+instance Hashable TupleExprs where
588+ hashWithSalt = genericHashWithSalt
556589
557590type GraphRefTupleExprs = TupleExprsBase GraphRefTransactionMarker
558591
@@ -604,6 +637,7 @@ attrTypeVars (Attribute _ aType) = case aType of
604637 DateTimeAtomType -> S.empty
605638 ByteStringAtomType -> S.empty
606639 BoolAtomType -> S.empty
640+ RelationalExprAtomType -> S.empty
607641 (RelationAtomType attrs) -> S.unions (map attrTypeVars (V.toList attrs))
608642 (ConstructedAtomType _ tvMap) -> M.keysSet tvMap
609643 (TypeVariableType nam) -> S.singleton nam
@@ -627,6 +661,7 @@ atomTypeVars DayAtomType = S.empty
627661atomTypeVars DateTimeAtomType = S.empty
628662atomTypeVars ByteStringAtomType = S.empty
629663atomTypeVars BoolAtomType = S.empty
664+atomTypeVars RelationalExprAtomType = S.empty
630665atomTypeVars (RelationAtomType attrs) = S.unions (map attrTypeVars (V.toList attrs))
631666atomTypeVars (ConstructedAtomType _ tvMap) = M.keysSet tvMap
632667atomTypeVars (TypeVariableType nam) = S.singleton nam
src/lib/ProjectM36/DataTypes/Interval.hs+2
@@ -37,6 +37,7 @@ supportsInterval typ = case typ of
3737 BoolAtomType -> False
3838 RelationAtomType _ -> False
3939 ConstructedAtomType _ _ -> False --once we support an interval-style typeclass, we might enable this
40+ RelationalExprAtomType -> False
4041 TypeVariableType _ -> False
4142
4243supportsOrdering :: AtomType -> Bool
@@ -50,6 +51,7 @@ supportsOrdering typ = case typ of
5051 ByteStringAtomType -> False
5152 BoolAtomType -> False
5253 RelationAtomType _ -> False
54+ RelationalExprAtomType -> False
5355 ConstructedAtomType _ _ -> False --once we support an interval-style typeclass, we might enable this
5456 TypeVariableType _ -> False
5557
src/lib/ProjectM36/DataTypes/Primitive.hs+1
@@ -42,3 +42,4 @@ atomTypeForAtom (ByteStringAtom _) = ByteStringAtomType
4242atomTypeForAtom (BoolAtom _) = BoolAtomType
4343atomTypeForAtom (RelationAtom (Relation attrs _)) = RelationAtomType attrs
4444atomTypeForAtom (ConstructedAtom _ aType _) = aType
45+atomTypeForAtom (RelationalExprAtom _) = RelationalExprAtomType
src/lib/ProjectM36/DataTypes/Sorting.hs+1
@@ -24,6 +24,7 @@ isSortableAtomType typ = case typ of
2424 DateTimeAtomType -> True
2525 ByteStringAtomType -> False
2626 BoolAtomType -> True
27+ RelationalExprAtomType -> False
2728 RelationAtomType _ -> False
2829 ConstructedAtomType _ _ -> False
2930 TypeVariableType _ -> False
src/lib/ProjectM36/InclusionDependency.hs+4−7
@@ -4,19 +4,16 @@ import ProjectM36.Attribute
44import ProjectM36.Error
55import ProjectM36.Relation
66import qualified Data.Map as M
7−import qualified Data.Text as T
8−import ProjectM36.PrettyPrinter
9−import Data.Text.Prettyprint.Doc
107
118inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation
129inclusionDependenciesAsRelation incDeps =
1310 mkRelationFromList attrs (map incDepAsAtoms (M.toList incDeps))
1411 where
1512 attrs = attributesFromList [Attribute "name" TextAtomType,
16− Attribute "sub" TextAtomType,
17− Attribute "super" TextAtomType
13+ Attribute "sub" RelationalExprAtomType,
14+ Attribute "super" RelationalExprAtomType
1815 ]
1916 incDepAsAtoms (name, InclusionDependency exprA exprB) = [TextAtom name,
20− TextAtom (T.pack (show (pretty exprA))),
21− TextAtom (T.pack (show (pretty exprB)))]
17+ RelationalExprAtom exprA,
18+ RelationalExprAtom exprB]
2219
src/lib/ProjectM36/Relation/Parse/CSV.hs+5
@@ -83,6 +83,11 @@ parseCSVAtomP _ _ BoolAtomType = do
8383 case readMaybe bString of
8484 Nothing -> fail ("invalid BoolAtom string: " ++ bString)
8585 Just b -> pure (Right (BoolAtom b))
86+parseCSVAtomP _ _ RelationalExprAtomType = do
87+ reString <- T.unpack <$> takeToEndOfData
88+ case readMaybe reString of
89+ Nothing -> fail ("invalid RelationalExprAtom string: " ++ reString)
90+ Just b -> pure (Right (RelationalExprAtom b))
8691parseCSVAtomP attrName tConsMap typ@(ConstructedAtomType _ tvmap)
8792 | isIntervalAtomType typ = do
8893 begin <- (APT.char '[' >> pure False) <|> (APT.char '(' >> pure True)
test/PrettyPrinter.hsdeleted−22
@@ -1,22 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−import Test.HUnit
3−import ProjectM36.Base
4−import ProjectM36.PrettyPrinter
5−import qualified Data.Vector as V
6−import System.Exit
7−import Data.Text
8−import ProjectM36.Relation
9−import Data.Text.Prettyprint.Doc
10−testList :: Test
11−testList = TestList [
12− testPretty "true" (ExistingRelation (Relation V.empty (RelationTupleSet [RelationTuple V.empty V.empty]))),
13− testPretty "false" (ExistingRelation (Relation V.empty (RelationTupleSet []))),
14− testPretty "true:{a:=1, b:=1}" (Extend (AttributeExtendTupleExpr "b" (NakedAtomExpr (IntAtom 1))) (Extend (AttributeExtendTupleExpr "a" (NakedAtomExpr (IntAtom 1))) (ExistingRelation relationTrue)))]
15−
16−main :: IO ()
17−main = do
18− tcounts <- runTestTT testList
19− if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
20−
21−testPretty :: String -> RelationalExpr -> Test
22−testPretty relExprText relExprADT = TestCase $ assertEqual relExprText (show (pretty relExprADT)) (show (pretty relExprText))
test/TutorialD/Printer.hsnew file+47
@@ -0,0 +1,47 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+import Test.HUnit
3+import ProjectM36.Base
4+import System.Exit
5+import Data.Text.Prettyprint.Doc
6+import Data.Map (fromList)
7+import TutorialD.Printer ()
8+import TutorialD.Interpreter.RelationalExpr
9+import Text.Megaparsec
10+import Data.Text (pack)
11+
12+testList :: Test
13+testList = TestList [
14+ testPretty "true" (RelationVariable "true" ()),
15+ testPretty "relation{tuple{a 3, b \"x\"}, tuple{a 4, b \"y\"}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",NakedAtomExpr (IntegerAtom 3)),("b",NakedAtomExpr (TextAtom "x"))]),TupleExpr (fromList [("a",NakedAtomExpr (IntegerAtom 4)),("b",NakedAtomExpr (TextAtom "y"))])])),
16+ testPretty "true:{a:=1, b:=1}" (Extend (AttributeExtendTupleExpr "b" (NakedAtomExpr (IntegerAtom 1))) (Extend (AttributeExtendTupleExpr "a" (NakedAtomExpr (IntegerAtom 1))) (RelationVariable "true" ()))),
17+ testPretty "relation{tuple{a fromGregorian(2014, 2, 4)}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",FunctionAtomExpr "fromGregorian" [NakedAtomExpr (IntegerAtom 2014),NakedAtomExpr (IntegerAtom 2),NakedAtomExpr (IntegerAtom 4)] ())])])),
18+ testPretty "relation{tuple{a bytestring(\"dGVzdGRhdGE=\")}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",FunctionAtomExpr "bytestring" [NakedAtomExpr (TextAtom "dGVzdGRhdGE=")] ())])])),
19+ testPretty "relation{tuple{a t}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",NakedAtomExpr (BoolAtom True))])])),
20+ testPretty "relation{tuple{a Cons 4 (Cons 5 Empty)}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",ConstructedAtomExpr "Cons" [NakedAtomExpr (IntegerAtom 4),ConstructedAtomExpr "Cons" [NakedAtomExpr (IntegerAtom 5),ConstructedAtomExpr "Empty" [] ()] ()] ())])])),
21+ testPretty "relation{a Int, b Text, c Bool}{}" (MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "a" (ADTypeConstructor "Int" []) (),AttributeAndTypeNameExpr "b" (ADTypeConstructor "Text" []) (),AttributeAndTypeNameExpr "c" (ADTypeConstructor "Bool" []) ()]) (TupleExprs () [])),
22+ testPretty "relation{a relation{b Int}}{}" (MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "a" (RelationAtomTypeConstructor [AttributeAndTypeNameExpr "b" (ADTypeConstructor "Int" []) ()]) ()]) (TupleExprs () []))
23+ ]
24+
25+main :: IO ()
26+main = do
27+ tcounts <- runTestTT testList
28+ if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
29+
30+testPretty :: String -> RelationalExpr -> Test
31+testPretty tutdStr relExprADT =
32+ TestCase $ do
33+ let relExprStr = show (pretty relExprADT)
34+ print relExprStr
35+ roundTrip <- parseRelExpr relExprStr
36+ {-tutdIn <- parseRelExpr tutdStr
37+ print ("tutd parsed", tutdIn)-}
38+ assertEqual ("pretty ADT " <> tutdStr) tutdStr relExprStr
39+ assertEqual ("round-trip " <> tutdStr) relExprADT roundTrip
40+
41+--round trip tutoriald
42+parseRelExpr :: String -> IO RelationalExpr
43+parseRelExpr tutdStr =
44+ case parse relExprP "test" (pack tutdStr) of
45+ Left err ->
46+ assertFailure (errorBundlePretty err)
47+ Right parsed -> pure parsed