c8968b5 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

Added support for GHC 8.6

c8968b5iko7 years ago

.travis.yml+6−3

compare with master

unifiedsplit

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

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

28 compiler: ": #stack 8.4.3"

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

31+ compiler: ": #stack 8.6.5"

32+

30before_script:

33before_script:

31 - unset CC

34 - unset CC

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

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

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

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

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

44 - |

47 - |

45 #Run HLint

48 #Run HLint

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

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

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

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

48 fi

51 fi

49 - |

52 - |

50 #Run Haddock

53 #Run Haddock

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

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

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

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

53 fi

56 fi

55after_success:

58after_success:

project-m36.cabal+21−18

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

31Library

32 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

33 Exposed-Modules: ProjectM36.Error,

35 Exposed-Modules: ProjectM36.Error,

34 ProjectM36.Transaction,

36 ProjectM36.Transaction,

35 ProjectM36.TransactionGraph,

37 ProjectM36.TransactionGraph,

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

112 GHC-Options: -rdynamic

114 GHC-Options: -rdynamic

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

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

114 Build-Depends: unix

116 Build-Depends: unix

115− CC-Options: -fPIC

117+ CC-Options: -fPIC

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

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

117 Default-Language: Haskell2010

119 Default-Language: Haskell2010

118 Default-Extensions: OverloadedStrings, CPP

120 Default-Extensions: OverloadedStrings, CPP

119 if impl(ghc>= 8)

121 if impl(ghc>= 8)

120 build-depends:

122 build-depends:

121 ghc-boot, ghci

123 ghc-boot, ghci

122− if !flag(stack)

124+ if !flag(stack)

123 Build-Depends: deferred-folds

125 Build-Depends: deferred-folds

124

126

125Executable tutd

127Executable tutd

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

159 optparse-applicative,

161 optparse-applicative,

160 attoparsec,

162 attoparsec,

161 stm-containers >= 1.0.0,

163 stm-containers >= 1.0.0,

162− list-t

164+ list-t,

165+ parser-combinators

163 Other-Modules: TutorialD.Interpreter,

166 Other-Modules: TutorialD.Interpreter,

164 TutorialD.Interpreter.Base,

167 TutorialD.Interpreter.Base,

165 TutorialD.Interpreter.DatabaseContextExpr,

168 TutorialD.Interpreter.DatabaseContextExpr,

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

217 list-t,

220 list-t,

218 base64-bytestring

221 base64-bytestring

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

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

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

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

221 if flag(profiler)

224 if flag(profiler)

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

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

223 Default-Language: Haskell2010

226 Default-Language: Haskell2010

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

226Executable bigrel

229Executable bigrel

227 Default-Language: Haskell2010

230 Default-Language: Haskell2010

228 Default-Extensions: OverloadedStrings

231 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

230 Other-Modules: TutorialD.Interpreter.Base,

233 Other-Modules: TutorialD.Interpreter.Base,

231 TutorialD.Interpreter.DatabaseContextExpr,

234 TutorialD.Interpreter.DatabaseContextExpr,

232 TutorialD.Interpreter.RelationalExpr,

235 TutorialD.Interpreter.RelationalExpr,

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

253 Default-Extensions: OverloadedStrings

256 Default-Extensions: OverloadedStrings

254 type: exitcode-stdio-1.0

257 type: exitcode-stdio-1.0

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

258 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

257 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

260 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

258 GHC-Options: -Wall -threaded

261 GHC-Options: -Wall -threaded

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

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

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

264 type: exitcode-stdio-1.0

267 type: exitcode-stdio-1.0

265 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

268 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

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

269 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

268 GHC-Options: -Wall -threaded

271 GHC-Options: -Wall -threaded

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

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

270

273

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

274 type: exitcode-stdio-1.0

277 type: exitcode-stdio-1.0

275 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

278 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

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

279 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

278 GHC-Options: -Wall -threaded

281 GHC-Options: -Wall -threaded

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

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

280

283

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

299 Default-Extensions: OverloadedStrings

302 Default-Extensions: OverloadedStrings

300 type: exitcode-stdio-1.0

303 type: exitcode-stdio-1.0

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

304 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

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

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

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

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

305 GHC-Options: -Wall -threaded

308 GHC-Options: -Wall -threaded

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

317 Default-Extensions: OverloadedStrings

320 Default-Extensions: OverloadedStrings

318 type: exitcode-stdio-1.0

321 type: exitcode-stdio-1.0

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

322 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

321 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

324 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

322 GHC-Options: -Wall -threaded

325 GHC-Options: -Wall -threaded

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

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

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

397 Default-Extensions: OverloadedStrings

400 Default-Extensions: OverloadedStrings

398 type: exitcode-stdio-1.0

401 type: exitcode-stdio-1.0

399 main-is: test/scripts.hs

402 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

401 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

404 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

402 GHC-Options: -Wall -threaded

405 GHC-Options: -Wall -threaded

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

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

404

407

405Executable project-m36-websocket-server

408Executable project-m36-websocket-server

406 Default-Language: Haskell2010

409 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

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

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

409 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

412 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

410 GHC-Options: -Wall -threaded

413 GHC-Options: -Wall -threaded

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

415 Default-Language: Haskell2010

418 Default-Language: Haskell2010

416 type: exitcode-stdio-1.0

419 type: exitcode-stdio-1.0

417 main-is: test/Server/WebSocket.hs

420 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

419 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

422 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

420 Default-Extensions: OverloadedStrings

423 Default-Extensions: OverloadedStrings

421 GHC-Options: -Wall -threaded

424 GHC-Options: -Wall -threaded

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

434 Default-Language: Haskell2010

437 Default-Language: Haskell2010

435 type: exitcode-stdio-1.0

438 type: exitcode-stdio-1.0

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

439 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

438 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

441 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

439 Default-Extensions: OverloadedStrings

442 Default-Extensions: OverloadedStrings

440 GHC-Options: -Wall -threaded

443 GHC-Options: -Wall -threaded

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

453 Default-Language: Haskell2010

456 Default-Language: Haskell2010

454 type: exitcode-stdio-1.0

457 type: exitcode-stdio-1.0

455 main-is: test/TransactionGraph/Automerge.hs

458 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

457 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

460 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

458 Default-Extensions: OverloadedStrings

461 Default-Extensions: OverloadedStrings

459 GHC-Options: -Wall -threaded

462 GHC-Options: -Wall -threaded

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

481Executable handles

484Executable handles

482 Default-Language: Haskell2010

485 Default-Language: Haskell2010

483 Default-Extensions: OverloadedStrings

486 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

485 main-is: benchmark/Handles.hs

488 main-is: benchmark/Handles.hs

486 Other-Modules: TutorialD.Interpreter,

489 Other-Modules: TutorialD.Interpreter,

487 TutorialD.Interpreter.Base,

490 TutorialD.Interpreter.Base,

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

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

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

505 if flag(profiler)

508 if flag(profiler)

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

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

507−

510+

508Test-Suite test-dataframe

511Test-Suite test-dataframe

509 Default-Language: Haskell2010

512 Default-Language: Haskell2010

510 Main-Is: test/DataFrame.hs

513 Main-Is: test/DataFrame.hs

511 type: exitcode-stdio-1.0

514 type: exitcode-stdio-1.0

512 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

515 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

514 Default-Extensions: OverloadedStrings

517 Default-Extensions: OverloadedStrings

515 GHC-Options: -Wall -threaded

518 GHC-Options: -Wall -threaded

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

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

2module ProjectM36.Server.WebSocket where

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

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

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

23import Text.Megaparsec.Error

24import Data.Functor

26+#if __GLASGOW_HASKELL__ >= 806

27+import Data.List.NonEmpty as NE

28+#endif

29+

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

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

27−websocketProxyServer port host pending = do

31+websocketProxyServer port host pending = do

28 conn <- WS.acceptRequest pending

32 conn <- WS.acceptRequest pending

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

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

30 --phase 1- accept database name for connection

34 --phase 1- accept database name for connection

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

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

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

34 else do

38 else do

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

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

36− bracket (createConnection conn dbname port host)

40+ bracket (createConnection conn dbname port host)

37 (\case

41 (\case

38 Right dbconn -> close dbconn

42 Right dbconn -> close dbconn

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

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

40 Left err -> sendError conn err

44 Left err -> sendError conn err

41 Right dbconn -> do

45 Right dbconn -> do

42 eSessionId <- createSessionAtHead dbconn "master"

46 eSessionId <- createSessionAtHead dbconn "master"

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

47 _ <- forever $ do

51 _ <- forever $ do

48 pInfo <- promptInfo sessionId dbconn

52 pInfo <- promptInfo sessionId dbconn

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

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

50− sendPromptInfo pInfo conn

54+ sendPromptInfo pInfo conn

51 sendPromptInfo pInfo conn

55 sendPromptInfo pInfo conn

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

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

53 case parseOnly parseExecuteMessage msg of

57 case parseOnly parseExecuteMessage msg of

54 Left _ -> unexpectedMsg

58 Left _ -> unexpectedMsg

55 Right (presentation, tutdString) ->

59 Right (presentation, tutdString) ->

56 case parseTutorialD tutdString of

60 case parseTutorialD tutdString of

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

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

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

68+ #endif

58 Right parsed -> do

69 Right parsed -> do

59− let timeoutFilter exc = if exc == RequestTimeoutException

70+ let timeoutFilter exc = if exc == RequestTimeoutException

60− then Just exc

71+ then Just exc

61 else Nothing

72 else Nothing

62 responseHandler = do

73 responseHandler = do

63 result <- evalTutorialD sessionId dbconn SafeEvaluation parsed

74 result <- evalTutorialD sessionId dbconn SafeEvaluation parsed

64 pInfo' <- promptInfo sessionId dbconn

75 pInfo' <- promptInfo sessionId dbconn

65− sendPromptInfo pInfo' conn

76+ sendPromptInfo pInfo' conn

66 handleOpResult conn dbconn presentation result

77 handleOpResult conn dbconn presentation result

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

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

68 pure ()

79 pure ()

69−

80+

70−notificationCallback :: WS.Connection -> NotificationCallback

81+notificationCallback :: WS.Connection -> NotificationCallback

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

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

72 "evaldnotification" .= evaldNotif

83 "evaldnotification" .= evaldNotif

73 ]))

84 ]))

74−

85+

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

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

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

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

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

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

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

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

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

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

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

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

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

103−

114+

104-- get current schema and head name for client

115-- get current schema and head name for client

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

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

106promptInfo sessionId conn = do

117promptInfo sessionId conn = do

107− eHeadName <- headName sessionId conn

118+ eHeadName <- headName sessionId conn

108 eSchemaName <- currentSchemaName sessionId conn

119 eSchemaName <- currentSchemaName sessionId conn

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

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

110−

121+

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

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

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

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

113

124

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

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

115data Presentation = Presentation {

126data Presentation = Presentation {

116− jsonPresentation :: Bool,

127+ jsonPresentation :: Bool,

117 textPresentation :: Bool,

128 textPresentation :: Bool,

118 htmlPresentation :: Bool }

129 htmlPresentation :: Bool }

119−

130+

120data PresentationFlag = JSONFlag | TextFlag | HTMLFlag

131data PresentationFlag = JSONFlag | TextFlag | HTMLFlag

121−

132+

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

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

123parseExecuteMessage = do

134parseExecuteMessage = do

124 _ <- string "executetutd/"

135 _ <- string "executetutd/"

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

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

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

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

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

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

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

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

129 JSONFlag -> acc {jsonPresentation = True}

140 JSONFlag -> acc {jsonPresentation = True}

130 TextFlag -> acc {textPresentation = True}

141 TextFlag -> acc {textPresentation = True}

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

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

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

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

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

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

63 fmap DatabaseContextIOExprOp (dbContextIOExprP <* eof)

64−

64+

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

66safeInterpreterParserP :: Parser ParsedOperation

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

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

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

79 where

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

81−

81+

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

83parseTutorialD = parse interpreterParserP ""

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

106 else

107 pure res

108 _ -> pure res

109−

109+

110− (DatabaseContextExprOp execOp) ->

110+ (DatabaseContextExprOp execOp) ->

111− eHandler $ C.executeDatabaseContextExpr sessionId conn execOp

111+ eHandler $ C.executeDatabaseContextExpr sessionId conn execOp

112−

112+

113− (DatabaseContextIOExprOp execOp) ->

113+ (DatabaseContextIOExprOp execOp) ->

114 if needsSafe then

115 unsafeError

116 else

117 eHandler $ C.executeDatabaseContextIOExpr sessionId conn execOp

118−

118+

119 (GraphOp execOp) -> do

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

121 eIsDirty <- C.disconnectedTransactionIsDirty sessionId conn

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

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

123 settings = Settings {complete = noCompletion,

124 historyFile = Nothing,

125 autoAddHistory = False}

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

143 pure (DisplayErrorResult "Graph operation cancelled.")

144 else

145 runGraphOp

146−

146+

147 (ConvenienceGraphOp execOp) ->

148 eHandler $ evalConvenienceGraphOp sessionId conn execOp

149

150 (ROGraphOp execOp) -> do

151 opResult <- evalROGraphOp sessionId conn execOp

152− case opResult of

152+ case opResult of

153 Left err -> barf err

154 Right rel -> pure (DisplayRelationResult rel)

155−

155+

156 (SchemaOp execOp) ->

157 eHandler $ evalSchemaOperator sessionId conn execOp

158−

158+

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

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

160 if needsSafe then

161 unsafeError

162 else do

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

174 case exprErr of

175 Left err -> barf err

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

177−

177+

178− (ImportDBContextOp execOp) ->

178+ (ImportDBContextOp execOp) ->

179 if needsSafe then

180 unsafeError

181 else do

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

183 case eErr of

184 Left err -> barf err

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

186−

186+

187− (InfoOp execOp) ->

187+ (InfoOp execOp) ->

188 if needsSafe then

189 unsafeError

190 else

191 case evalInformationOperator execOp of

192 Left err -> pure (DisplayErrorResult err)

193 Right info -> pure (DisplayResult info)

194−

194+

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

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

197 if needsSafe then

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

221 case eErr of

222 Left err -> barf err

223 Right () -> return QuietSuccessResult

224−

224+

225−type GhcPkgPath = String

225+type GhcPkgPath = String

226type TutorialDExec = String

227type CheckFS = Bool

228−

228+

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

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

231

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

256 Just line -> do

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

258 reprLoop config sessionId conn

259−

259+

260

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

262−runTutorialD sessionId conn mPromptLength tutd =

262+runTutorialD sessionId conn mPromptLength tutd =

263 case parseTutorialD tutd of

264− Left err ->

264+ Left err ->

265 displayOpResult $ DisplayParseErrorResult mPromptLength err

266 Right parsed ->

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

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

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

1{-# LANGUAGE DeriveGeneric, CPP #-}

2module TutorialD.Interpreter.Base (

3− module TutorialD.Interpreter.Base,

3+ module TutorialD.Interpreter.Base,

4 module Text.Megaparsec,

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

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

6 module Text.Megaparsec.Char,

7 module Control.Applicative

8#else

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

45import Data.Time.Format

46import Control.Monad (void)

48+#if __GLASGOW_HASKELL__ < 806

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

50+anySingle = anyChar

51+#endif

52+

48displayOpResult :: TutorialDOperatorResult -> IO ()

53displayOpResult :: TutorialDOperatorResult -> IO ()

49displayOpResult QuitResult = return ()

54displayOpResult QuitResult = return ()

50displayOpResult (DisplayResult out) = TIO.putStrLn out

55displayOpResult (DisplayResult out) = TIO.putStrLn out

51displayOpResult (DisplayIOResult ioout) = ioout

56displayOpResult (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

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

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

54displayOpResult QuietSuccessResult = return ()

59displayOpResult QuietSuccessResult = return ()

55displayOpResult (DisplayRelationResult rel) = do

60displayOpResult (DisplayRelationResult rel) = do

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

57 let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen

62 let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen

58 TIO.putStrLn (showRelation randomlySortedRel)

63 TIO.putStrLn (showRelation randomlySortedRel)

59displayOpResult (DisplayParseErrorResult mPromptLength err) = do

64displayOpResult (DisplayParseErrorResult mPromptLength err) = do

65+ let

66+ #if __GLASGOW_HASKELL__ >= 806

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

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

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

69+ #else

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

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

71+ errString = T.pack (parseErrorPretty err)

72+ #endif

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

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

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

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

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

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

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

74spaceConsumer :: Parser ()

85spaceConsumer :: Parser ()

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

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

76−

87+

77opChar :: Parser Char

88opChar :: Parser Char

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

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

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

143float = Lex.float

154float = Lex.float

144

155

145capitalizedIdentifier :: Parser Text

156capitalizedIdentifier :: Parser Text

146−capitalizedIdentifier =

157+capitalizedIdentifier =

147 upperChar >>= identifierRemainder

158 upperChar >>= identifierRemainder

148−

159+

149uncapitalizedIdentifier :: Parser Text

160uncapitalizedIdentifier :: Parser Text

150−uncapitalizedIdentifier =

161+uncapitalizedIdentifier =

151 lowerChar >>= identifierRemainder

162 lowerChar >>= identifierRemainder

152

163

153showRelationAttributes :: Attributes -> Text

164showRelationAttributes :: Attributes -> Text

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

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

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

157 attrsL = V.toList attrs

168 attrsL = V.toList attrs

158

169

159−type PromptLength = Int

170+type PromptLength = Int

160

171

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)

162type ParserError = ParseError Char Void

175type ParserError = ParseError Char Void

163−#else

176+#else

164−type ParserError = ParseError Char Dec

177+type ParserError = ParseError Char Dec

165#endif

178#endif

166

179

167data TutorialDOperatorResult = QuitResult |

180data TutorialDOperatorResult = QuitResult |

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

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

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

174 QuietSuccessResult

187 QuietSuccessResult

175 deriving (Generic)

188 deriving (Generic)

176−

189+

177type TransactionGraphWasUpdated = Bool

190type TransactionGraphWasUpdated = Bool

178

191

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

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

180tripleQuotedString :: Parser Text

193tripleQuotedString :: Parser Text

181tripleQuotedString = do

194tripleQuotedString = do

182 _ <- tripleQuote

195 _ <- tripleQuote

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

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

184−

197+

185normalQuotedString :: Parser Text

198normalQuotedString :: Parser Text

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

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

187

200

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

190

203

191uuidP :: Parser U.UUID

204uuidP :: Parser U.UUID

192uuidP = do

205uuidP = do

193− uuidStart <- count 8 hexDigitChar

206+ uuidStart <- count 8 hexDigitChar

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

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

195 uuidMid1 <- count 4 hexDigitChar

208 uuidMid1 <- count 4 hexDigitChar

196 _ <- char '-'

209 _ <- char '-'

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

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

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

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

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

212 Just stamp -> pure stamp

225 Just stamp -> pure stamp

213−

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

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

1+{-# LANGUAGE CPP #-}

1module TutorialD.Interpreter.RelationalExpr where

3module TutorialD.Interpreter.RelationalExpr where

2import Text.Megaparsec

4import Text.Megaparsec

5+#if __GLASGOW_HASKELL__ >= 806

6+import Control.Monad.Combinators.Expr

7+#else

3import Text.Megaparsec.Expr

8import Text.Megaparsec.Expr

9+#endif

4import ProjectM36.Base

10import ProjectM36.Base

5import TutorialD.Interpreter.Base

11import TutorialD.Interpreter.Base

6import TutorialD.Interpreter.Types

12import TutorialD.Interpreter.Types

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

13--used in projection

19--used in projection

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

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

15−attributeListP =

21+attributeListP =

16 (reservedOp "all but" >>

22 (reservedOp "all but" >>

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

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

18 (reservedOp "all from" >>

24 (reservedOp "all from" >>

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

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

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

27 pure $ MakeRelationFromExprs attrExprs tupleExprs

33 pure $ MakeRelationFromExprs attrExprs tupleExprs

29−

35+

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

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

31--Either Text Int

37--Either Text Int

32adTypeConstructorP :: Parser TypeConstructor

38adTypeConstructorP :: Parser TypeConstructor

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

41 attrAssocs <- braces (sepBy tupleAtomExprP comma)

47 attrAssocs <- braces (sepBy tupleAtomExprP comma)

42 --detect duplicate attribute names

48 --detect duplicate attribute names

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

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

44− if not (null dupAttrNames) then

50+ if not (null dupAttrNames) then

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

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

46 else

52 else

47 pure (TupleExpr (M.fromList attrAssocs))

53 pure (TupleExpr (M.fromList attrAssocs))

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

51 attributeName <- attributeNameP

57 attributeName <- attributeNameP

52 atomExpr <- atomExprP

58 atomExpr <- atomExprP

53 pure (attributeName, atomExpr)

59 pure (attributeName, atomExpr)

54−

60+

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

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

56projectP = Project <$> braces attributeListP

62projectP = Project <$> braces attributeListP

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

68 renameList <- braces (sepBy renameClauseP comma)

74 renameList <- braces (sepBy renameClauseP comma)

69 case renameList of

75 case renameList of

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

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

71− renames ->

77+ renames ->

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

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

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

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

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

97extendP = do

103extendP = do

98 reservedOp ":"

104 reservedOp ":"

99 Extend <$> braces extendTupleExpressionP

105 Extend <$> braces extendTupleExpressionP

100−

106+

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

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

102semijoinP = do

108semijoinP = do

103 reservedOp "semijoin" <|> reservedOp "matching"

109 reservedOp "semijoin" <|> reservedOp "matching"

104− pure (\exprA exprB ->

110+ pure (\exprA exprB ->

105 Project (RelationalExprAttributeNames exprA) (Join exprA exprB))

111 Project (RelationalExprAttributeNames exprA) (Join exprA exprB))

106−

112+

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

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

108antijoinP = do

114antijoinP = do

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

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

110 pure (\exprA exprB ->

116 pure (\exprA exprB ->

111 Difference exprA (

117 Difference exprA (

112 Project (RelationalExprAttributeNames exprA) (Join exprA exprB)))

118 Project (RelationalExprAttributeNames exprA) (Join exprA exprB)))

113−

119+

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

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

115relOperators = [

121relOperators = [

116 [Postfix projectP],

122 [Postfix projectP],

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

136

142

137relVarNameP :: Parser RelVarName

143relVarNameP :: Parser RelVarName

138relVarNameP = uncapitalizedIdentifier

144relVarNameP = uncapitalizedIdentifier

139−

145+

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

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

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

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

142

148

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

159 <|> relationalBooleanExprP

165 <|> relationalBooleanExprP

160

166

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

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

162−relationalBooleanExprP =

168+relationalBooleanExprP =

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

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

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

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

165−

171+

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

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

167restrictionAttributeEqualityP = do

173restrictionAttributeEqualityP = do

168 attributeName <- attributeNameP

174 attributeName <- attributeNameP

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

210 dConsName <- dataConstructorNameP

216 dConsName <- dataConstructorNameP

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

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

212 ConstructedAtomExpr dConsName dConsArgs <$> parseMarkerP

218 ConstructedAtomExpr dConsName dConsArgs <$> parseMarkerP

213−

219+

214-- used only for primitive type parsing ?

220-- used only for primitive type parsing ?

215atomP :: Parser Atom

221atomP :: Parser Atom

216−atomP = stringAtomP <|>

222+atomP = stringAtomP <|>

217− doubleAtomP <|>

223+ doubleAtomP <|>

218− integerAtomP <|>

224+ integerAtomP <|>

219 boolAtomP

225 boolAtomP

220−

226+

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

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

222−functionAtomExprP =

228+functionAtomExprP =

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

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

224

230

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

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

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

228stringAtomP :: Parser Atom

234stringAtomP :: Parser Atom

229stringAtomP = TextAtom <$> quotedString

235stringAtomP = TextAtom <$> quotedString

230

236

231−doubleAtomP :: Parser Atom

237+doubleAtomP :: Parser Atom

232doubleAtomP = DoubleAtom <$> try float

238doubleAtomP = DoubleAtom <$> try float

233

239

234integerAtomP :: Parser Atom

240integerAtomP :: Parser Atom

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

238boolAtomP = do

244boolAtomP = do

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

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

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

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

241−

247+

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

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

243relationAtomExprP = RelationAtomExpr <$> makeRelationP

249relationAtomExprP = RelationAtomExpr <$> makeRelationP

244

250

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

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

246withMacroExprP = do

252withMacroExprP = do

247 reservedOp "with"

253 reservedOp "with"

248− views <- parens (sepBy1 createViewP comma)

254+ views <- parens (sepBy1 createViewP comma)

249 With views <$> relExprP

255 With views <$> relExprP

250

256

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

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

252−createViewP = do

258+createViewP = do

253 name <- relVarNameP

259 name <- relVarNameP

254 reservedOp "as"

260 reservedOp "as"

255 expr <- relExprP

261 expr <- relExprP

256 pure (name, expr)

262 pure (name, expr)

257−

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

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

14data HandlesArgs = HandlesArgs {

15 openCloseCount :: Int,

16 transactionCount :: Int,

17− dbdir :: FilePath,

17+ dbdir :: FilePath,

18 tutdSetup :: String,

19 tutdIterate :: String

20 }

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

40main :: IO ()

41main = do

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

43− replicateM_ (openCloseCount args) (runOpenClose

43+ replicateM_ (openCloseCount args) (runOpenClose

44 (T.pack (tutdSetup args))

45 (T.pack (tutdIterate args))

46− (transactionCount args)

46+ (transactionCount args)

47 (dbdir args))

48−

48+

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

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

50runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do

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

52 eConn <- connectProjectM36 connInfo

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

56 eSess <- createSessionAtHead conn "master"

57 case eSess of

58 Left err -> error (show err)

59− Right session ->

59+ Right session ->

60 --database setup

61 case parseTutorialD tutdSetup' of

62 Left err -> error (show err)

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

64 res <- evalTutorialD session conn UnsafeEvaluation parsed

65 case res of

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

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

67+ DisplayParseErrorResult _ err ->

68+ #if __GLASGOW_HASKELL__ >= 806

69+ error (errorBundlePretty err)

70+ #else

71+ error (parseErrorPretty err)

72+ #endif

68− _ -> do

73+ _ -> do

69 replicateM_ tCount (runTransaction tutdIterate' session conn)

74 replicateM_ tCount (runTransaction tutdIterate' session conn)

70 close conn

75 close conn

71 printFdCount

76 printFdCount

72−

77+

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

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

74−runTransaction tutdIterate' sess conn =

79+runTransaction tutdIterate' sess conn =

75 --run tutd on every iteration

80 --run tutd on every iteration

76 case parseTutorialD tutdIterate' of

81 case parseTutorialD tutdIterate' of

77 Left err -> error (show err)

82 Left err -> error (show err)

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

79 res <- evalTutorialD sess conn UnsafeEvaluation parsed

84 res <- evalTutorialD sess conn UnsafeEvaluation parsed

80 case res of

85 case res of

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

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

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

87+ DisplayParseErrorResult _ err ->

88+ #if __GLASGOW_HASKELL__ >= 806

89+ error (errorBundlePretty err)

90+ #else

91+ error (parseErrorPretty err)

92+ #endif

83− _ -> do

93+ _ -> do

84− eErr <- commit sess conn

94+ eErr <- commit sess conn

85 case eErr of

95 case eErr of

86 Left err -> error (show err)

96 Left err -> error (show err)

87 Right _ -> printFdCount

97 Right _ -> printFdCount

88−

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

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

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

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

2module ProjectM36.ScriptSession where

4import ProjectM36.Error

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

33#if __GLASGOW_HASKELL__ >= 802

34import Type

35#elif __GLASGOW_HASKELL__ >= 710

36−import Type hiding (pprTyThing)

36+import Type hiding (pprTyThing)

37#else

38#endif

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

42import Encoding

44data ScriptSession = ScriptSession {

45− hscEnv :: HscEnv,

45+ hscEnv :: HscEnv,

46 atomFunctionBodyType :: Type,

47 dbcFunctionBodyType :: Type

48 }

49−

49+

50newtype ScriptSessionError = ScriptSessionLoadError GhcException

51 deriving (Show)

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

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

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

72 ]

73−

73+

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

75−

75+

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

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

77− ghcLink = LinkInMemory,

77+ ghcLink = LinkInMemory,

78 safeHaskell = Sf_Trustworthy,

79 safeInfer = True,

80 safeInferred = True,

81 --verbosity = 3,

82−#if __GLASGOW_HASKELL__ >= 800

82+#if __GLASGOW_HASKELL__ >= 800

83 trustFlags = map TrustPackage required_packages,

84−#endif

84+#endif

85 packageFlags = packageFlags dflags ++ packages,

86#if __GLASGOW_HASKELL__ >= 802

87 packageDBFlags = map PackageDB localPkgPaths

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

94 applyXopts flags = foldl xopt_set flags xopts

95#if __GLASGOW_HASKELL__ >= 800

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

97−#else

97+#else

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

99#endif

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

101− required_packages = ["base",

101+ required_packages = ["base",

102 "containers",

103 "Glob",

104 "directory",

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

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

121 _ <- setSessionDynFlags dflags'

122 let safeImportDecl mn mQual = ImportDecl {

123−#if __GLASGOW_HASKELL__ >= 802

123+#if __GLASGOW_HASKELL__ >= 802

124 ideclSourceSrc = NoSourceText,

125#else

126 ideclSourceSrc = Nothing,

127#endif

128+

129+#if __GLASGOW_HASKELL__ >= 806

130+ ideclExt = NoExt,

131+#endif

128 ideclName = noLoc mn,

132 ideclName = noLoc mn,

129 ideclPkgQual = Nothing,

133 ideclPkgQual = Nothing,

130 ideclSource = False,

134 ideclSource = False,

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

134 ideclAs = mQual,

138 ideclAs = mQual,

135 ideclHiding = Nothing

139 ideclHiding = Nothing

136 }

140 }

141+#if __GLASGOW_HASKELL__ >= 806

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

143+#endif

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

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

138 "Prelude",

145 "Prelude",

139 "Data.Map",

146 "Data.Map",

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

150 mkModName = noLoc . mkModuleName

157 mkModName = noLoc . mkModuleName

151#else

158#else

152 mkModName = mkModuleName

159 mkModName = mkModuleName

153−#endif

160+#endif

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

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

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

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

156 ]

163 ]

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

164addImport moduleNam = do

171addImport moduleNam = do

165 ctx <- getContext

172 ctx <- getContext

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

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

167−

174+

168showType :: DynFlags -> Type -> String

175showType :: DynFlags -> Type -> String

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

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

170

177

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

189 mErr <- typeCheckScript funcType script

196 mErr <- typeCheckScript funcType script

190 case mErr of

197 case mErr of

191 Just err -> pure (Left err)

198 Just err -> pure (Left err)

192− Nothing ->

199+ Nothing ->

193 --catch exception here

200 --catch exception here

194 --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.

201 --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.

195 -- we can't use dynCompileExpr here because

202 -- we can't use dynCompileExpr here because

196 Right . unsafeCoerce <$> compileExpr sScript

203 Right . unsafeCoerce <$> compileExpr sScript

197−

204+

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

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

199typeCheckScript expectedType inp = do

206typeCheckScript expectedType inp = do

200− dflags <- getSessionDynFlags

207+ dflags <- getSessionDynFlags

201 --catch exception for SyntaxError

208 --catch exception for SyntaxError

202#if __GLASGOW_HASKELL__ >= 802

209#if __GLASGOW_HASKELL__ >= 802

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

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

204−#else

211+#else

205 funcType <- GHC.exprType (unpack inp)

212 funcType <- GHC.exprType (unpack inp)

206#endif

213#endif

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

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

208 if eqType funcType expectedType then

215 if eqType funcType expectedType then

209 pure Nothing

216 pure Nothing

210 else

217 else

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

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

212−

219+

213mangleSymbol :: Maybe String -> String -> String -> String

220mangleSymbol :: Maybe String -> String -> String -> String

214mangleSymbol pkg module' valsym =

221mangleSymbol pkg module' valsym =

215 prefixUnderscore ++

222 prefixUnderscore ++

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

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

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

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

218−

225+

219type ModName = String

226type ModName = String

220type FuncName = String

227type FuncName = String

221

228

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

223

230

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

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

225loadFunction modName funcName objPath = do

232loadFunction modName funcName objPath = do

226−#if __GLASGOW_HASKELL__ >= 802

233+#if __GLASGOW_HASKELL__ >= 802

227 initObjLinker RetainCAFs

234 initObjLinker RetainCAFs

228#else

235#else

229 initObjLinker

236 initObjLinker

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

235 Nothing -> pure (Left LoadSymbolError)

242 Nothing -> pure (Left LoadSymbolError)

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

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

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

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

238−

245+

239−prefixUnderscore :: String

246+prefixUnderscore :: String

240prefixUnderscore =

247prefixUnderscore =

241 case (os,arch) of

248 case (os,arch) of

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

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

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

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

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

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

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

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

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

247− _ -> ""

254+ _ -> ""

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

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

7#else

8import qualified STMContainers.Map as StmMap

9import qualified STMContainers.Set as StmSet

10−#endif

10+#endif

11import ProjectM36.Attribute

12import ProjectM36.Base

13import ProjectM36.Session

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

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

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

49 Attribute "parentCommit" TextAtomType]) atomMatrix

50−

51−

stack.ghc8.4.yaml+1−2

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

24- network-transport-tcp-0.6.0

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

27−flags:

27+flags:

28 project-m36:

29 stack: true

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

50# compiler-check: newer-minor

52allow-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

19import qualified Data.ByteString.Lazy as BS

20-}

22−main :: IO ()

22+main :: IO ()

23−main = do

23+main = do

24− tcounts <- runTestTT $ TestList [testCSVExport,

24+ tcounts <- runTestTT $ TestList [testCSVExport,

25 testADTExport]

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

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

31 case res of

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

33 Right val -> pure val

34−

34+

35−testADTExport :: Test

35+testADTExport :: Test

36testADTExport = TestCase $ do

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

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

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

40 case csvAsRelation attrs basicTypeConstructorMapping adtCSV of

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

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

43−

43+

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

45testCSVExport :: Test

46testCSVExport = TestCase $ do

47 now <- getCurrentTime

48− testInterval <- assertEither $ pure (createInterval

48+ testInterval <- assertEither $ pure (createInterval

49− (DateTimeAtom now)

49+ (DateTimeAtom now)

50 (DateTimeAtom (addUTCTime 86400 now))

51 True

52 False)

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

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

54 Attribute "integerattr" IntegerAtomType,

55 Attribute "dayattr" DayAtomType,

56 Attribute "datetimeattr" DateTimeAtomType,

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

61 ]

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

63 relOrErr = mkRelationFromList attrs [

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

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

65− IntegerAtom 123,

65+ IntegerAtom 123,

66 DayAtom (fromGregorian 2017 4 10),

67 DateTimeAtom now,

68 ByteStringAtom sampleByteString,

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

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

71 testInterval

72 ],

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

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

74− IntegerAtom 314,

74+ IntegerAtom 314,

75 DayAtom (fromGregorian 1001 6 28),

76 DateTimeAtom (addUTCTime 360 now),

77− ByteStringAtom sampleByteString,

77+ ByteStringAtom sampleByteString,

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

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

80 testInterval

81 ]]

82−

82+

83− case relOrErr of

83+ case relOrErr of

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

85− Right rel ->

85+ Right rel ->

86 case relationAsCSV rel of

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

88 Right csvData ->

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

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

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

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

94−