git.iko.soy/project-m36
on master help sign in
WIP compilation checkpoint
commit8b5e1153082148bf77f5965b7c9e8f60fe780b0a authorAgentM <agentm@themactionfaction.com> dateTue 30 Aug 2016, 16:42 (10 years ago) parentae6c31a
14 files changed+171−190
compare with master
unifiedsplit
project-m36.cabal+18−19 src/bin/TutorialD/Interpreter.hs+7−6 src/bin/TutorialD/Interpreter/Base.hs+47−39 src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs+25−23 src/bin/TutorialD/Interpreter/DatabaseContextIOOperator.hs+4−30 src/bin/TutorialD/Interpreter/Export/CSV.hs+2−2 src/bin/TutorialD/Interpreter/Import/BasicExamples.hs+1−1 src/bin/TutorialD/Interpreter/Import/CSV.hs+3−3 src/bin/TutorialD/Interpreter/Import/TutorialD.hs+9−7 src/bin/TutorialD/Interpreter/InformationOperator.hs+2−2 src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+4−4 src/bin/TutorialD/Interpreter/RelationalExpr.hs+32−33 src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+8−9 src/bin/TutorialD/Interpreter/Types.hs+9−12
project-m36.cabal+18−19
@@ -164,7 +164,6 @@ Executable tutd
164164 directory,
165165 filepath,
166166 temporary,
167− parsec,
168167 megaparsec,
169168 haskeline,
170169 base64-bytestring,
@@ -252,7 +251,7 @@ Executable project-m36-server
252251Executable bigrel
253252 Default-Language: Haskell2010
254253 Default-Extensions: OverloadedStrings
255− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36 == 0.1
254+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, 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 == 0.1
256255 Other-Modules: TutorialD.Interpreter.Base,
257256 TutorialD.Interpreter.DatabaseContextExpr,
258257 TutorialD.Interpreter.RelationalExpr,
@@ -268,7 +267,7 @@ Test-Suite test-tutoriald
268267 Default-Extensions: OverloadedStrings
269268 type: exitcode-stdio-1.0
270269 main-is: test/TutorialD/Interpreter.hs
271− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t, project-m36 == 0.1
270+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t, project-m36 == 0.1
272271 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
273272 GHC-Options: -Wall
274273 Hs-Source-Dirs: ./src/bin, ., test
@@ -279,7 +278,7 @@ Test-Suite test-tutoriald-atomfunctionscript
279278 Default-Extensions: OverloadedStrings
280279 type: exitcode-stdio-1.0
281280 main-is: test/TutorialD/Interpreter/AtomFunctionScript.hs
282− Build-Depends: base, HUnit, project-m36 == 0.1, uuid, containers, parsec, text, vector, directory, bytestring, mtl, haskeline
281+ Build-Depends: base, HUnit, project-m36 == 0.1, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline
283282 GHC-Options: -Wall
284283 Hs-Source-Dirs: ./src/bin, ./test, .
285284 CPP-Options: -DPROJECTM36_VERSION="v0.1"
@@ -289,7 +288,7 @@ Test-Suite test-relation
289288 Default-Extensions: OverloadedStrings
290289 type: exitcode-stdio-1.0
291290 main-is: test/Relation/Basic.hs
292− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
291+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
293292 GHC-Options: -Wall
294293
295294Test-Suite test-static-optimizer
@@ -297,7 +296,7 @@ Test-Suite test-static-optimizer
297296 Default-Extensions: OverloadedStrings
298297 type: exitcode-stdio-1.0
299298 main-is: test/Relation/StaticOptimizer.hs
300− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
299+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
301300 GHC-Options: -Wall
302301 CPP-Options: -DPROJECTM36_VERSION="v0.1"
303302
@@ -306,7 +305,7 @@ Test-Suite test-transactiongraph-persist
306305 Default-Extensions: OverloadedStrings
307306 type: exitcode-stdio-1.0
308307 main-is: test/TransactionGraph/Persist.hs
309− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
308+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
310309 Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples
311310 Hs-Source-Dirs: ., ./src/bin
312311 GHC-Options: -Wall
@@ -316,7 +315,7 @@ Test-Suite test-relation-import-csv
316315 Default-Extensions: OverloadedStrings
317316 type: exitcode-stdio-1.0
318317 main-is: test/Relation/Import/CSV.hs
319− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
318+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
320319 GHC-Options: -Wall
321320 CPP-Options: -DPROJECTM36_VERSION="v0.1"
322321
@@ -325,7 +324,7 @@ Test-Suite test-tutoriald-import-tutoriald
325324 Default-Extensions: OverloadedStrings
326325 type: exitcode-stdio-1.0
327326 main-is: test/TutorialD/Interpreter/Import/TutorialD.hs
328− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
327+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
329328 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
330329 GHC-Options: -Wall
331330 Hs-Source-Dirs: ., ./src/bin
@@ -335,7 +334,7 @@ Test-Suite test-relation-export-csv
335334 Default-Extensions: OverloadedStrings
336335 type: exitcode-stdio-1.0
337336 main-is: test/Relation/Export/CSV.hs
338− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
337+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36 == 0.1
339338 GHC-Options: -Wall
340339
341340Test-Suite test-persistent-driver
@@ -344,7 +343,7 @@ Test-Suite test-persistent-driver
344343 type: exitcode-stdio-1.0
345344 main-is: test/persistent-driver/test.hs
346345 Other-Modules: Database.Persist.ProjectM36
347− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, persistent-template, conduit, persistent >= 2.2 && < 2.3, either, path-pieces, http-api-data, stm-containers, list-t, project-m36 == 0.1
346+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, persistent-template, conduit, persistent >= 2.2 && < 2.3, either, path-pieces, http-api-data, stm-containers, list-t, project-m36 == 0.1
348347 Hs-Source-Dirs: ., src/persistent
349348 GHC-Options: -Wall
350349
@@ -353,7 +352,7 @@ Test-Suite test-transactiongraph-merge
353352 Default-Extensions: OverloadedStrings
354353 type: exitcode-stdio-1.0
355354 main-is: test/TransactionGraph/Merge.hs
356− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, persistent-template, conduit, persistent, either, path-pieces, http-api-data, stm-containers, list-t, project-m36 == 0.1
355+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, persistent-template, conduit, persistent, either, path-pieces, http-api-data, stm-containers, list-t, project-m36 == 0.1
357356 GHC-Options: -Wall
358357
359358benchmark bench
@@ -361,7 +360,7 @@ benchmark bench
361360 Default-Extensions: OverloadedStrings
362361 type: exitcode-stdio-1.0
363362 main-is: benchmark/Relation.hs
364− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, criterion, stm-containers, project-m36 == 0.1
363+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, criterion, stm-containers, project-m36 == 0.1
365364 GHC-Options: -Wall -rtsopts
366365 Hs-Source-Dirs: ./src/bin
367366
@@ -370,21 +369,21 @@ Test-Suite test-server
370369 Default-Extensions: OverloadedStrings
371370 type: exitcode-stdio-1.0
372371 main-is: test/Server/Main.hs
373− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, project-m36 == 0.1
372+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, project-m36 == 0.1
374373 HS-Source-Dirs: ., ./src/bin
375374 GHC-Options: -Wall
376375
377376Executable Example-SimpleClient
378377 Default-Language: Haskell2010
379378 Default-Extensions: OverloadedStrings
380− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, ghc, ghc-paths, project-m36 == 0.1
379+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, ghc, ghc-paths, project-m36 == 0.1
381380 Main-Is: examples/SimpleClient.hs
382381 GHC-Options: -Wall
383382
384383Executable Example-PersistClient
385384 Default-Language: Haskell2010
386385 Default-Extensions: OverloadedStrings
387− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, persistent, aeson, path-pieces, either, conduit, http-api-data, template-haskell, persistent-template, ghc, ghc-paths, project-m36 == 0.1
386+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, persistent, aeson, path-pieces, either, conduit, http-api-data, template-haskell, persistent-template, ghc, ghc-paths, project-m36 == 0.1
388387 Main-Is: examples/PersistClient.hs
389388 GHC-Options: -Wall
390389 CPP-Options: -DPROJECTM36_VERSION="v0.1"
@@ -396,14 +395,14 @@ Test-Suite test-scripts
396395 Default-Extensions: OverloadedStrings
397396 type: exitcode-stdio-1.0
398397 main-is: test/scripts.hs
399− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, project-m36 == 0.1
398+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, project-m36 == 0.1
400399 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
401400 GHC-Options: -Wall
402401 Hs-Source-Dirs: ., ./src/bin
403402
404403Executable project-m36-websocket-server
405404 Default-Language: Haskell2010
406− Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, persistent-template, websockets, aeson, uuid-aeson, optparse-applicative, project-m36 == 0.1, containers, bytestring, text, vector, uuid, parsec, haskeline, mtl, directory, base64-bytestring
405+ Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, persistent-template, websockets, aeson, uuid-aeson, optparse-applicative, project-m36 == 0.1, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring
407406 Main-Is: ProjectM36/Server/WebSocket/websocket-server.hs
408407 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
409408 GHC-Options: -Wall
@@ -415,7 +414,7 @@ Test-Suite test-websocket-server
415414 Default-Language: Haskell2010
416415 type: exitcode-stdio-1.0
417416 main-is: test/Server/WebSocket.hs
418− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, uuid-aeson, project-m36 == 0.1
417+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, uuid-aeson, project-m36 == 0.1
419418 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
420419 Default-Extensions: OverloadedStrings
421420 GHC-Options: -Wall
src/bin/TutorialD/Interpreter.hs+7−6
@@ -21,8 +21,8 @@ import ProjectM36.TransactionGraph
2121import qualified ProjectM36.Client as C
2222import ProjectM36.Relation (attributes)
2323
24−import Text.Parsec
25−import Text.Parsec.String
24+import Text.Megaparsec
25+import Text.Megaparsec.Text
2626import Control.Monad.State
2727import System.Console.Haskeline
2828import System.Directory (getHomeDirectory)
@@ -68,11 +68,11 @@ promptText mHeadName = "TutorialD (" `T.append` transInfo `T.append` "): "
6868 where
6969 transInfo = fromMaybe "<unknown>" mHeadName
7070
71−parseTutorialD :: String -> Either ParseError ParsedOperation
71+parseTutorialD :: T.Text -> Either (ParseError Char Dec) ParsedOperation
7272parseTutorialD inputString = parse interpreterParserP "" inputString
7373
7474--only parse tutoriald which doesn't result in file I/O
75−safeParseTutorialD :: String -> Either ParseError ParsedOperation
75+safeParseTutorialD :: T.Text -> Either (ParseError Char Dec) ParsedOperation
7676safeParseTutorialD inputString = parse safeInterpreterParserP "" inputString
7777
7878data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)
@@ -187,9 +187,10 @@ reprLoop config sessionId conn = do
187187 case maybeLine of
188188 Nothing -> return ()
189189 Just line -> do
190− case parseTutorialD line of
190+ case parseTutorialD (T.pack line) of
191191 Left err -> do
192− displayOpResult $ DisplayErrorResult (T.pack (show err))
192+ let strErr = parseErrorPretty err
193+ displayOpResult $ DisplayErrorResult (T.pack strErr)
193194 Right parsed -> do
194195 evald <- evalTutorialD sessionId conn UnsafeEvaluation parsed
195196 displayOpResult evald
src/bin/TutorialD/Interpreter/Base.hs+47−39
@@ -6,6 +6,7 @@ import qualified Text.Megaparsec.Lexer as Lex
66import ProjectM36.Base
77import ProjectM36.AtomType
88import Data.Text
9+import qualified Data.Text as T
910import qualified Data.List as L
1011import qualified Data.Vector as V
1112import qualified Data.Text.IO as TIO
@@ -13,6 +14,7 @@ import System.IO
1314import ProjectM36.Relation.Show.Term
1415import GHC.Generics
1516import Data.Monoid
17+import Control.Monad (void)
1618
1719displayOpResult :: TutorialDOperatorResult -> IO ()
1820displayOpResult QuitResult = return ()
@@ -22,69 +24,79 @@ displayOpResult (DisplayErrorResult err) = TIO.hPutStrLn stderr ("ERR: " <> err)
2224displayOpResult QuietSuccessResult = return ()
2325displayOpResult (DisplayRelationResult rel) = TIO.putStrLn (showRelation rel)
2426
25−spaceConsumer = space spaceChar (skipLineComment "--") (skipBlockComment "{-" "-}")
27+spaceConsumer :: Parser ()
28+spaceConsumer = Lex.space (void spaceChar) (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")
2629
27−parens :: Parser a -> Parser a
28−parens = between (symbol "(") (symbol ")")
30+opChar :: Parser Char
31+opChar = oneOf (":!#$%&*+./<=>?\\^|-~"::String)-- remove "@" so it can be used as attribute marker without spaces
32+
33+reserved :: String -> Parser ()
34+reserved word = try (string word *> notFollowedBy opChar *> spaceConsumer)
2935
30−reservedOp :: Text -> Parser ()
31−reservedOp = Token.reservedOp lexer
36+reservedOp :: String -> Parser ()
37+reservedOp op = try (string op *> notFollowedBy opChar *> spaceConsumer)
3238
33−reserved :: Text -> Parser ()
34−reserved = Token.reserved lexer
39+parens :: Parser a -> Parser a
40+parens = between (symbol "(") (symbol ")")
3541
3642braces :: Parser a -> Parser a
37−braces = Token.braces lexer
43+braces = between (symbol "{") (symbol "}")
3844
3945identifier :: Parser Text
40−identifier = Token.identifier lexer
46+identifier = do
47+ istart <- letterChar <|> char '_'
48+ irest <- many (alphaNumChar <|> char '_' <|> char '#')
49+ spaceConsumer
50+ pure (pack (istart:irest))
4151
42−symbol :: Text -> Parser Text
43−symbol = L.symbol spaceConsumer
52+symbol :: String -> Parser Text
53+symbol sym = pack <$> Lex.symbol spaceConsumer sym
4454
4555comma :: Parser Text
46−comma = Token.comma lexer
56+comma = symbol ","
4757
4858pipe :: Parser Text
49−pipe = Token.symbol lexer "|"
59+pipe = symbol "|"
5060
5161quote :: Parser Text
52−quote = Token.symbol lexer "\""
62+quote = symbol "\""
5363
5464tripleQuote :: Parser Text
55−tripleQuote = Token.symbol lexer "\"\"\""
65+tripleQuote = symbol "\"\"\""
5666
5767arrow :: Parser Text
58−arrow = Token.symbol lexer "->"
68+arrow = symbol "->"
5969
6070semi :: Parser Text
61−semi = Token.semi lexer
71+semi = symbol ";"
6272
73+{-
6374whiteSpace :: Parser ()
6475whiteSpace = Token.whiteSpace lexer
76+-}
6577
6678integer :: Parser Integer
67−integer = Token.integer lexer
79+integer = Lex.integer
6880
6981float :: Parser Double
70−float = Token.float lexer
82+float = Lex.float
7183
7284capitalizedIdentifier :: Parser Text
7385capitalizedIdentifier = do
74− fletter <- upper
86+ fletter <- upperChar
7587 rest <- option "" identifier
76− spaces
77− pure $ fletter:rest
88+ spaceConsumer
89+ pure (T.cons fletter rest)
7890
7991uncapitalizedIdentifier :: Parser Text
8092uncapitalizedIdentifier = do
81− fletter <- lower
93+ fletter <- lowerChar
8294 rest <- option "" identifier
83− spaces
84− pure (fletter:rest)
95+ spaceConsumer
96+ pure (T.cons fletter rest)
8597
8698showRelationAttributes :: Attributes -> Text
87−showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ map showAttribute attrsL) <> "}"
99+showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ L.map showAttribute attrsL) <> "}"
88100 where
89101 showAttribute (Attribute name atomType) = name <> " " <> prettyAtomType atomType
90102 attrsL = V.toList attrs
@@ -99,34 +111,30 @@ data TutorialDOperatorResult = QuitResult |
99111
100112type TransactionGraphWasUpdated = Bool
101113
102−escapedString :: Parser Text
103−escapedString = do
114+escapedChar :: Parser Char
115+escapedChar = do
104116 _ <- char '\\'
105− let lookupAssoc = [('n',"\n"), ('\"',"\""), ('\\', "\\")]
106− c <- oneOf "\\\"n" -- all the characters which can be escaped
117+ let lookupAssoc = [('n','\n'), ('\"','\"'), ('\\', '\\')]
118+ c <- oneOf ("\\\"n"::String) -- all the characters which can be escaped
107119 case lookup c lookupAssoc of
108120 Just v -> pure v
109121 Nothing -> fail "failed to handle escaped character"
110122
111123--http://stackoverflow.com/questions/24106314/parser-for-quoted-string-using-parsec
112124nonEscapedChar :: Parser Char
113−nonEscapedChar = noneOf "\\\""
125+nonEscapedChar = noneOf ("\\\""::String)
114126
115−character :: Parser Text
116−character = fmap return nonEscapedChar <|> escapedString
127+quotedChar :: Parser Char
128+quotedChar = escapedChar <|> nonEscapedChar
117129
118130--allow for python-style triple quoting because guessing the correct amount of escapes in different contexts is annoying
119131tripleQuotedString :: Parser Text
120132tripleQuotedString = do
121133 _ <- tripleQuote
122− manyTill anyChar (try (tripleQuote >> notFollowedBy quote))
134+ pack <$> manyTill anyChar (try (tripleQuote >> notFollowedBy quote))
123135
124136normalQuotedString :: Parser Text
125−normalQuotedString = do
126− _ <- quote
127− strings <- many character
128− _ <- quote
129− pure (concat strings)
137+normalQuotedString = quote *> (T.pack <$> manyTill quotedChar quote)
130138
131139quotedString :: Parser Text
132140quotedString = try tripleQuotedString <|> normalQuotedString
src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs+25−23
@@ -1,6 +1,6 @@
11module TutorialD.Interpreter.DatabaseContextExpr where
2−import Text.Parsec
3−import Text.Parsec.String
2+import Text.Megaparsec
3+import Text.Megaparsec.Text
44import ProjectM36.Base
55import TutorialD.Interpreter.Base
66import qualified Data.Text as T
@@ -9,9 +9,11 @@ import TutorialD.Interpreter.Types
99import qualified Data.Map as M
1010import Control.Monad.State
1111import ProjectM36.StaticOptimizer
12+import qualified ProjectM36.Error as PM36E
1213import ProjectM36.Error
1314import ProjectM36.RelationalExpression
1415import ProjectM36.Key
16+import Data.Monoid
1517
1618--parsers which create "database expressions" which modify the database context (such as relvar assignment)
1719databaseExprP :: Parser DatabaseContextExpr
@@ -34,7 +36,7 @@ commentP :: Parser DatabaseContextExpr
3436commentP = reserved "--" >> manyTill anyChar eof >> pure NoOperation
3537
3638nothingP :: Parser DatabaseContextExpr
37−nothingP = whiteSpace >> pure NoOperation
39+nothingP = spaceConsumer >> pure NoOperation
3840
3941assignP :: Parser DatabaseContextExpr
4042assignP = do
@@ -43,19 +45,19 @@ assignP = do
4345 reservedOp ":="
4446 return relVarName
4547 expr <- relExprP
46− return $ Assign (T.pack relVarName) expr
48+ pure $ Assign relVarName expr
4749
4850multipleDatabaseContextExprP :: Parser DatabaseContextExpr
4951multipleDatabaseContextExprP = do
5052 exprs <- sepBy1 databaseExprP semi
51− return $ MultipleExpr exprs
53+ pure $ MultipleExpr exprs
5254
5355insertP :: Parser DatabaseContextExpr
5456insertP = do
5557 reservedOp "insert"
5658 relvar <- identifier
5759 expr <- relExprP
58− return $ Insert (T.pack relvar) expr
60+ pure $ Insert relvar expr
5961
6062defineP :: Parser DatabaseContextExpr
6163defineP = do
@@ -64,28 +66,28 @@ defineP = do
6466 reservedOp "::"
6567 return relVarName
6668 attributeSet <- makeAttributeExprsP
67− return $ Define (T.pack relVarName) attributeSet
69+ pure $ Define relVarName attributeSet
6870
6971undefineP :: Parser DatabaseContextExpr
7072undefineP = do
7173 reservedOp "undefine"
7274 relVarName <- identifier
73− return $ Undefine (T.pack relVarName)
75+ return $ Undefine relVarName
7476
7577deleteP :: Parser DatabaseContextExpr
7678deleteP = do
7779 reservedOp "delete"
7880 relVarName <- identifier
7981 predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP)
80− return $ Delete (T.pack relVarName) predicate
82+ return $ Delete relVarName predicate
8183
8284updateP :: Parser DatabaseContextExpr
8385updateP = do
8486 reservedOp "update"
8587 relVarName <- identifier
86− predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP <* spaces)
88+ predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP <* spaceConsumer)
8789 attributeAssignments <- liftM M.fromList $ parens (sepBy attributeAssignmentP comma)
88− return $ Update (T.pack relVarName) (M.mapKeys T.pack $ attributeAssignments) predicate
90+ return $ Update relVarName attributeAssignments predicate
8991
9092data IncDepOp = SubsetOp | EqualityOp
9193
@@ -97,8 +99,8 @@ addConstraintP = do
9799 op <- (reservedOp "in" *> pure SubsetOp) <|> (reservedOp "equals" *> pure EqualityOp)
98100 superset <- relExprP
99101 let subsetA = incDepSet constraintName subset superset
100− subsetB = incDepSet (constraintName ++ "_eqInvert") superset subset --inverted args for equality constraint
101− incDepSet nam a b = AddInclusionDependency (T.pack nam) (InclusionDependency a b)
102+ subsetB = incDepSet (constraintName <> "_eqInvert") superset subset --inverted args for equality constraint
103+ incDepSet nam a b = AddInclusionDependency nam (InclusionDependency a b)
102104 case op of
103105 SubsetOp -> pure subsetA
104106 EqualityOp -> pure (MultipleExpr [subsetA, subsetB])
@@ -107,7 +109,7 @@ deleteConstraintP :: Parser DatabaseContextExpr
107109deleteConstraintP = do
108110 reserved "deleteconstraint"
109111 constraintName <- identifier
110− return $ RemoveInclusionDependency (T.pack constraintName)
112+ pure $ RemoveInclusionDependency constraintName
111113
112114-- key <constraint name> {<uniqueness attributes>} <uniqueness relexpr>
113115keyP :: Parser DatabaseContextExpr
@@ -117,14 +119,14 @@ keyP = do
117119 uniquenessAttrNames <- braces attributeListP
118120 uniquenessExpr <- relExprP
119121 let newIncDep = inclusionDependencyForKey uniquenessAttrNames uniquenessExpr
120− return $ AddInclusionDependency (T.pack keyName) newIncDep
122+ pure $ AddInclusionDependency keyName newIncDep
121123
122−attributeAssignmentP :: Parser (String, AtomExpr)
124+attributeAssignmentP :: Parser (AttributeName, AtomExpr)
123125attributeAssignmentP = do
124126 attrName <- identifier
125127 reservedOp ":="
126128 atomExpr <- atomExprP
127− return $ (attrName, atomExpr)
129+ pure $ (attrName, atomExpr)
128130
129131addNotificationP :: Parser DatabaseContextExpr
130132addNotificationP = do
@@ -132,13 +134,13 @@ addNotificationP = do
132134 notName <- identifier
133135 triggerExpr <- relExprP
134136 resultExpr <- relExprP
135− return $ AddNotification (T.pack notName) triggerExpr resultExpr
137+ pure $ AddNotification notName triggerExpr resultExpr
136138
137139removeNotificationP :: Parser DatabaseContextExpr
138140removeNotificationP = do
139141 reserved "unnotify"
140142 notName <- identifier
141− return $ RemoveNotification (T.pack notName)
143+ pure $ RemoveNotification notName
142144
143145-- | data Hair = Bald | Color Text
144146addTypeConstructorP :: Parser DatabaseContextExpr
@@ -152,12 +154,12 @@ addTypeConstructorP = do
152154removeTypeConstructorP :: Parser DatabaseContextExpr
153155removeTypeConstructorP = do
154156 reserved "undata"
155− RemoveTypeConstructor <$> liftM T.pack identifier
157+ RemoveTypeConstructor <$> identifier
156158
157159removeAtomFunctionP :: Parser DatabaseContextExpr
158160removeAtomFunctionP = do
159161 reserved "removeatomfunction"
160− RemoveAtomFunction <$> liftM T.pack quotedString
162+ RemoveAtomFunction <$> quotedString
161163
162164databaseExprOpP :: Parser DatabaseContextExpr
163165databaseExprOpP = multipleDatabaseContextExprP
@@ -170,9 +172,9 @@ evalDatabaseContextExpr useOptimizer context expr = do
170172 (Just err, _) -> Left err
171173
172174
173−interpretDatabaseContextExpr :: DatabaseContext -> String -> Either RelationalError DatabaseContext
175+interpretDatabaseContextExpr :: DatabaseContext -> T.Text -> Either RelationalError DatabaseContext
174176interpretDatabaseContextExpr context tutdstring = case parse databaseExprOpP "" tutdstring of
175− Left err -> Left $ ParseError (T.pack (show err))
177+ Left err -> Left $ PM36E.ParseError (T.pack (show err))
176178 Right parsed -> evalDatabaseContextExpr True context parsed
177179
178180{-
src/bin/TutorialD/Interpreter/DatabaseContextIOOperator.hs+4−30
@@ -4,42 +4,16 @@ import ProjectM36.Base
44
55import TutorialD.Interpreter.Base
66import TutorialD.Interpreter.Types
7−import Text.Parsec
8−import Text.Parsec.String
9−import Data.Text
10−import Control.Monad
7+import Text.Megaparsec
8+import Text.Megaparsec.Text
119
1210addAtomFunctionExprP :: Parser DatabaseContextIOExpr
1311addAtomFunctionExprP = do
1412 reserved "addatomfunction"
15− funcName <- liftM pack quotedString
13+ funcName <- quotedString
1614 funcType <- atomTypeSignatureP
17− funcScript <- liftM pack quotedString
15+ funcScript <- quotedString
1816 pure $ AddAtomFunction funcName funcType funcScript
1917
2018atomTypeSignatureP :: Parser [TypeConstructor]
2119atomTypeSignatureP = sepBy typeConstructorP arrow
22−
23−{-
24−evalDatabaseContextIOOp :: HscEnv -> DatabaseContext -> DatabaseContextIOExpr -> IO (Either RelationalError DatabaseContextIOExpr)
25−evalDatabaseContextIOOp env context addfunc@(AddAtomFunction _ _ _) = do
26− evalDatabaseContextIOExpr context
27− result <- runGhc (Just libdir) $ do
28− setSession env
29− ret <- typeCheckAtomFunctionScript script
30− case ret of
31− Just err -> pure (Left err)
32− Nothing -> do
33− eBody <- compileAtomFunctionScript script
34− case eBody of
35− Left err -> pure (Left err)
36− Right func -> let atomFunc = AtomFunction {
37− atomFuncName = funcName,
38− atomFuncType = funcType,
39− atomFuncBody = AtomFunctionBody (Just script) func } in
40− --actually add the func
41− pure $ Right context
42− case result of
43− Left err -> Left (AtomFunctionBodyScriptError err)
44− Right context -> pure (Right context)
45−-}
src/bin/TutorialD/Interpreter/Export/CSV.hs+2−2
@@ -5,7 +5,7 @@ import TutorialD.Interpreter.RelationalExpr
55import TutorialD.Interpreter.Base
66import ProjectM36.Base
77import ProjectM36.Error
8−import Text.Parsec.String
8+import Text.Megaparsec.Text
99import qualified Data.ByteString.Lazy as BS
1010import Control.Exception (try)
1111import qualified Data.Text as T
@@ -15,7 +15,7 @@ exportCSVP = do
1515 reserved ":exportcsv"
1616 exportExpr <- relExprP
1717 path <- quotedString
18− return $ RelVarDataExportOperator exportExpr path exportRelationCSV
18+ return $ RelVarDataExportOperator exportExpr (T.unpack path) exportRelationCSV
1919
2020exportRelationCSV :: RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError)
2121exportRelationCSV (RelVarDataExportOperator _ pathOut _) rel = do
src/bin/TutorialD/Interpreter/Import/BasicExamples.hs+1−1
@@ -4,7 +4,7 @@ import ProjectM36.DateExamples
44import ProjectM36.Base
55import ProjectM36.DatabaseContext
66import TutorialD.Interpreter.Base
7−import Text.Parsec.String
7+import Text.Megaparsec.Text
88
99data ImportBasicExampleOperator = ImportBasicDateExampleOperator
1010
src/bin/TutorialD/Interpreter/Import/CSV.hs+3−3
@@ -5,7 +5,7 @@ import ProjectM36.Error
55import ProjectM36.Relation.Parse.CSV
66import qualified Data.ByteString.Lazy as BS
77import qualified Data.Text as T
8−import Text.Parsec.String
8+import Text.Megaparsec.Text
99import TutorialD.Interpreter.Base
1010import Control.Exception
1111
@@ -23,7 +23,7 @@ importCSVP :: Parser RelVarDataImportOperator
2323importCSVP = do
2424 reserved ":importcsv"
2525 path <- quotedString
26− whiteSpace
26+ spaceConsumer
2727 relVarName <- identifier
28− return $ RelVarDataImportOperator (T.pack relVarName) path importCSVRelation
28+ return $ RelVarDataImportOperator relVarName (T.unpack path) importCSVRelation
2929
src/bin/TutorialD/Interpreter/Import/TutorialD.hs+9−7
@@ -3,29 +3,31 @@ import ProjectM36.Base
33import TutorialD.Interpreter.Import.Base
44import TutorialD.Interpreter.Base
55import TutorialD.Interpreter.DatabaseContextExpr
6−import Text.Parsec.String
7−import Text.Parsec hiding (try)
6+import Text.Megaparsec.Text
7+import Text.Megaparsec hiding (try)
88import ProjectM36.Error
9+import qualified ProjectM36.Error as PM36E
910import Data.Either
1011import qualified Data.Text as T
1112import Control.Exception
13+import qualified Data.Text.IO as TIO
1214--import a file containing TutorialD database context expressions
1315
1416importTutorialD :: FilePath -> IO (Either RelationalError DatabaseContextExpr)
1517importTutorialD pathIn = do
16− tutdData <- try (readFile pathIn) :: IO (Either IOError String)
18+ tutdData <- try (TIO.readFile pathIn) :: IO (Either IOError T.Text)
1719 case tutdData of
1820 Left err -> return $ Left (ImportError $ T.pack (show err))
1921 Right tutdData' -> do
20− let dbexprsErr = map (parse databaseExprP "import") (lines tutdData')
22+ let dbexprsErr = map (parse databaseExprP "import") (T.lines tutdData')
2123 errs = lefts dbexprsErr
2224 case errs of
23− err2:_ -> return $ Left (ParseError (T.pack (show err2)))
25+ err2:_ -> return $ Left (PM36E.ParseError (T.pack (show err2)))
2426 [] -> return $ Right (MultipleExpr (rights dbexprsErr))
2527
2628tutdImportP :: Parser DatabaseContextDataImportOperator
2729tutdImportP = do
2830 reserved ":importtutd"
2931 path <- quotedString
30− whiteSpace
31− return $ DatabaseContextDataImportOperator path importTutorialD
32+ spaceConsumer
33+ return $ DatabaseContextDataImportOperator (T.unpack path) importTutorialD
src/bin/TutorialD/Interpreter/InformationOperator.hs+2−2
@@ -1,8 +1,8 @@
11{-# LANGUAGE CPP #-}
22module TutorialD.Interpreter.InformationOperator where
33import Data.Text
4−import Text.Parsec
5−import Text.Parsec.String
4+import Text.Megaparsec
5+import Text.Megaparsec.Text
66import TutorialD.Interpreter.Base
77
88-- this module provides information about the current interpreter
src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+4−4
@@ -2,8 +2,8 @@
22module TutorialD.Interpreter.RODatabaseContextOperator where
33import ProjectM36.Base
44import qualified ProjectM36.Client as C
5−import Text.Parsec
6−import Text.Parsec.String
5+import Text.Megaparsec
6+import Text.Megaparsec.Text
77import TutorialD.Interpreter.Base
88import TutorialD.Interpreter.RelationalExpr
99import TutorialD.Interpreter.DatabaseContextExpr
@@ -58,7 +58,7 @@ showConstraintsP :: Parser RODatabaseContextOperator
5858showConstraintsP = do
5959 reservedOp ":constraints"
6060 constraintName <- option "" identifier
61− return $ ShowConstraint (T.pack constraintName)
61+ return $ ShowConstraint constraintName
6262
6363plotRelExprP :: Parser RODatabaseContextOperator
6464plotRelExprP = do
@@ -128,7 +128,7 @@ evalRODatabaseContextOp sessionId conn ShowRelationVariables = do
128128
129129evalRODatabaseContextOp _ _ (Quit) = pure QuitResult
130130
131−interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> String -> IO TutorialDOperatorResult
131+interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> T.Text -> IO TutorialDOperatorResult
132132interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseContextOperatorP "" tutdstring of
133133 Left err -> pure $ DisplayErrorResult (T.pack (show err))
134134 Right parsed -> evalRODatabaseContextOp sessionId conn parsed
src/bin/TutorialD/Interpreter/RelationalExpr.hs+32−33
@@ -1,25 +1,24 @@
11module TutorialD.Interpreter.RelationalExpr where
2−import Text.Parsec
3−import Text.Parsec.Expr
2+import Text.Megaparsec
3+import Text.Megaparsec.Expr
44import ProjectM36.Base
5−import Text.Parsec.String
5+import Text.Megaparsec.Text
66import TutorialD.Interpreter.Base
77import TutorialD.Interpreter.Types
88import qualified Data.Text as T
99import qualified Data.Set as S
1010import qualified Data.Map as M
1111import Data.List (sort)
12−import Data.Functor.Identity (Identity)
1312import Control.Applicative (liftA)
1413import ProjectM36.MiscUtils
1514
1615--used in projection
1716attributeListP :: Parser AttributeNames
1817attributeListP = do
19− but <- try (string "all but " <* whiteSpace) <|> string ""
18+ but <- try (string "all but " <* spaceConsumer) <|> string ""
2019 let constructor = if but == "" then AttributeNames else InvertedAttributeNames
2120 attrs <- sepBy identifier comma
22− return $ constructor (S.fromList (map T.pack attrs))
21+ pure $ constructor (S.fromList attrs)
2322
2423makeRelationP :: Parser RelationalExpr
2524makeRelationP = do
@@ -37,7 +36,7 @@ attributeAndTypeNameP = do
3736 attrName <- identifier
3837 --convert type name into type
3938 typeCons <- typeConstructorP
40− return $ AttributeAndTypeNameExpr (T.pack attrName) typeCons
39+ return $ AttributeAndTypeNameExpr attrName typeCons
4140
4241--abstract data type parser- in this context, the type constructor must not include any type arguments
4342--Either Text Int
@@ -45,7 +44,7 @@ adTypeConstructorP :: Parser TypeConstructor
4544adTypeConstructorP = do
4645 tConsName <- capitalizedIdentifier
4746 tConsArgs <- many typeConstructorArgP
48− pure $ ADTypeConstructor (T.pack tConsName) tConsArgs
47+ pure $ ADTypeConstructor tConsName tConsArgs
4948
5049tupleExprP :: Parser TupleExpr
5150tupleExprP = do
@@ -62,25 +61,25 @@ tupleAtomExprP :: Parser (AttributeName, AtomExpr)
6261tupleAtomExprP = do
6362 attributeName <- identifier
6463 atomExpr <- atomExprP
65− return $ (T.pack attributeName, atomExpr)
64+ pure $ (attributeName, atomExpr)
6665
6766projectP :: Parser (RelationalExpr -> RelationalExpr)
6867projectP = do
6968 attrs <- braces attributeListP
70− return $ Project attrs
69+ pure $ Project attrs
7170
72−renameClauseP :: Parser (String, String)
71+renameClauseP :: Parser (T.Text, T.Text)
7372renameClauseP = do
7473 oldAttr <- identifier
7574 reservedOp "as"
7675 newAttr <- identifier
77− return $ (oldAttr, newAttr)
76+ pure $ (oldAttr, newAttr)
7877
7978renameP :: Parser (RelationalExpr -> RelationalExpr)
8079renameP = do
8180 reservedOp "rename"
8281 (oldAttr, newAttr) <- braces renameClauseP
83− return $ Rename (T.pack oldAttr) (T.pack newAttr)
82+ return $ Rename oldAttr newAttr
8483
8584whereClauseP :: Parser (RelationalExpr -> RelationalExpr)
8685whereClauseP = do
@@ -88,7 +87,7 @@ whereClauseP = do
8887 boolExpr <- restrictionPredicateP
8988 return $ Restrict boolExpr
9089
91−groupClauseP :: Parser (AttributeNames, String)
90+groupClauseP :: Parser (AttributeNames, T.Text)
9291groupClauseP = do
9392 attrs <- braces attributeListP
9493 reservedOp "as"
@@ -99,14 +98,14 @@ groupP :: Parser (RelationalExpr -> RelationalExpr)
9998groupP = do
10099 reservedOp "group"
101100 (groupAttrList, groupAttrName) <- parens groupClauseP
102− return $ Group groupAttrList (T.pack groupAttrName)
101+ pure $ Group groupAttrList groupAttrName
103102
104103--in "Time and Relational Theory" (2014), Date's Tutorial D grammar for ungroup takes one attribute, while in previous books, it take multiple arguments. Let us assume that nested ungroups are the same as multiple attributes.
105104ungroupP :: Parser (RelationalExpr -> RelationalExpr)
106105ungroupP = do
107106 reservedOp "ungroup"
108107 rvaAttrName <- identifier
109− return $ Ungroup (T.pack rvaAttrName)
108+ pure $ Ungroup rvaAttrName
110109
111110extendP :: Parser (RelationalExpr -> RelationalExpr)
112111extendP = do
@@ -114,25 +113,25 @@ extendP = do
114113 tupleExpr <- braces extendTupleExpressionP
115114 return $ Extend tupleExpr
116115
117−relOperators :: [[Operator String () Identity RelationalExpr]]
116+relOperators :: [[Operator Parser RelationalExpr]]
118117relOperators = [
119118 [Postfix projectP],
120119 [Postfix renameP],
121120 [Postfix whereClauseP],
122121 [Postfix groupP],
123122 [Postfix ungroupP],
124− [Infix (reservedOp "join" >> return Join) AssocLeft],
125− [Infix (reservedOp "union" >> return Union) AssocLeft],
126− [Infix (reservedOp "minus" >> return Difference) AssocLeft],
127− [Infix (reservedOp "=" >> return Equals) AssocNone],
123+ [InfixL (reservedOp "join" >> return Join)],
124+ [InfixL (reservedOp "union" >> return Union)],
125+ [InfixL (reservedOp "minus" >> return Difference)],
126+ [InfixN (reservedOp "=" >> return Equals)],
128127 [Postfix extendP]
129128 ]
130129
131130relExprP :: Parser RelationalExpr
132−relExprP = buildExpressionParser relOperators relTerm
131+relExprP = makeExprParser relTerm relOperators
133132
134133relVarP :: Parser RelationalExpr
135−relVarP = liftA (RelationVariable . T.pack) identifier
134+relVarP = liftA RelationVariable identifier
136135
137136relTerm :: Parser RelationalExpr
138137relTerm = parens relExprP
@@ -140,12 +139,12 @@ relTerm = parens relExprP
140139 <|> relVarP
141140
142141restrictionPredicateP :: Parser RestrictionPredicateExpr
143−restrictionPredicateP = buildExpressionParser predicateOperators predicateTerm
142+restrictionPredicateP = makeExprParser predicateTerm predicateOperators
144143 where
145144 predicateOperators = [
146145 [Prefix (reservedOp "not" >> return NotPredicate)],
147− [Infix (reservedOp "and" >> return AndPredicate) AssocLeft],
148− [Infix (reservedOp "or" >> return OrPredicate) AssocLeft]
146+ [InfixL (reservedOp "and" >> return AndPredicate)],
147+ [InfixL (reservedOp "or" >> return OrPredicate)]
149148 ]
150149 predicateTerm = parens restrictionPredicateP
151150 <|> try restrictionAtomExprP
@@ -163,7 +162,7 @@ restrictionAttributeEqualityP = do
163162 attributeName <- identifier
164163 reservedOp "="
165164 atomexpr <- atomExprP
166− return $ AttributeEqualityPredicate (T.pack attributeName) atomexpr
165+ return $ AttributeEqualityPredicate attributeName atomexpr
167166
168167restrictionAtomExprP :: Parser RestrictionPredicateExpr --atoms which are of type "boolean"
169168restrictionAtomExprP = do
@@ -181,7 +180,7 @@ attributeExtendTupleExpressionP = do
181180 newAttr <- identifier
182181 reservedOp ":="
183182 atom <- atomExprP
184− return $ AttributeExtendTupleExpr (T.pack newAttr) atom
183+ return $ AttributeExtendTupleExpr newAttr atom
185184
186185atomExprP :: Parser AtomExpr
187186atomExprP = consumeAtomExprP True
@@ -198,7 +197,7 @@ attributeAtomExprP :: Parser AtomExpr
198197attributeAtomExprP = do
199198 _ <- string "@"
200199 attrName <- identifier
201− return $ AttributeAtomExpr (T.pack attrName)
200+ return $ AttributeAtomExpr attrName
202201
203202nakedAtomExprP :: Parser AtomExpr
204203nakedAtomExprP = NakedAtomExpr <$> atomP
@@ -206,8 +205,8 @@ nakedAtomExprP = NakedAtomExpr <$> atomP
206205constructedAtomExprP :: Bool -> Parser AtomExpr
207206constructedAtomExprP consume = do
208207 dConsName <- capitalizedIdentifier
209− dConsArgs <- if consume then sepBy (consumeAtomExprP False) spaces else pure []
210− pure $ ConstructedAtomExpr (T.pack dConsName) dConsArgs
208+ dConsArgs <- if consume then sepBy (consumeAtomExprP False) spaceConsumer else pure []
209+ pure $ ConstructedAtomExpr dConsName dConsArgs
211210
212211-- used only for primitive type parsing ?
213212atomP :: Parser Atom
@@ -220,13 +219,13 @@ functionAtomExprP :: Parser AtomExpr
220219functionAtomExprP = do
221220 funcName <- identifier
222221 argList <- parens (sepBy atomExprP comma)
223− return $ FunctionAtomExpr (T.pack funcName) argList
222+ return $ FunctionAtomExpr funcName argList
224223
225224relationalAtomExprP :: Parser AtomExpr
226225relationalAtomExprP = RelationAtomExpr <$> relExprP
227226
228227stringAtomP :: Parser Atom
229−stringAtomP = liftA (TextAtom . T.pack) quotedString
228+stringAtomP = liftA TextAtom quotedString
230229
231230doubleAtomP :: Parser Atom
232231doubleAtomP = DoubleAtom <$> (try float)
src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+8−9
@@ -1,10 +1,9 @@
11{-# LANGUAGE GADTs #-}
22module TutorialD.Interpreter.TransactionGraphOperator where
33import TutorialD.Interpreter.Base
4−import Text.Parsec
5−import Text.Parsec.String
4+import Text.Megaparsec.Text
5+import Text.Megaparsec
66import qualified Data.UUID as U
7−import qualified Data.Text as T
87import ProjectM36.TransactionGraph
98import ProjectM36.Client
109import ProjectM36.Error
@@ -14,7 +13,7 @@ jumpToHeadP :: Parser TransactionGraphOperator
1413jumpToHeadP = do
1514 reservedOp ":jumphead"
1615 headid <- identifier
17− return $ JumpToHead (T.pack headid)
16+ return $ JumpToHead headid
1817
1918jumpToTransactionP :: Parser TransactionGraphOperator
2019jumpToTransactionP = do
@@ -26,7 +25,7 @@ branchTransactionP :: Parser TransactionGraphOperator
2625branchTransactionP = do
2726 reservedOp ":branch"
2827 branchName <- identifier
29− return $ Branch (T.pack branchName)
28+ return $ Branch branchName
3029
3130commitTransactionP :: Parser TransactionGraphOperator
3231commitTransactionP = do
@@ -48,11 +47,11 @@ mergeTransactionStrategyP = (reserved "union" *> pure UnionMergeStrategy) <|>
4847 (do
4948 reserved "selectedbranch"
5049 branch <- identifier
51− pure (SelectedBranchMergeStrategy (T.pack branch))) <|>
50+ pure (SelectedBranchMergeStrategy branch)) <|>
5251 (do
5352 reserved "unionpreferbranch"
5453 branch <- identifier
55− pure (UnionPreferMergeStrategy (T.pack branch)))
54+ pure (UnionPreferMergeStrategy branch))
5655
5756mergeTransactionsP :: Parser TransactionGraphOperator
5857mergeTransactionsP = do
@@ -60,7 +59,7 @@ mergeTransactionsP = do
6059 strategy <- mergeTransactionStrategyP
6160 headA <- identifier
6261 headB <- identifier
63− pure (MergeTransactions strategy (T.pack headA) (T.pack headB))
62+ pure (MergeTransactions strategy headA headB)
6463
6564transactionGraphOpP :: Parser TransactionGraphOperator
6665transactionGraphOpP = do
@@ -76,7 +75,7 @@ roTransactionGraphOpP = showGraphP
7675
7776uuidP :: Parser U.UUID
7877uuidP = do
79− uuidStr <- many (alphaNum <|> char '-')
78+ uuidStr <- many (alphaNumChar <|> char '-')
8079 case U.fromString uuidStr of
8180 Nothing -> fail "Invalid uuid string"
8281 Just uuid -> return uuid
src/bin/TutorialD/Interpreter/Types.hs+9−12
@@ -1,49 +1,46 @@
11--parse type and data constructors
22module TutorialD.Interpreter.Types where
33import ProjectM36.Base
4−import Text.Parsec.String
5−import Text.Parsec
4+import Text.Megaparsec.Text
5+import Text.Megaparsec
66import TutorialD.Interpreter.Base
77import ProjectM36.DataTypes.Primitive
8−import Control.Monad (liftM)
98import qualified Data.Text as T
109
1110-- | Upper case names are type names while lower case names are polymorphic typeconstructor arguments.
1211-- data *Either a b* = Left a | Right b
1312typeConstructorDefP :: Parser TypeConstructorDef
14−typeConstructorDefP = ADTypeConstructorDef <$> liftM T.pack capitalizedIdentifier <*> typeVarNamesP
13+typeConstructorDefP = ADTypeConstructorDef <$> capitalizedIdentifier <*> typeVarNamesP
1514
1615typeVarNamesP :: Parser [TypeVarName]
17−typeVarNamesP = do
18− vars <- many uncapitalizedIdentifier
19− pure (map T.pack vars)
16+typeVarNamesP = many uncapitalizedIdentifier
2017
2118-- data Either a b = *Left a* | *Right b*
2219dataConstructorDefP :: Parser DataConstructorDef
23−dataConstructorDefP = DataConstructorDef <$> liftM T.pack capitalizedIdentifier <*> many dataConstructorDefArgP
20+dataConstructorDefP = DataConstructorDef <$> capitalizedIdentifier <*> many dataConstructorDefArgP
2421
2522-- data *Either a b* = Left *a* | Right *b*
2623dataConstructorDefArgP :: Parser DataConstructorDefArg
2724dataConstructorDefArgP = parens (DataConstructorDefTypeConstructorArg <$> typeConstructorP) <|>
2825 DataConstructorDefTypeConstructorArg <$> typeConstructorP <|>
29− DataConstructorDefTypeVarNameArg <$> liftM T.pack uncapitalizedIdentifier
26+ DataConstructorDefTypeVarNameArg <$> uncapitalizedIdentifier
3027
3128--built-in, nullary type constructors
3229-- Int, Text, etc.
3330primitiveTypeConstructorP :: Parser TypeConstructor
3431primitiveTypeConstructorP = choice (map (\(PrimitiveTypeConstructorDef name typ, _) -> do
35− tName <- try $ liftM T.pack (symbol (T.unpack name))
32+ tName <- try $ symbol (T.unpack name)
3633 pure $ PrimitiveTypeConstructor tName typ)
3734 primitiveTypeConstructorMapping)
3835
3936-- *Either Int Text*, *Int*
4037typeConstructorP :: Parser TypeConstructor
4138typeConstructorP = primitiveTypeConstructorP <|>
42− ADTypeConstructor <$> liftM T.pack capitalizedIdentifier <*> many typeConstructorArgP
39+ ADTypeConstructor <$> capitalizedIdentifier <*> many typeConstructorArgP
4340
4441typeConstructorArgP :: Parser TypeConstructorArg
4542typeConstructorArgP = TypeConstructorArg <$> typeConstructorP <|>
46− TypeConstructorTypeVarArg <$> liftM T.pack uncapitalizedIdentifier
43+ TypeConstructorTypeVarArg <$> uncapitalizedIdentifier
4744
4845
4946