c8968b5 · project-m36 · git.iko.soy

git.iko.soy/project-m36

Added support for GHC 8.6

commitc8968b5ab924380a9dd608710cce580303a8d203 authoriko <ilyakooo0@gmail.com> dateSun 1 Sep 2019, 16:53 (7 years ago) parent4dfb019

12 files changed+271−171

compare with master

unifiedsplit

.travis.yml+6−3 project-m36.cabal+21−18 src/bin/ProjectM36/Server/WebSocket.hs+30−19 src/bin/TutorialD/Interpreter.hs+25−25 src/bin/TutorialD/Interpreter/Base.hs+29−17 src/bin/TutorialD/Interpreter/RelationalExpr.hs+29−24 src/bin/benchmark/Handles.hs+23−14 src/lib/ProjectM36/ScriptSession.hs+35−28 src/lib/ProjectM36/Sessions.hs+1−3 stack.ghc8.4.yaml+1−2 stack.ghc8.6.yaml+54 test/Relation/Export/CSV.hs+17−18

.travis.yml+6−3

@@ -27,6 +27,9 @@ matrix:

2727 - env: CACHE_NAME=8.4.3 STACK_YAML=stack.ghc8.4.yaml

2828 compiler: ": #stack 8.4.3"

2929

30+ - env: CACHE_NAME=8.6.5 STACK_YAML=stack.ghc8.6.yaml

31+ compiler: ": #stack 8.6.5"

32+

3033before_script:

3134 - unset CC

3235 - export PATH=$HOME/.local/bin:/opt/ghc/$GHC_VERSION/bin:$PATH

@@ -43,13 +46,13 @@ script:

4346 stack --no-terminal --jobs=2 --system-ghc test

4447 - |

4548 #Run HLint

46− if [[ "$(uname)" = "Linux" ]]; then

49+ if [[ "$(uname)" = "Linux" ]]; then

4750 curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s lint src test examples --cpp-define VERSION_project_m36=HLINT

4851 fi

4952 - |

5053 #Run Haddock

51− if [[ "$(uname)" = "Linux" ]]; then

52− stack --no-install-ghc --system-ghc --no-haddock-deps haddock

54+ if [[ "$(uname)" = "Linux" ]]; then

55+ stack --no-install-ghc --system-ghc --no-haddock-deps haddock

5356 fi

5457

5558after_success:

project-m36.cabal+21−18

@@ -30,6 +30,8 @@ Flag stack

3030

3131Library

3232 Build-Depends: base>=4.8 && < 4.12, ghc >= 7.8 && < 8.5, 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

33+ if impl(ghc>= 8.6)

34+ Build-Depends: deferred-folds

3335 Exposed-Modules: ProjectM36.Error,

3436 ProjectM36.Transaction,

3537 ProjectM36.TransactionGraph,

@@ -112,14 +114,14 @@ Library

112114 GHC-Options: -rdynamic

113115 C-sources: cbits/DirectoryFsync.c, cbits/darwin_statfs.c

114116 Build-Depends: unix

115− CC-Options: -fPIC

117+ CC-Options: -fPIC

116118 Hs-Source-Dirs: ./src/lib

117119 Default-Language: Haskell2010

118120 Default-Extensions: OverloadedStrings, CPP

119121 if impl(ghc>= 8)

120122 build-depends:

121123 ghc-boot, ghci

122− if !flag(stack)

124+ if !flag(stack)

123125 Build-Depends: deferred-folds

124126

125127Executable tutd

@@ -159,7 +161,8 @@ Executable tutd

159161 optparse-applicative,

160162 attoparsec,

161163 stm-containers >= 1.0.0,

162− list-t

164+ list-t,

165+ parser-combinators

163166 Other-Modules: TutorialD.Interpreter,

164167 TutorialD.Interpreter.Base,

165168 TutorialD.Interpreter.DatabaseContextExpr,

@@ -217,7 +220,7 @@ Executable project-m36-server

217220 list-t,

218221 base64-bytestring

219222 Main-Is: ./src/bin/ProjectM36/Server/project-m36-server.hs

220− GHC-Options: -Wall -threaded -rtsopts

223+ GHC-Options: -Wall -threaded -rtsopts

221224 if flag(profiler)

222225 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall

223226 Default-Language: Haskell2010

@@ -226,7 +229,7 @@ Executable project-m36-server

226229Executable bigrel

227230 Default-Language: Haskell2010

228231 Default-Extensions: OverloadedStrings

229− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36, random, MonadRandom, semigroups

232+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36, random, MonadRandom, semigroups, parser-combinators

230233 Other-Modules: TutorialD.Interpreter.Base,

231234 TutorialD.Interpreter.DatabaseContextExpr,

232235 TutorialD.Interpreter.RelationalExpr,

@@ -253,7 +256,7 @@ Test-Suite test-tutoriald

253256 Default-Extensions: OverloadedStrings

254257 type: exitcode-stdio-1.0

255258 main-is: test/TutorialD/Interpreter.hs

256− 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

259+ 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

257260 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

258261 GHC-Options: -Wall -threaded

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

@@ -264,7 +267,7 @@ Test-Suite test-tutoriald-atomfunctionscript

264267 type: exitcode-stdio-1.0

265268 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

266269 main-is: test/TutorialD/Interpreter/AtomFunctionScript.hs

267− Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time

270+ Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time, parser-combinators

268271 GHC-Options: -Wall -threaded

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

270273

@@ -274,7 +277,7 @@ Test-Suite test-tutoriald-databasecontextfunctionscript

274277 type: exitcode-stdio-1.0

275278 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

276279 main-is: test/TutorialD/Interpreter/DatabaseContextFunctionScript.hs

277− Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time

280+ Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time, parser-combinators

278281 GHC-Options: -Wall -threaded

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

280283

@@ -299,7 +302,7 @@ Test-Suite test-transactiongraph-persist

299302 Default-Extensions: OverloadedStrings

300303 type: exitcode-stdio-1.0

301304 main-is: test/TransactionGraph/Persist.hs

302− 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

305+ 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

303306 Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples

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

305308 GHC-Options: -Wall -threaded

@@ -317,7 +320,7 @@ Test-Suite test-tutoriald-import-tutoriald

317320 Default-Extensions: OverloadedStrings

318321 type: exitcode-stdio-1.0

319322 main-is: test/TutorialD/Interpreter/Import/TutorialD.hs

320− 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

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

321324 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

322325 GHC-Options: -Wall -threaded

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

@@ -397,14 +400,14 @@ Test-Suite test-scripts

397400 Default-Extensions: OverloadedStrings

398401 type: exitcode-stdio-1.0

399402 main-is: test/scripts.hs

400− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, project-m36, random, MonadRandom, semigroups

403+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, project-m36, random, MonadRandom, semigroups, parser-combinators

401404 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

402405 GHC-Options: -Wall -threaded

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

404407

405408Executable project-m36-websocket-server

406409 Default-Language: Haskell2010

407− Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, websockets, aeson, optparse-applicative, project-m36, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring, random, MonadRandom, time, network-transport-tcp, semigroups, attoparsec

410+ Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, websockets, aeson, optparse-applicative, project-m36, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring, random, MonadRandom, time, network-transport-tcp, semigroups, attoparsec, parser-combinators

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

409412 Other-Modules: ProjectM36.Client.Json, ProjectM36.Server.RemoteCallTypes.Json, ProjectM36.Server.WebSocket, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.SchemaOperator

410413 GHC-Options: -Wall -threaded

@@ -415,7 +418,7 @@ Test-Suite test-websocket-server

415418 Default-Language: Haskell2010

416419 type: exitcode-stdio-1.0

417420 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, 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

421+ 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

419422 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

420423 Default-Extensions: OverloadedStrings

421424 GHC-Options: -Wall -threaded

@@ -434,7 +437,7 @@ Test-Suite test-atomable

434437 Default-Language: Haskell2010

435438 type: exitcode-stdio-1.0

436439 main-is: test/Relation/Atomable.hs

437− 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

440+ 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

438441 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

439442 Default-Extensions: OverloadedStrings

440443 GHC-Options: -Wall -threaded

@@ -453,7 +456,7 @@ Test-Suite test-transactiongraph-automerge

453456 Default-Language: Haskell2010

454457 type: exitcode-stdio-1.0

455458 main-is: test/TransactionGraph/Automerge.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, semigroups

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, semigroups, parser-combinators

457460 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

458461 Default-Extensions: OverloadedStrings

459462 GHC-Options: -Wall -threaded

@@ -481,7 +484,7 @@ Test-Suite test-client-simple

481484Executable handles

482485 Default-Language: Haskell2010

483486 Default-Extensions: OverloadedStrings

484− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36, random, MonadRandom, semigroups

487+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36, random, MonadRandom, semigroups, parser-combinators

485488 main-is: benchmark/Handles.hs

486489 Other-Modules: TutorialD.Interpreter,

487490 TutorialD.Interpreter.Base,

@@ -504,13 +507,13 @@ Executable handles

504507 HS-Source-Dirs: ./src/bin

505508 if flag(profiler)

506509 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall

507−

510+

508511Test-Suite test-dataframe

509512 Default-Language: Haskell2010

510513 Main-Is: test/DataFrame.hs

511514 type: exitcode-stdio-1.0

512515 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

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

516+ 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

514517 Default-Extensions: OverloadedStrings

515518 GHC-Options: -Wall -threaded

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

src/bin/ProjectM36/Server/WebSocket.hs+30−19

@@ -1,4 +1,4 @@

1−{-# LANGUAGE LambdaCase #-}

1+{-# LANGUAGE LambdaCase, CPP #-}

22module ProjectM36.Server.WebSocket where

33-- while the tutd client performs TutorialD parsing on the client, the websocket server will pass tutd to be parsed and executed on the server- otherwise I have to pull in ghcjs as a dependency to allow client-side parsing- that's not appealing because then the frontend is not language-agnostic, but this could change in the future, perhaps by sending different messages over the websocket

44-- ideally, the wire protocol should not be exposed to a straight string-based API ala SQL, so we could make perhaps a javascript DSL which compiles to the necessary JSON- anaylyze tradeoffs

@@ -23,8 +23,12 @@ import Control.Applicative

2323import Text.Megaparsec.Error

2424import Data.Functor

2525

26+#if __GLASGOW_HASKELL__ >= 806

27+import Data.List.NonEmpty as NE

28+#endif

29+

2630websocketProxyServer :: Port -> Hostname -> WS.ServerApp

27−websocketProxyServer port host pending = do

31+websocketProxyServer port host pending = do

2832 conn <- WS.acceptRequest pending

2933 let unexpectedMsg = WS.sendTextData conn ("messagenotexpected" :: T.Text)

3034 --phase 1- accept database name for connection

@@ -33,10 +37,10 @@ websocketProxyServer port host pending = do

3337 if not (connectdbmsg `T.isPrefixOf` dbmsg) then unexpectedMsg >> WS.sendClose conn ("" :: T.Text)

3438 else do

3539 let dbname = T.unpack $ T.drop (T.length connectdbmsg) dbmsg

36− bracket (createConnection conn dbname port host)

40+ bracket (createConnection conn dbname port host)

3741 (\case

3842 Right dbconn -> close dbconn

39− Left _ -> pure ()) $ \case

43+ Left _ -> pure ()) $ \case

4044 Left err -> sendError conn err

4145 Right dbconn -> do

4246 eSessionId <- createSessionAtHead dbconn "master"

@@ -47,31 +51,38 @@ websocketProxyServer port host pending = do

4751 _ <- forever $ do

4852 pInfo <- promptInfo sessionId dbconn

4953 --figure out why sending three times during startup is necessary

50− sendPromptInfo pInfo conn

54+ sendPromptInfo pInfo conn

5155 sendPromptInfo pInfo conn

5256 msg <- WS.receiveData conn :: IO T.Text

5357 case parseOnly parseExecuteMessage msg of

5458 Left _ -> unexpectedMsg

5559 Right (presentation, tutdString) ->

5660 case parseTutorialD tutdString of

57− Left err -> handleOpResult conn dbconn presentation (DisplayErrorResult ("parse error: " `T.append` T.pack (parseErrorPretty err)))

61+ Left err -> handleOpResult conn dbconn presentation

62+ #if __GLASGOW_HASKELL__ >= 806

63+ (DisplayErrorResult

64+ ("parse error: " `T.append` T.pack

65+ (parseErrorPretty . NE.head . bundleErrors $ err)))

66+ #else

67+ (DisplayErrorResult ("parse error: " `T.append` T.pack (parseErrorPretty err)))

68+ #endif

5869 Right parsed -> do

59− let timeoutFilter exc = if exc == RequestTimeoutException

60− then Just exc

70+ let timeoutFilter exc = if exc == RequestTimeoutException

71+ then Just exc

6172 else Nothing

6273 responseHandler = do

6374 result <- evalTutorialD sessionId dbconn SafeEvaluation parsed

6475 pInfo' <- promptInfo sessionId dbconn

65− sendPromptInfo pInfo' conn

76+ sendPromptInfo pInfo' conn

6677 handleOpResult conn dbconn presentation result

6778 catchJust timeoutFilter responseHandler (\_ -> handleOpResult conn dbconn presentation (DisplayErrorResult "Request Timed Out."))

6879 pure ()

69−

70−notificationCallback :: WS.Connection -> NotificationCallback

80+

81+notificationCallback :: WS.Connection -> NotificationCallback

7182notificationCallback conn notifName evaldNotif = WS.sendTextData conn (encode (object ["notificationname" .= notifName,

7283 "evaldnotification" .= evaldNotif

7384 ]))

74−

85+

7586--this creates a new database for each connection- perhaps not what we want (?)

7687createConnection :: WS.Connection -> DatabaseName -> Port -> Hostname -> IO (Either ConnectionError Connection)

7788createConnection wsconn dbname port host = connectProjectM36 (RemoteProcessConnectionInfo dbname (createNodeId host port) (notificationCallback wsconn))

@@ -100,32 +111,32 @@ handleOpResult conn _ presentation (DisplayDataFrameResult df) = do

100111 texto = ["text" .= showDataFrame df | textPresentation presentation]

101112 htmlo = ["html" .= dataFrameAsHTML df | htmlPresentation presentation]

102113 WS.sendTextData conn (encode (object ["displaydataframe" .= object (jsono ++ texto ++ htmlo)]))

103−

114+

104115-- get current schema and head name for client

105116promptInfo :: SessionId -> Connection -> IO (HeadName, SchemaName)

106117promptInfo sessionId conn = do

107− eHeadName <- headName sessionId conn

118+ eHeadName <- headName sessionId conn

108119 eSchemaName <- currentSchemaName sessionId conn

109120 pure (either (const "<unknown>") id eHeadName, either (const "<no schema>") id eSchemaName)

110−

121+

111122sendPromptInfo :: (HeadName, SchemaName) -> WS.Connection -> IO ()

112123sendPromptInfo (hName, sName) conn = WS.sendTextData conn (encode (object ["promptInfo" .= object ["headname" .= hName, "schemaname" .= sName]]))

113124

114125--a returning relation can be returned as JSON, Text (for consoles), or HTML

115126data Presentation = Presentation {

116− jsonPresentation :: Bool,

127+ jsonPresentation :: Bool,

117128 textPresentation :: Bool,

118129 htmlPresentation :: Bool }

119−

130+

120131data PresentationFlag = JSONFlag | TextFlag | HTMLFlag

121−

132+

122133parseExecuteMessage :: Parser (Presentation, T.Text)

123134parseExecuteMessage = do

124135 _ <- string "executetutd/"

125136 flags <- sepBy ((string "json" $> JSONFlag) <|>

126137 (string "text" $> TextFlag) <|>

127138 (string "html" $> HTMLFlag)) "+"

128− let presentation = foldr (\flag acc -> case flag of

139+ let presentation = foldr (\flag acc -> case flag of

129140 JSONFlag -> acc {jsonPresentation = True}

130141 TextFlag -> acc {textPresentation = True}

131142 HTMLFlag -> acc {htmlPresentation = True}) (Presentation False False False) flags

src/bin/TutorialD/Interpreter.hs+25−25

@@ -61,7 +61,7 @@ interpreterParserP = safeInterpreterParserP <|>

6161 fmap ImportDBContextOp (tutdImportP <* eof) <|>

6262 fmap RelVarExportOp (exportCSVP <* eof) <|>

6363 fmap DatabaseContextIOExprOp (dbContextIOExprP <* eof)

64−

64+

6565-- the safe interpreter never reads or writes the file system

6666safeInterpreterParserP :: Parser ParsedOperation

6767safeInterpreterParserP = fmap RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>

@@ -78,7 +78,7 @@ promptText :: Either RelationalError HeadName -> Either RelationalError SchemaNa

7878promptText eHeadName eSchemaName = "TutorialD (" <> transInfo <> "): "

7979 where

8080 transInfo = either (const "<unknown>") id eHeadName <> "/" <> either (const "<no schema>") id eSchemaName

81−

81+

8282parseTutorialD :: T.Text -> Either ParserError ParsedOperation

8383parseTutorialD = parse interpreterParserP ""

8484

@@ -106,20 +106,20 @@ evalTutorialDInteractive sessionId conn safe interactive expr = case expr of

106106 else

107107 pure res

108108 _ -> pure res

109−

110− (DatabaseContextExprOp execOp) ->

111− eHandler $ C.executeDatabaseContextExpr sessionId conn execOp

112−

113− (DatabaseContextIOExprOp execOp) ->

109+

110+ (DatabaseContextExprOp execOp) ->

111+ eHandler $ C.executeDatabaseContextExpr sessionId conn execOp

112+

113+ (DatabaseContextIOExprOp execOp) ->

114114 if needsSafe then

115115 unsafeError

116116 else

117117 eHandler $ C.executeDatabaseContextIOExpr sessionId conn execOp

118−

118+

119119 (GraphOp execOp) -> do

120120 -- warn if the graph op could cause uncommited changes to be discarded

121121 eIsDirty <- C.disconnectedTransactionIsDirty sessionId conn

122− let runGraphOp = eHandler $ C.executeGraphExpr sessionId conn execOp

122+ let runGraphOp = eHandler $ C.executeGraphExpr sessionId conn execOp

123123 settings = Settings {complete = noCompletion,

124124 historyFile = Nothing,

125125 autoAddHistory = False}

@@ -143,20 +143,20 @@ evalTutorialDInteractive sessionId conn safe interactive expr = case expr of

143143 pure (DisplayErrorResult "Graph operation cancelled.")

144144 else

145145 runGraphOp

146−

146+

147147 (ConvenienceGraphOp execOp) ->

148148 eHandler $ evalConvenienceGraphOp sessionId conn execOp

149149

150150 (ROGraphOp execOp) -> do

151151 opResult <- evalROGraphOp sessionId conn execOp

152− case opResult of

152+ case opResult of

153153 Left err -> barf err

154154 Right rel -> pure (DisplayRelationResult rel)

155−

155+

156156 (SchemaOp execOp) ->

157157 eHandler $ evalSchemaOperator sessionId conn execOp

158−

159− (ImportRelVarOp execOp@(RelVarDataImportOperator relVarName _ _)) ->

158+

159+ (ImportRelVarOp execOp@(RelVarDataImportOperator relVarName _ _)) ->

160160 if needsSafe then

161161 unsafeError

162162 else do

@@ -174,8 +174,8 @@ evalTutorialDInteractive sessionId conn safe interactive expr = case expr of

174174 case exprErr of

175175 Left err -> barf err

176176 Right dbexpr -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexpr)

177−

178− (ImportDBContextOp execOp) ->

177+

178+ (ImportDBContextOp execOp) ->

179179 if needsSafe then

180180 unsafeError

181181 else do

@@ -183,15 +183,15 @@ evalTutorialDInteractive sessionId conn safe interactive expr = case expr of

183183 case eErr of

184184 Left err -> barf err

185185 Right dbexprs -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexprs)

186−

187− (InfoOp execOp) ->

186+

187+ (InfoOp execOp) ->

188188 if needsSafe then

189189 unsafeError

190190 else

191191 case evalInformationOperator execOp of

192192 Left err -> pure (DisplayErrorResult err)

193193 Right info -> pure (DisplayResult info)

194−

194+

195195 (RelVarExportOp execOp@(RelVarDataExportOperator relExpr _ _)) ->

196196 --eval relexpr to relation and pass to export function

197197 if needsSafe then

@@ -221,11 +221,11 @@ evalTutorialDInteractive sessionId conn safe interactive expr = case expr of

221221 case eErr of

222222 Left err -> barf err

223223 Right () -> return QuietSuccessResult

224−

225−type GhcPkgPath = String

224+

225+type GhcPkgPath = String

226226type TutorialDExec = String

227227type CheckFS = Bool

228−

228+

229229data InterpreterConfig = LocalInterpreterConfig PersistenceStrategy HeadName (Maybe TutorialDExec) [GhcPkgPath] CheckFS |

230230 RemoteInterpreterConfig C.NodeId C.DatabaseName HeadName (Maybe TutorialDExec) CheckFS

231231

@@ -256,12 +256,12 @@ reprLoop config sessionId conn = do

256256 Just line -> do

257257 runTutorialD sessionId conn (Just (T.length prompt)) (T.pack line)

258258 reprLoop config sessionId conn

259−

259+

260260

261261runTutorialD :: C.SessionId -> C.Connection -> Maybe PromptLength -> T.Text -> IO ()

262−runTutorialD sessionId conn mPromptLength tutd =

262+runTutorialD sessionId conn mPromptLength tutd =

263263 case parseTutorialD tutd of

264− Left err ->

264+ Left err ->

265265 displayOpResult $ DisplayParseErrorResult mPromptLength err

266266 Right parsed ->

267267 catchJust (\exc -> if exc == C.RequestTimeoutException then Just exc else Nothing) (do

src/bin/TutorialD/Interpreter/Base.hs+29−17

@@ -1,8 +1,8 @@

11{-# LANGUAGE DeriveGeneric, CPP #-}

22module TutorialD.Interpreter.Base (

3− module TutorialD.Interpreter.Base,

3+ module TutorialD.Interpreter.Base,

44 module Text.Megaparsec,

5−#if MIN_VERSION_megaparsec(6,0,0)

5+#if MIN_VERSION_megaparsec(6,0,0)

66 module Text.Megaparsec.Char,

77 module Control.Applicative

88#else

@@ -45,11 +45,16 @@ import Data.Time.Clock

4545import Data.Time.Format

4646import Control.Monad (void)

4747

48+#if __GLASGOW_HASKELL__ < 806

49+anySingle :: Parsec Void Text (Token Text)

50+anySingle = anyChar

51+#endif

52+

4853displayOpResult :: TutorialDOperatorResult -> IO ()

4954displayOpResult QuitResult = return ()

5055displayOpResult (DisplayResult out) = TIO.putStrLn out

5156displayOpResult (DisplayIOResult ioout) = ioout

52−displayOpResult (DisplayErrorResult err) = let outputf = if T.length err > 0 && T.last err /= '\n' then TIO.hPutStrLn else TIO.hPutStr in

57+displayOpResult (DisplayErrorResult err) = let outputf = if T.length err > 0 && T.last err /= '\n' then TIO.hPutStrLn else TIO.hPutStr in

5358 outputf stderr ("ERR: " <> err)

5459displayOpResult QuietSuccessResult = return ()

5560displayOpResult (DisplayRelationResult rel) = do

@@ -57,8 +62,14 @@ displayOpResult (DisplayRelationResult rel) = do

5762 let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen

5863 TIO.putStrLn (showRelation randomlySortedRel)

5964displayOpResult (DisplayParseErrorResult mPromptLength err) = do

60− let errString = T.pack (parseErrorPretty err)

65+ let

66+ #if __GLASGOW_HASKELL__ >= 806

67+ errorIndent = errorOffset . NE.head . bundleErrors $ err

68+ errString = T.pack (parseErrorPretty . NE.head . bundleErrors $ err)

69+ #else

6170 errorIndent = unPos (sourceColumn (NE.head (errorPos err)))

71+ errString = T.pack (parseErrorPretty err)

72+ #endif

6273 pointyString len = T.justifyRight (len + fromIntegral errorIndent) '_' "^"

6374 maybe (pure ()) (TIO.putStrLn . pointyString) mPromptLength

6475 TIO.putStr ("ERR:" <> errString)

@@ -73,7 +84,7 @@ type ParseStr = String

7384

7485spaceConsumer :: Parser ()

7586spaceConsumer = Lex.space (void spaceChar) (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")

76−

87+

7788opChar :: Parser Char

7889opChar = oneOf (":!#$%&*+./<=>?\\^|-~" :: String)-- remove "@" so it can be used as attribute marker without spaces

7990

@@ -143,11 +154,11 @@ float :: Parser Double

143154float = Lex.float

144155

145156capitalizedIdentifier :: Parser Text

146−capitalizedIdentifier =

157+capitalizedIdentifier =

147158 upperChar >>= identifierRemainder

148−

159+

149160uncapitalizedIdentifier :: Parser Text

150−uncapitalizedIdentifier =

161+uncapitalizedIdentifier =

151162 lowerChar >>= identifierRemainder

152163

153164showRelationAttributes :: Attributes -> Text

@@ -156,12 +167,14 @@ showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ L.map showA

156167 showAttribute (Attribute name atomType) = name <> " " <> prettyAtomType atomType

157168 attrsL = V.toList attrs

158169

159−type PromptLength = Int

170+type PromptLength = Int

160171

161−#if MIN_VERSION_megaparsec(6,0,0)

172+#if MIN_VERSION_megaparsec(7,0,0)

173+type ParserError = ParseErrorBundle T.Text Void

174+#elif MIN_VERSION_megaparsec(6,0,0)

162175type ParserError = ParseError Char Void

163−#else

164−type ParserError = ParseError Char Dec

176+#else

177+type ParserError = ParseError Char Dec

165178#endif

166179

167180data TutorialDOperatorResult = QuitResult |

@@ -173,15 +186,15 @@ data TutorialDOperatorResult = QuitResult |

173186 DisplayParseErrorResult (Maybe PromptLength) ParserError | -- PromptLength refers to length of prompt text

174187 QuietSuccessResult

175188 deriving (Generic)

176−

189+

177190type TransactionGraphWasUpdated = Bool

178191

179192--allow for python-style triple quoting because guessing the correct amount of escapes in different contexts is annoying

180193tripleQuotedString :: Parser Text

181194tripleQuotedString = do

182195 _ <- tripleQuote

183− pack <$> manyTill anyChar (try (tripleQuote >> notFollowedBy quote))

184−

196+ pack <$> manyTill anySingle (try (tripleQuote >> notFollowedBy quote))

197+

185198normalQuotedString :: Parser Text

186199normalQuotedString = quote *> (T.pack <$> manyTill Lex.charLiteral quote)

187200

@@ -190,7 +203,7 @@ quotedString = try tripleQuotedString <|> normalQuotedString

190203

191204uuidP :: Parser U.UUID

192205uuidP = do

193− uuidStart <- count 8 hexDigitChar

206+ uuidStart <- count 8 hexDigitChar

194207 _ <- char '-' -- min 28 with no dashes, maximum 4 dashes

195208 uuidMid1 <- count 4 hexDigitChar

196209 _ <- char '-'

@@ -210,4 +223,3 @@ utcTimeP = do

210223 case parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack timeStr) of

211224 Nothing -> fail "invalid datetime input, use \"YYYY-MM-DD HH:MM:SS\""

212225 Just stamp -> pure stamp

213−

src/bin/TutorialD/Interpreter/RelationalExpr.hs+29−24

@@ -1,6 +1,12 @@

1+{-# LANGUAGE CPP #-}

13module TutorialD.Interpreter.RelationalExpr where

24import Text.Megaparsec

5+#if __GLASGOW_HASKELL__ >= 806

6+import Control.Monad.Combinators.Expr

7+#else

38import Text.Megaparsec.Expr

9+#endif

410import ProjectM36.Base

511import TutorialD.Interpreter.Base

612import TutorialD.Interpreter.Types

@@ -12,7 +18,7 @@ import ProjectM36.MiscUtils

1218

1319--used in projection

1420attributeListP :: RelationalMarkerExpr a => Parser (AttributeNamesBase a)

15−attributeListP =

21+attributeListP =

1622 (reservedOp "all but" >>

1723 InvertedAttributeNames . S.fromList <$> sepBy attributeNameP comma) <|>

1824 (reservedOp "all from" >>

@@ -26,7 +32,7 @@ makeRelationP = do

2632 tupleExprs <- braces (sepBy tupleExprP comma) <|> pure []

2733 pure $ MakeRelationFromExprs attrExprs tupleExprs

2834

29−

35+

3036--abstract data type parser- in this context, the type constructor must not include any type arguments

3137--Either Text Int

3238adTypeConstructorP :: Parser TypeConstructor

@@ -41,7 +47,7 @@ tupleExprP = do

4147 attrAssocs <- braces (sepBy tupleAtomExprP comma)

4248 --detect duplicate attribute names

4349 let dupAttrNames = dupes (sort (map fst attrAssocs))

44− if not (null dupAttrNames) then

50+ if not (null dupAttrNames) then

4551 fail ("Attribute names duplicated: " ++ show dupAttrNames)

4652 else

4753 pure (TupleExpr (M.fromList attrAssocs))

@@ -51,7 +57,7 @@ tupleAtomExprP = do

5157 attributeName <- attributeNameP

5258 atomExpr <- atomExprP

5359 pure (attributeName, atomExpr)

54−

60+

5561projectP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

5662projectP = Project <$> braces attributeListP

5763

@@ -68,7 +74,7 @@ renameP = do

6874 renameList <- braces (sepBy renameClauseP comma)

6975 case renameList of

7076 [] -> pure (Restrict TruePredicate) --no-op when rename list is empty

71− renames ->

77+ renames ->

7278 pure $ \expr -> foldl (\acc (oldAttr, newAttr) -> Rename oldAttr newAttr acc) expr renames

7379

7480whereClauseP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

@@ -97,20 +103,20 @@ extendP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalE

97103extendP = do

98104 reservedOp ":"

99105 Extend <$> braces extendTupleExpressionP

100−

106+

101107semijoinP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a)

102108semijoinP = do

103109 reservedOp "semijoin" <|> reservedOp "matching"

104− pure (\exprA exprB ->

110+ pure (\exprA exprB ->

105111 Project (RelationalExprAttributeNames exprA) (Join exprA exprB))

106−

107−antijoinP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a)

112+

113+antijoinP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a)

108114antijoinP = do

109115 reservedOp "not matching" <|> reservedOp "antijoin"

110116 pure (\exprA exprB ->

111117 Difference exprA (

112118 Project (RelationalExprAttributeNames exprA) (Join exprA exprB)))

113−

119+

114120relOperators :: RelationalMarkerExpr a => [[Operator Parser (RelationalExprBase a)]]

115121relOperators = [

116122 [Postfix projectP],

@@ -136,7 +142,7 @@ attributeNameP = uncapitalizedIdentifier

136142

137143relVarNameP :: Parser RelVarName

138144relVarNameP = uncapitalizedIdentifier

139−

145+

140146relVarP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

141147relVarP = RelationVariable <$> relVarNameP <*> parseMarkerP

142148

@@ -159,10 +165,10 @@ restrictionPredicateP = makeExprParser predicateTerm predicateOperators

159165 <|> relationalBooleanExprP

160166

161167relationalBooleanExprP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

162−relationalBooleanExprP =

168+relationalBooleanExprP =

163169 --we can't actually detect if the type is relational boolean, so we just pass it to the next phase

164170 RelationalExprPredicate <$> (parens relExprP <|> relTerm)

165−

171+

166172restrictionAttributeEqualityP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

167173restrictionAttributeEqualityP = do

168174 attributeName <- attributeNameP

@@ -210,16 +216,16 @@ constructedAtomExprP consume = do

210216 dConsName <- dataConstructorNameP

211217 dConsArgs <- if consume then sepBy (consumeAtomExprP False) spaceConsumer else pure []

212218 ConstructedAtomExpr dConsName dConsArgs <$> parseMarkerP

213−

219+

214220-- used only for primitive type parsing ?

215221atomP :: Parser Atom

216−atomP = stringAtomP <|>

217− doubleAtomP <|>

218− integerAtomP <|>

222+atomP = stringAtomP <|>

223+ doubleAtomP <|>

224+ integerAtomP <|>

219225 boolAtomP

220−

226+

221227functionAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

222−functionAtomExprP =

228+functionAtomExprP =

223229 FunctionAtomExpr <$> uncapitalizedIdentifier <*> parens (sepBy atomExprP comma) <*> parseMarkerP

224230

225231relationalAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

@@ -228,7 +234,7 @@ relationalAtomExprP = RelationAtomExpr <$> relExprP

228234stringAtomP :: Parser Atom

229235stringAtomP = TextAtom <$> quotedString

230236

231−doubleAtomP :: Parser Atom

237+doubleAtomP :: Parser Atom

232238doubleAtomP = DoubleAtom <$> try float

233239

234240integerAtomP :: Parser Atom

@@ -238,20 +244,19 @@ boolAtomP :: Parser Atom

238244boolAtomP = do

239245 val <- char 't' <|> char 'f'

240246 return $ BoolAtom (val == 't')

241−

247+

242248relationAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

243249relationAtomExprP = RelationAtomExpr <$> makeRelationP

244250

245251withMacroExprP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

246252withMacroExprP = do

247253 reservedOp "with"

248− views <- parens (sepBy1 createViewP comma)

254+ views <- parens (sepBy1 createViewP comma)

249255 With views <$> relExprP

250256

251257createViewP :: RelationalMarkerExpr a => Parser (RelVarName, RelationalExprBase a)

252−createViewP = do

258+createViewP = do

253259 name <- relVarNameP

254260 reservedOp "as"

255261 expr <- relExprP

256262 pure (name, expr)

257−

src/bin/benchmark/Handles.hs+23−14

@@ -14,7 +14,7 @@ import Control.Monad

1414data HandlesArgs = HandlesArgs {

1515 openCloseCount :: Int,

1616 transactionCount :: Int,

17− dbdir :: FilePath,

17+ dbdir :: FilePath,

1818 tutdSetup :: String,

1919 tutdIterate :: String

2020 }

@@ -40,13 +40,13 @@ parseTutdIterate = strOption (short 'i' <> long "iterate-tutd" <> value "update

4040main :: IO ()

4141main = do

4242 args <- execParser $ info (helper <*> parseArgs) fullDesc

43− replicateM_ (openCloseCount args) (runOpenClose

43+ replicateM_ (openCloseCount args) (runOpenClose

4444 (T.pack (tutdSetup args))

4545 (T.pack (tutdIterate args))

46− (transactionCount args)

46+ (transactionCount args)

4747 (dbdir args))

48−

49−runOpenClose :: T.Text -> T.Text -> Int -> FilePath -> IO ()

48+

49+runOpenClose :: T.Text -> T.Text -> Int -> FilePath -> IO ()

5050runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do

5151 let connInfo = InProcessConnectionInfo (MinimalPersistence dbdir') emptyNotificationCallback []

5252 eConn <- connectProjectM36 connInfo

@@ -56,7 +56,7 @@ runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do

5656 eSess <- createSessionAtHead conn "master"

5757 case eSess of

5858 Left err -> error (show err)

59− Right session ->

59+ Right session ->

6060 --database setup

6161 case parseTutorialD tutdSetup' of

6262 Left err -> error (show err)

@@ -64,14 +64,19 @@ runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do

6464 res <- evalTutorialD session conn UnsafeEvaluation parsed

6565 case res of

6666 DisplayErrorResult err -> error (T.unpack err)

67− DisplayParseErrorResult _ err -> error (parseErrorPretty err)

68− _ -> do

67+ DisplayParseErrorResult _ err ->

68+ #if __GLASGOW_HASKELL__ >= 806

69+ error (errorBundlePretty err)

70+ #else

71+ error (parseErrorPretty err)

72+ #endif

73+ _ -> do

6974 replicateM_ tCount (runTransaction tutdIterate' session conn)

7075 close conn

7176 printFdCount

72−

77+

7378runTransaction :: T.Text -> SessionId -> Connection -> IO ()

74−runTransaction tutdIterate' sess conn =

79+runTransaction tutdIterate' sess conn =

7580 --run tutd on every iteration

7681 case parseTutorialD tutdIterate' of

7782 Left err -> error (show err)

@@ -79,10 +84,14 @@ runTransaction tutdIterate' sess conn =

7984 res <- evalTutorialD sess conn UnsafeEvaluation parsed

8085 case res of

8186 DisplayErrorResult err -> error (T.unpack err)

82− DisplayParseErrorResult _ err -> error (parseErrorPretty err)

83− _ -> do

84− eErr <- commit sess conn

87+ DisplayParseErrorResult _ err ->

88+ #if __GLASGOW_HASKELL__ >= 806

89+ error (errorBundlePretty err)

90+ #else

91+ error (parseErrorPretty err)

92+ #endif

93+ _ -> do

94+ eErr <- commit sess conn

8595 case eErr of

8696 Left err -> error (show err)

8797 Right _ -> printFdCount

88−

src/lib/ProjectM36/ScriptSession.hs+35−28

@@ -1,4 +1,4 @@

1−{-# LANGUAGE MagicHash, UnboxedTuples #-}

1+{-# LANGUAGE MagicHash, UnboxedTuples, KindSignatures, DataKinds #-}

22module ProjectM36.ScriptSession where

44import ProjectM36.Error

@@ -33,7 +33,7 @@ import Unsafe.Coerce

3333#if __GLASGOW_HASKELL__ >= 802

3434import Type

3535#elif __GLASGOW_HASKELL__ >= 710

36−import Type hiding (pprTyThing)

36+import Type hiding (pprTyThing)

3737#else

3838#endif

3939

@@ -42,11 +42,11 @@ import GHC.Ptr (Ptr(..))

4242import Encoding

4343

4444data ScriptSession = ScriptSession {

45− hscEnv :: HscEnv,

45+ hscEnv :: HscEnv,

4646 atomFunctionBodyType :: Type,

4747 dbcFunctionBodyType :: Type

4848 }

49−

49+

5050newtype ScriptSessionError = ScriptSessionLoadError GhcException

5151 deriving (Show)

5252

@@ -70,18 +70,18 @@ initScriptSession ghcPkgPaths = do

7070 homeDir </> ".stack/snapshots/*/*/" ++ ghcVersion ++ "/pkgdb",

7171 homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"

7272 ]

73−

73+

7474 let localPkgPaths = map PkgConfFile (ghcPkgPaths ++ sandboxPkgPaths)

75−

76− let dflags' = applyGopts . applyXopts $ dflags { hscTarget = HscInterpreted ,

77− ghcLink = LinkInMemory,

75+

76+ let dflags' = applyGopts . applyXopts $ dflags { hscTarget = HscInterpreted ,

77+ ghcLink = LinkInMemory,

7878 safeHaskell = Sf_Trustworthy,

7979 safeInfer = True,

8080 safeInferred = True,

8181 --verbosity = 3,

82−#if __GLASGOW_HASKELL__ >= 800

82+#if __GLASGOW_HASKELL__ >= 800

8383 trustFlags = map TrustPackage required_packages,

84−#endif

84+#endif

8585 packageFlags = packageFlags dflags ++ packages,

8686#if __GLASGOW_HASKELL__ >= 802

8787 packageDBFlags = map PackageDB localPkgPaths

@@ -94,11 +94,11 @@ initScriptSession ghcPkgPaths = do

9494 applyXopts flags = foldl xopt_set flags xopts

9595#if __GLASGOW_HASKELL__ >= 800

9696 xopts = [OverloadedStrings, ExtendedDefaultRules, ImplicitPrelude, ScopedTypeVariables]

97−#else

97+#else

9898 xopts = [Opt_OverloadedStrings, Opt_ExtendedDefaultRules, Opt_ImplicitPrelude, Opt_ScopedTypeVariables]

9999#endif

100100 gopts = [] --[Opt_DistrustAllPackages, Opt_PackageTrust]

101− required_packages = ["base",

101+ required_packages = ["base",

102102 "containers",

103103 "Glob",

104104 "directory",

@@ -120,11 +120,15 @@ initScriptSession ghcPkgPaths = do

120120 --liftIO $ traceShowM (showSDoc dflags' (ppr packages))

121121 _ <- setSessionDynFlags dflags'

122122 let safeImportDecl mn mQual = ImportDecl {

123−#if __GLASGOW_HASKELL__ >= 802

123+#if __GLASGOW_HASKELL__ >= 802

124124 ideclSourceSrc = NoSourceText,

125125#else

126126 ideclSourceSrc = Nothing,

127127#endif

128+

129+#if __GLASGOW_HASKELL__ >= 806

130+ ideclExt = NoExt,

131+#endif

128132 ideclName = noLoc mn,

129133 ideclPkgQual = Nothing,

130134 ideclSource = False,

@@ -134,6 +138,9 @@ initScriptSession ghcPkgPaths = do

134138 ideclAs = mQual,

135139 ideclHiding = Nothing

136140 }

141+#if __GLASGOW_HASKELL__ >= 806

142+ :: ImportDecl (GhcPass (c :: Pass))

143+#endif

137144 unqualifiedModules = map (\modn -> IIDecl $ safeImportDecl (mkModuleName modn) Nothing) [

138145 "Prelude",

139146 "Data.Map",

@@ -150,7 +157,7 @@ initScriptSession ghcPkgPaths = do

150157 mkModName = noLoc . mkModuleName

151158#else

152159 mkModName = mkModuleName

153−#endif

160+#endif

154161 qualifiedModules = map (\(modn, qualNam) -> IIDecl $ safeImportDecl (mkModuleName modn) (Just (mkModName qualNam))) [

155162 ("Data.Text", "T")

156163 ]

@@ -164,7 +171,7 @@ addImport :: String -> Ghc ()

164171addImport moduleNam = do

165172 ctx <- getContext

166173 setContext ( (IIDecl $ simpleImportDecl (mkModuleName moduleNam)) : ctx )

167−

174+

168175showType :: DynFlags -> Type -> String

169176showType dflags ty = showSDocForUser dflags alwaysQualify (pprTypeForUser ty)

170177

@@ -189,33 +196,33 @@ compileScript funcType script = do

189196 mErr <- typeCheckScript funcType script

190197 case mErr of

191198 Just err -> pure (Left err)

192− Nothing ->

199+ Nothing ->

193200 --catch exception here

194201 --we could potentially wrap the script with Atom pattern matching so that the script doesn't have to do it, but the change to an Atom ADT should make it easier. Still, it would be nice if the script didn't have to handle a list of arguments, for example.

195202 -- we can't use dynCompileExpr here because

196203 Right . unsafeCoerce <$> compileExpr sScript

197−

198−typeCheckScript :: Type -> Text -> Ghc (Maybe ScriptCompilationError)

204+

205+typeCheckScript :: Type -> Text -> Ghc (Maybe ScriptCompilationError)

199206typeCheckScript expectedType inp = do

200− dflags <- getSessionDynFlags

207+ dflags <- getSessionDynFlags

201208 --catch exception for SyntaxError

202209#if __GLASGOW_HASKELL__ >= 802

203− funcType <- GHC.exprType TM_Inst (unpack inp)

204−#else

210+ funcType <- GHC.exprType TM_Inst (unpack inp)

211+#else

205212 funcType <- GHC.exprType (unpack inp)

206213#endif

207− --liftIO $ putStrLn $ showType dflags expectedType ++ ":::" ++ showType dflags funcType

214+ --liftIO $ putStrLn $ showType dflags expectedType ++ ":::" ++ showType dflags funcType

208215 if eqType funcType expectedType then

209216 pure Nothing

210217 else

211218 pure (Just (TypeCheckCompilationError (showType dflags expectedType) (showType dflags funcType)))

212−

219+

213220mangleSymbol :: Maybe String -> String -> String -> String

214221mangleSymbol pkg module' valsym =

215222 prefixUnderscore ++

216223 maybe "" (\p -> zEncodeString p ++ "_") pkg ++

217224 zEncodeString module' ++ "_" ++ zEncodeString valsym ++ "_closure"

218−

225+

219226type ModName = String

220227type FuncName = String

221228

@@ -223,7 +230,7 @@ data LoadSymbolError = LoadSymbolError

223230

224231loadFunction :: ModName -> FuncName -> FilePath -> IO (Either LoadSymbolError a)

225232loadFunction modName funcName objPath = do

226−#if __GLASGOW_HASKELL__ >= 802

233+#if __GLASGOW_HASKELL__ >= 802

227234 initObjLinker RetainCAFs

228235#else

229236 initObjLinker

@@ -235,8 +242,8 @@ loadFunction modName funcName objPath = do

235242 Nothing -> pure (Left LoadSymbolError)

236243 Just (Ptr addr) -> case addrToAny# addr of

237244 (# hval #) -> pure (Right hval)

238−

239−prefixUnderscore :: String

245+

246+prefixUnderscore :: String

240247prefixUnderscore =

241248 case (os,arch) of

242249 ("mingw32","x86_64") -> ""

@@ -244,4 +251,4 @@ prefixUnderscore =

244251 ("mingw32",_) -> "_"

245252 ("darwin",_) -> "_"

246253 ("cygwin",_) -> "_"

247− _ -> ""

254+ _ -> ""

src/lib/ProjectM36/Sessions.hs+1−3

@@ -7,7 +7,7 @@ import qualified StmContainers.Set as StmSet

77#else

88import qualified STMContainers.Map as StmMap

99import qualified STMContainers.Set as StmSet

10−#endif

10+#endif

1111import ProjectM36.Attribute

1212import ProjectM36.Base

1313import ProjectM36.Session

@@ -47,5 +47,3 @@ sessionsAsRelation sessions = do

4747 let atomMatrix = map (\(sessionId, session) -> [uuidAtom sessionId, uuidAtom (parentId session)]) sessionAssocs

4848 pure $ mkRelationFromList (attributesFromList [Attribute "sessionid" TextAtomType,

4949 Attribute "parentCommit" TextAtomType]) atomMatrix

50−

51−

stack.ghc8.4.yaml+1−2

@@ -24,7 +24,7 @@ extra-deps:

2424- network-transport-tcp-0.6.0

2525

2626# Override default flag values for local packages and extra-deps

27−flags:

27+flags:

2828 project-m36:

2929 stack: true

3030

@@ -50,4 +50,3 @@ extra-package-dbs: []

5050# compiler-check: newer-minor

5151

5252allow-newer: true

53−

stack.ghc8.6.yamlnew file+54

@@ -0,0 +1,54 @@

1+# This file was automatically generated by stack init

2+# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/

4+# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)

5+resolver: lts-14.3

7+# Local packages, usually specified by relative directory name

8+packages:

9+- '.'

10+# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)

11+extra-deps:

12+- git: https://github.com/Bodigrim/data-interval.git

13+ commit: 05269a15ee4db49ad956646206d6e817f259f135

14+- git: https://github.com/haskell-distributed/distributed-process.git

15+ commit: 660d554f6acd2dba8b605c84e8fa69e45708bc14

16+- extended-reals-0.2.3.0

17+- stm-containers-1.1.0.4

18+- distributed-static-0.3.9

19+- stm-hamt-1.2.0.4

20+- distributed-process-async-0.2.6

21+- distributed-process-client-server-0.2.5.1

22+- distributed-process-extras-0.3.5

23+- rset-1.0.0

24+- hashable-time-0.2.0.2

25+- network-transport-tcp-0.6.0

26+- megaparsec-7.0.5

27+

28+# Override default flag values for local packages and extra-deps

29+flags:

30+ project-m36:

31+ stack: true

32+

33+# Extra package databases containing global packages

34+extra-package-dbs: []

35+

36+# Control whether we use the GHC we find on the path

37+# system-ghc: true

38+

39+# Require a specific version of stack, using version ranges

40+# require-stack-version: -any # Default

41+# require-stack-version: >= 1.0.0

42+

43+# Override the architecture used by stack, especially useful on Windows

44+# arch: i386

45+# arch: x86_64

46+

47+# Extra directories used by stack for building

48+# extra-include-dirs: [/path/to/dir]

49+# extra-lib-dirs: [/path/to/dir]

50+

51+# Allow a newer minor version of GHC than the snapshot specifies

52+# compiler-check: newer-minor

53+

54+allow-newer: true

test/Relation/Export/CSV.hs+17−18

@@ -19,9 +19,9 @@ import ProjectM36.Relation.Show.Term

1919import qualified Data.ByteString.Lazy as BS

2020-}

2121

22−main :: IO ()

23−main = do

24− tcounts <- runTestTT $ TestList [testCSVExport,

22+main :: IO ()

23+main = do

24+ tcounts <- runTestTT $ TestList [testCSVExport,

2525 testADTExport]

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

2727

@@ -31,8 +31,8 @@ assertEither x = do

3131 case res of

3232 Left err -> assertFailure (show err) >> undefined

3333 Right val -> pure val

34−

35−testADTExport :: Test

34+

35+testADTExport :: Test

3636testADTExport = TestCase $ do

3737 let adtCSV = "a\nCons 4 (Cons 5 Empty)\n"

3838 attrs = A.attributesFromList [Attribute "a" (listAtomType IntegerAtomType)]

@@ -40,17 +40,17 @@ testADTExport = TestCase $ do

4040 case csvAsRelation attrs basicTypeConstructorMapping adtCSV of

4141 Left err -> assertFailure ("import failure: " <> show err)

4242 Right rel -> assertEqual "import cons list" expectedRel (Right rel)

43−

43+

4444--round-trip various atom types through CSV export/import

4545testCSVExport :: Test

4646testCSVExport = TestCase $ do

4747 now <- getCurrentTime

48− testInterval <- assertEither $ pure (createInterval

49− (DateTimeAtom now)

48+ testInterval <- assertEither $ pure (createInterval

49+ (DateTimeAtom now)

5050 (DateTimeAtom (addUTCTime 86400 now))

5151 True

5252 False)

53− let attrs = A.attributesFromList [Attribute "textattr" TextAtomType,

53+ let attrs = A.attributesFromList [Attribute "textattr" TextAtomType,

5454 Attribute "integerattr" IntegerAtomType,

5555 Attribute "dayattr" DayAtomType,

5656 Attribute "datetimeattr" DateTimeAtomType,

@@ -61,8 +61,8 @@ testCSVExport = TestCase $ do

6161 ]

6262 sampleByteString = "\1\0\244\34\150"

6363 relOrErr = mkRelationFromList attrs [

64− [TextAtom "text atom with \"quote\"",

65− IntegerAtom 123,

64+ [TextAtom "text atom with \"quote\"",

65+ IntegerAtom 123,

6666 DayAtom (fromGregorian 2017 4 10),

6767 DateTimeAtom now,

6868 ByteStringAtom sampleByteString,

@@ -70,19 +70,19 @@ testCSVExport = TestCase $ do

7070 listCons TextAtomType [TextAtom "text1", TextAtom "text2"],

7171 testInterval

7272 ],

73− [TextAtom "second text atom with 漢字",

74− IntegerAtom 314,

73+ [TextAtom "second text atom with 漢字",

74+ IntegerAtom 314,

7575 DayAtom (fromGregorian 1001 6 28),

7676 DateTimeAtom (addUTCTime 360 now),

77− ByteStringAtom sampleByteString,

77+ ByteStringAtom sampleByteString,

7878 listCons IntegerAtomType [IntegerAtom 10, IntegerAtom 11, IntegerAtom 12],

7979 listCons TextAtomType [TextAtom "text5\"", TextAtom "text6\r\n"],

8080 testInterval

8181 ]]

82−

83− case relOrErr of

82+

83+ case relOrErr of

8484 Left err -> assertFailure $ "export relation creation failure: " ++ show err

85− Right rel ->

85+ Right rel ->

8686 case relationAsCSV rel of

8787 Left err -> assertFailure $ "export failed: " ++ show err

8888 Right csvData ->

@@ -91,4 +91,3 @@ testCSVExport = TestCase $ do

9191 case csvAsRelation attrs basicTypeConstructorMapping csvData of -- import csv data back to relation

9292 Left err -> assertFailure $ "re-import failed: " ++ show err

9393 Right rel' -> assertEqual "relation CSV comparison" rel rel'

94−