d4d1df8 · project-m36 · git.iko.soy

git.iko.soy/project-m36

Merge branch 'master' into YuMingLiao-feature/dataframe

commitd4d1df80830e2df69e478b397af2a5ee938e1325 authorAgentM <agentm@themactionfaction.com> dateMon 31 Dec 2018, 23:33 (8 years ago) parent2d313ac 4d8607f

52 files changed+423−296

compare with master

unifiedsplit

.appveyor.yml+4−1

@@ -16,6 +16,9 @@ clone_depth: 2

1616environment:

1717 global:

1818 STACK_ROOT: "c:\\sr"

19+ matrix:

20+ - YAML: "stack.ghc8.2.yaml"

21+ - YAML: "stack.ghc8.4.yaml"

1922

2023platform:

2124 - x64

@@ -29,7 +32,7 @@ test_script:

2932 - stack setup > nul

3033# The ugly echo "" hack is to avoid complaints about 0 being an invalid file

3134# descriptor

32− - echo "" | stack --no-terminal test

35+ - echo "" | stack --stack-yaml %YAML% --no-terminal test

3336# - 7z.exe a -t7z -m0=lzma -mx=9 -mfb=64 -md=32m -ms=on project-m36.7z .stack-work\install\*\bin\project-m36-server.exe .stack-work\install\*\bin\project-m36-websocket-server.exe .stack-work\install\*\bin\tutd.exe .stack-work\install\*\bin\project-m36-server.exe

3437

3538#artifacts:

.travis.yml+7−7

@@ -16,16 +16,16 @@ cache:

1616matrix:

1717 fast_finish: true

1818 include:

19− - env: CACHE_NAME=7.10.3 STACK_YAML=stack.ghc7.10.yaml

20− compiler: ": #stack 7.10.3"

19+ - env: CACHE_NAME=8.2.2 STACK_YAML=stack.ghc8.2.yaml

20+ compiler: ": #stack 8.2.2"

2121

22− - env: CACHE_NAME=8.0.2 STACK_YAML=stack.yaml

23− compiler: ": #stack 8.0.2"

24−

25− - env: CACHE_NAME=osx-8.0.2 STACK_YAML=stack.yaml

22+ - env: CACHE_NAME=osx-8.2.2 STACK_YAML=stack.ghc8.2.yaml

2623 os: osx

2724 os_image: xcode7.3

28− compiler: ": #stack 8.0.2"

25+ compiler: ": #stack 8.2.2"

26+

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

28+ compiler: ": #stack 8.4.3"

2929

3030before_script:

3131 - unset CC

.travis/install-dependencies.sh+1−1

@@ -4,7 +4,7 @@ if [[ "$(uname)" = "Darwin" ]]; then

44else

55 timeout_cmd="timeout"

66fi

7−$timeout_cmd 15m stack --no-terminal --jobs=2 --install-ghc --system-ghc build --only-dependencies --fast

7+$timeout_cmd 40m stack --no-terminal --jobs=2 --install-ghc --system-ghc build --only-dependencies --fast

88ret=$?

99case "$ret" in

1010 0)

Changelog.markdown+13

@@ -1,3 +1,16 @@

1+# 2018-10-03 (v0.5.1)

3+* fix atom function type validation

4+* add support for GHC 8.4 (now we support GHC 8.0, 8.2, and 8.4)

6+# 2018-08-10 (v0.5)

8+* fix critical type bug which allowed unresolved types to be used

9+* add full support for GHC 8.2 with stack or cabal (delayed for a long time by dependency version boundaries)

10+* drop support for GHC 7.10

11+* add support for `with (relexpr as name,...)` syntax for use as tutd macros

12+* add `NonEmptyList` list data type

13+

114# 2018-06-04 (v0.4)

215

316* add contributed feature to allow users to [create arbitrary relations](https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown#arbitrary-relation-variables)

README.markdown+1−1

@@ -86,7 +86,7 @@ Project:M36 supports multiple frontends which target different audiences.

8686

8787## Development

8888

89−Project:M36 is developed in Haskell and compiled with GHC 7.10 or GHC 8.0.2 or later.

89+Project:M36 is developed in Haskell and compiled with GHC 8.0.2 or later.

9090

9191## Related Projects

9292

docs/atomfunctions.markdown+1−1

@@ -15,7 +15,7 @@ In this example, we install an atom function to convert between Fahrenheit and C

1515We write the function giving it the name "celsiusToFahrenheit" with type ```Int -> Int``` which indicates to the compiler that the function take one ```Int``` argument value and returns one ```Int``` value. Finally, the body of the function is implemented in quotes or triple-quotes. Note that the function makes use of the "[ProjectM36.Base](/src/lib/ProjectM36/Base.hs)" module to handle the Atom type. The function must take a list of Atoms as arguments and return an Atom. The standard GHC Prelude is available in this AtomFunctionBody context.

1616

1717```

18−TutorialD (master/main): addatomfunction "celsiusToFahrenheit" Int -> Either AtomFunctionError Int """(\\((IntAtom c):_) -> pure $ IntAtom ( (c * 9 `div` 5) + 32)) :: [Atom] -> Either AtomFunctionError Atom"""

18+TutorialD (master/main): addatomfunction "celsiusToFahrenheit" Int -> Either AtomFunctionError Int """(\((IntAtom c):_) -> pure $ IntAtom ( (c * 9 `div` 5) + 32)) :: [Atom] -> Either AtomFunctionError Atom"""

1919```

2020

2121Using triple-quotes allows quotes to be used inside the string without backslash escaping, which can become tedious. The sum type using ```Either``` allows the function to return an error, if necessary.

docs/introduction_to_projectm36.markdown+7−5

@@ -30,23 +30,25 @@ The currently-preferred method of installation is from source. A future enhancem

3030

3131Requirements:

3232

33−* [GHC 7.10 or greater](https://www.haskell.org/downloads)

33+To build with stack:

34+

35+* [GHC 8.2.2 or greater](https://www.haskell.org/downloads)

3436* [Haskell stack](https://docs.haskellstack.org/en/stable/README/)

35−* Linux, MacOS X, or Windows OS

37+* Linux, macOS, or Microsoft Windows

3638

3739Compilation steps:

3840

3941* ```git clone https://github.com/agentm/project-m36```

4042* ```cd project-m36```

41−* ```stack build```

43+* ```stack --stack-yaml stack.ghc8.2.yaml build```

4244

4345At this point, the TutorialD interactive interpreter can be run using ```stack exec tutd```.

4446

45−Alternative building with GHC 8.0.x:

47+Alternative building with GHC 8.0.2 or greater:

4648

4749* ```cabal new-build```

4850

49−The resultant binaries can be found in ```./dist-newstyle/build/project-m36-0.1/build```.

51+The resultant binaries can be found in ```./dist-newstyle/build/project-m36-<version>/build```.

5052

5153## Accessing Project:M36 Databases

5254

docs/new_datatypes.markdown+1−1

@@ -106,6 +106,6 @@ The essential ```Atomable``` typeclass functions are:

106106| ```toAtomType :: Proxy a -> AtomType``` | generate a database AtomType for a Haskell datatype |

107107| ```toAddTypeExpr :: Proxy a -> DatabaseContextExpr``` | generate a ```DatabaseContextExpr``` which can be executed against a database context in order to add the new type |

108108

109−In addition, basic Haskell data types like ```Int```, ```Double```, ```Text```, ```Day```, ```Bool```, ```UTCTime```, and l```ByteString``` already have `Atomable` instances ready-to-go. In addition, an ```Atomable``` instance is available for lists: ```Atomable a => [a]```, though one should be very careful not to use this in a common anti-pattern. Typically, it makes more sense to store one-to-many relationships as discrete relation variables; when storing them as lists, one gives up the various query capabilities and optimizations of the relational algebra.

109+In addition, basic Haskell data types like ```Int```, ```Double```, ```Text```, ```Day```, ```Bool```, ```UTCTime```, and ```ByteString``` already have `Atomable` instances ready-to-go. In addition, an ```Atomable``` instance is available for lists: ```Atomable a => [a]```, though one should be very careful not to use this in a common anti-pattern. Typically, it makes more sense to store one-to-many relationships as discrete relation variables; when storing them as lists, one gives up the various query capabilities and optimizations of the relational algebra.

110110

111111To be clear, these data types are not black boxes once stored in the database. These new types can be scanned and manipulated by Haskell scripts which can be created at runtime. For more information, read about [```AtomFunction```s](/docs/atomfunctions.markdown).

docs/transaction_graph_operators.markdown+2−14

@@ -10,23 +10,11 @@ When a new database is created, a new transaction graph is created for it with o

1010

1111As the user interactively alters the database context such as by adding a new relation variable, the database context is no longer equal to that of the first transactions. This is called "database context divergence" because many of the same components exist in both the updated context and the context of the first transaction.

1212

13−![Initial database starting state](http://g.gravizo.com/g?

14−digraph G {

15− base[label="base transaction",shape=rectangle];

16− new[label="mutable database context"];

17− new -> base;

18−})

13+![Initial database starting state](http://g.gravizo.com/g?%20digraph%20G%20{%20base[label=%22base%20transaction%22,shape=rectangle];%20new[label=%22mutable%20database%20context%22];%20new%20-%3E%20base;%20})

1914

2015Once the user decides that the changes in the updated database context are worth adding to the transaction graph, the user issues a "commit" request. The commit operation converts the current database context into a new transaction which is then added to the graph with the parent transaction set to the same parent transaction as the database context. The user's mutable database context is shifted to be a copy of the context of the newly-committed transaction.

2116

22−![Freshly committed transaction](http://g.gravizo.com/g?

23−digraph G {

24− base[label="base transaction",shape=rectangle];

25− discon[label="mutable database context"];

26− fresh[label="newly committed transaction",shape=rectangle];

27− fresh -> base;

28− discon -> fresh;

29−})

17+![Freshly committed transaction](http://g.gravizo.com/g?%20digraph%20G%20{%20base[label=%22base%20transaction%22,shape=rectangle];%20discon[label=%22mutable%20database%20context%22];%20fresh[label=%22newly%20committed%20transaction%22,shape=rectangle];%20fresh%20-%3E%20base;%20discon%20-%3E%20fresh;%20})

3018

3119It can be handy to attempt to modify the database without altering the data that others may wish to continue to use and modify. If a set of transactions may diverge from another use-case for the data, the user may choose to "branch" the transaction graph. Branching allows the user to assign an arbitrary name to a series of transactions and then potentially merge the set of transactions back to the originating branch. Project:M36 creates a "master" branch when the transaction graph is first created.

3220

docs/tutd_tutorial.markdown+17−17

@@ -14,6 +14,22 @@ TutorialD (master/main):

1414

1515"master" refers to the name of the branch to which the current transaction will be potentially committing.

1616

17+### Date's Sample Relations

18+

19+The examples in this tutorial can be executed after loading Chris Date's sample relations using:

20+

21+```

22+:importexample date

23+```

24+

25+Each section assumes a fresh instance of the Date examples. The relation variables created in the script are:

26+

27+|Relation Variable Name|Description|

28+|----------------------|-----------|

29+|s|suppliers|

30+|p|parts|

31+|sp|contains mapping of which suppliers supply which parts|

32+

1733### Types

1834

1935TutorialD is strongly-typed. The basic built-in types are:

@@ -37,7 +53,7 @@ The ```interval``` function last two arguments are boolean values indicating whe

3753Project:M36 will complain loudly if the expected types do not match. Automatic type coercion does not exist.

3854

3955```

40−TutorialD (master/main): :showexpr S:{more:=add(10,@sname)}

56+TutorialD (master/main): :showexpr s:{more:=add(10,@sname)}

4157ERR: AtomFunctionTypeError "add" 2 IntAtomType StringAtomType

4258```

4359

@@ -68,22 +84,6 @@ Chris Date refers to these relations as "TABLE_DUM" and "TABLE_DEE" but such arb

6884products{}

6985```

7086

71−### Date's Sample Relations

72−

73−The examples in this tutorial can be executed after loading Chris Date's sample relations using:

74−

75−```

76−:importexample date

77−```

78−

79−Each section assumes a fresh instance of the Date examples. The relation variables created in the script are:

80−

81−|Relation Variable Name|Description|

82−|----------------------|-----------|

83−|s|suppliers|

84−|p|parts|

85−|sp|contains mapping of which suppliers supply which parts|

86−

8787### Relational Expressions

8888

8989A relational expression combines relational operators to create a new relation. ```tutd``` can display the result of executing a relational expression with ":showexpr".

project-m36.cabal+45−98

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

11Name: project-m36

2−Version: 0.4

2+Version: 0.5.1

33License: PublicDomain

44Build-Type: Simple

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

@@ -22,71 +22,14 @@ Flag profiler

2222 Default: False

2323 Manual: True

2424

25+--flag to allow stack to use its older, pinned packages

26+Flag stack

27+ Description: build with stack and stackage

28+ Manual: True

29+ Default: False

30+

2531Library

26− Build-Depends: base>=4.8 && < 6.0

27− ,ghc >= 7.8 && < 8.3

28− ,ghc-paths

29− ,mtl

30− ,containers

31− ,unordered-containers

32− ,hashable

33− ,haskeline

34− ,directory

35− ,MonadRandom

36− ,random-shuffle

37− --critical uuid bug in lesser versions https://www.reddit.com/r/haskell/comments/4myot5/psa_make_sure_to_use_uuid_1312/

38− ,uuid >= 1.3.12

39− ,cassava >= 0.4.5.1 && < 0.6

40− ,text

41− ,bytestring

42− ,deepseq

43− ,deepseq-generics

44− ,vector

45− ,parallel

46− ,monad-parallel

47− ,exceptions

48− ,transformers

49− ,gnuplot

50− ,binary

51− ,filepath

52− ,zlib

53− ,directory

54− ,vector-binary-instances

55− ,temporary

56− ,stm

57− ,time

58− ,hashable-time

59− ,old-locale

60− ,rset

61− --used for CSV parsing

62− ,attoparsec

63− ,either

64− ,base64-bytestring

65− ,data-interval

66− ,extended-reals

67− ,network-transport

68− -- aeson 1.1 and above includes instances for UUID types

69− ,aeson >= 1.1

70− ,path-pieces

71− ,conduit

72− ,resourcet

73− ,http-api-data

74− ,semigroups

75− -- used for arbitrary tuples

76− ,QuickCheck

77−--needed for remote access

78− ,distributed-process-client-server >= 0.2.3

79− ,distributed-process >= 0.6.6

80− ,distributed-process-extras >= 0.3.2

81− ,distributed-process-async >= 0.2.4

82− ,network-transport-tcp >= 0.6.0

83− ,network

84− ,list-t

85− ,stm-containers >= 0.2.15

86− ,optparse-applicative

87− ,Glob

88−--used for hashing the transaction graph file to check for differences

89− ,cryptohash-sha256

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

9033 Exposed-Modules: ProjectM36.Error,

9134 ProjectM36.Transaction,

9235 ProjectM36.TransactionGraph,

@@ -161,9 +104,11 @@ Library

161104 ProjectM36.Arbitrary

162105 GHC-Options: -Wall -rdynamic

163106 if os(windows)

164− Build-Depends: Win32 >= 2.3

107+ Build-Depends: Win32 >= 2.5.4.1

165108 Other-Modules: ProjectM36.Win32Handle

166109 else

110+ --219- too many exported symbols under Windows and GHC 8.4

111+ GHC-Options: -rdynamic

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

168113 Build-Depends: unix

169114 CC-Options: -fPIC

@@ -173,10 +118,12 @@ Library

173118 if impl(ghc>= 8)

174119 build-depends:

175120 ghc-boot, ghci

121+ if !flag(stack)

122+ Build-Depends: deferred-folds

176123

177124Executable tutd

178125 Build-Depends: base >=4.8 && <5.0,

179− ghc >= 7.8 && < 8.3,

126+ ghc >= 7.8 && < 8.5,

180127 ghc-paths,

181128 project-m36,

182129 containers,

@@ -204,13 +151,13 @@ Executable tutd

204151 directory,

205152 filepath,

206153 temporary,

207− megaparsec >= 5.2.0 && < 5.4,

154+ megaparsec >= 5.2.0 && < 7,

208155 haskeline,

209156 random, MonadRandom,

210157 base64-bytestring,

211158 optparse-applicative,

212159 attoparsec,

213− stm-containers,

160+ stm-containers >= 1.0.0,

214161 list-t

215162 Other-Modules: TutorialD.Interpreter,

216163 TutorialD.Interpreter.Base,

@@ -232,14 +179,14 @@ Executable tutd

232179 TutorialD.Interpreter.SchemaOperator

233180 main-is: TutorialD/tutd.hs

234181 CC-Options: -fPIC

235− GHC-Options: -Wall -rdynamic

182+ GHC-Options: -Wall -threaded

236183 Hs-Source-Dirs: ./src/bin

237184 Default-Language: Haskell2010

238185 Default-Extensions: OverloadedStrings

239186

240187Executable project-m36-server

241188 Build-Depends: base,

242− ghc >= 7.8 && < 8.3,

189+ ghc >= 7.8 && < 8.5,

243190 ghc-paths,

244191 project-m36,

245192 binary,

@@ -269,7 +216,7 @@ Executable project-m36-server

269216 list-t,

270217 base64-bytestring

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

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

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

273220 if flag(profiler)

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

275222 Default-Language: Haskell2010

@@ -307,7 +254,7 @@ Test-Suite test-tutoriald

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

308255 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

309256 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

310− GHC-Options: -Wall

257+ GHC-Options: -Wall -threaded

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

312259

313260Test-Suite test-tutoriald-atomfunctionscript

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

317264 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

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

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

320− GHC-Options: -Wall

267+ GHC-Options: -Wall -threaded

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

322269

323270Test-Suite test-tutoriald-databasecontextfunctionscript

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

327274 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

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

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

330− GHC-Options: -Wall

277+ GHC-Options: -Wall -threaded

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

332279

333280Test-Suite test-relation

@@ -336,7 +283,7 @@ Test-Suite test-relation

336283 type: exitcode-stdio-1.0

337284 main-is: test/Relation/Basic.hs

338285 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, transformers

339− GHC-Options: -Wall

286+ GHC-Options: -Wall -threaded

340287

341288Test-Suite test-static-optimizer

342289 Default-Language: Haskell2010

@@ -344,7 +291,7 @@ Test-Suite test-static-optimizer

344291 type: exitcode-stdio-1.0

345292 main-is: test/Relation/StaticOptimizer.hs

346293 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, transformers

347− GHC-Options: -Wall

294+ GHC-Options: -Wall -threaded

348295

349296Test-Suite test-transactiongraph-persist

350297 Default-Language: Haskell2010

@@ -354,7 +301,7 @@ Test-Suite test-transactiongraph-persist

354301 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

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

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

357− GHC-Options: -Wall

304+ GHC-Options: -Wall -threaded

358305

359306Test-Suite test-relation-import-csv

360307 Default-Language: Haskell2010

@@ -362,7 +309,7 @@ Test-Suite test-relation-import-csv

362309 type: exitcode-stdio-1.0

363310 main-is: test/Relation/Import/CSV.hs

364311 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

365− GHC-Options: -Wall

312+ GHC-Options: -Wall -threaded

366313

367314Test-Suite test-tutoriald-import-tutoriald

368315 Default-Language: Haskell2010

@@ -371,7 +318,7 @@ Test-Suite test-tutoriald-import-tutoriald

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

372319 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

373320 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

374− GHC-Options: -Wall

321+ GHC-Options: -Wall -threaded

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

376323

377324Test-Suite test-relation-export-csv

@@ -380,7 +327,7 @@ Test-Suite test-relation-export-csv

380327 type: exitcode-stdio-1.0

381328 main-is: test/Relation/Export/CSV.hs

382329 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

383− GHC-Options: -Wall

330+ GHC-Options: -Wall -threaded

384331

385332Test-Suite test-transactiongraph-merge

386333 Default-Language: Haskell2010

@@ -388,7 +335,7 @@ Test-Suite test-transactiongraph-merge

388335 type: exitcode-stdio-1.0

389336 main-is: test/TransactionGraph/Merge.hs

390337 Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, conduit, either, path-pieces, http-api-data, stm-containers, list-t, project-m36

391− GHC-Options: -Wall

338+ GHC-Options: -Wall -threaded

392339

393340benchmark bench

394341 Default-Language: Haskell2010

@@ -396,7 +343,7 @@ benchmark bench

396343 type: exitcode-stdio-1.0

397344 main-is: benchmark/Relation.hs

398345 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, criterion, stm-containers, project-m36

399− GHC-Options: -Wall -rtsopts

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

400347 Hs-Source-Dirs: ./src/bin

401348

402349Test-Suite test-server

@@ -406,28 +353,28 @@ Test-Suite test-server

406353 main-is: test/Server/Main.hs

407354 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, network-transport, semigroups

408355 HS-Source-Dirs: ., ./src/bin

409− GHC-Options: -Wall

356+ GHC-Options: -Wall -threaded

410357

411358Executable Example-SimpleClient

412359 Default-Language: Haskell2010

413360 Default-Extensions: OverloadedStrings

414361 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, ghc, ghc-paths, project-m36, random, MonadRandom

415362 Main-Is: examples/SimpleClient.hs

416− GHC-Options: -Wall

363+ GHC-Options: -Wall -threaded

417364

418365Executable Example-OutOfTheTarpit

419366 Default-Language: Haskell2010

420367 Default-Extensions: OverloadedStrings

421368 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, aeson, path-pieces, either, conduit, http-api-data, template-haskell, ghc, ghc-paths, project-m36

422369 Main-Is: examples/out_of_the_tarpit.hs

423− GHC-Options: -Wall

370+ GHC-Options: -Wall -threaded

424371

425372Executable Example-Blog

426373 Default-Language: Haskell2010

427374 Default-Extensions: OverloadedStrings

428375 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, aeson, path-pieces, either, conduit, http-api-data, template-haskell, ghc, ghc-paths, project-m36, scotty, blaze-html, http-types

429376 Main-Is: examples/blog.hs

430− GHC-Options: -Wall

377+ GHC-Options: -Wall -threaded

431378

432379

433380Executable Example-Hair

@@ -435,14 +382,14 @@ Executable Example-Hair

435382 Default-Extensions: OverloadedStrings

436383 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, aeson, path-pieces, either, conduit, http-api-data, template-haskell, ghc, ghc-paths, project-m36

437384 Main-Is: examples/hair.hs

438− GHC-Options: -Wall

385+ GHC-Options: -Wall -threaded

439386

440387Executable Example-CustomTupleable

441388 Default-Language: Haskell2010

442389 Default-Extensions: OverloadedStrings

443390 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, aeson, path-pieces, either, conduit, http-api-data, template-haskell, ghc, ghc-paths, project-m36

444391 Main-Is: examples/CustomTupleable.hs

445− GHC-Options: -Wall

392+ GHC-Options: -Wall -threaded

446393

447394Test-Suite test-scripts

448395 Default-Language: Haskell2010

@@ -451,7 +398,7 @@ Test-Suite test-scripts

451398 main-is: test/scripts.hs

452399 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

453400 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

454− GHC-Options: -Wall

401+ GHC-Options: -Wall -threaded

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

456403

457404Executable project-m36-websocket-server

@@ -459,7 +406,7 @@ Executable project-m36-websocket-server

459406 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

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

461408 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

462− GHC-Options: -Wall

409+ GHC-Options: -Wall -threaded

463410 Hs-Source-Dirs: ./src/bin

464411 Default-Extensions: OverloadedStrings

465412

@@ -470,7 +417,7 @@ Test-Suite test-websocket-server

470417 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

471418 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

472419 Default-Extensions: OverloadedStrings

473− GHC-Options: -Wall

420+ GHC-Options: -Wall -threaded

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

475422

476423Test-Suite test-isomorphic-schemas

@@ -479,7 +426,7 @@ Test-Suite test-isomorphic-schemas

479426 main-is: test/IsomorphicSchema.hs

480427 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

481428 Default-Extensions: OverloadedStrings

482− GHC-Options: -Wall

429+ GHC-Options: -Wall -threaded

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

484431

485432Test-Suite test-atomable

@@ -489,7 +436,7 @@ Test-Suite test-atomable

489436 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

490437 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

491438 Default-Extensions: OverloadedStrings

492− GHC-Options: -Wall

439+ GHC-Options: -Wall -threaded

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

494441

495442Test-Suite test-multiprocess-access

@@ -498,7 +445,7 @@ Test-Suite test-multiprocess-access

498445 main-is: test/MultiProcessDatabaseAccess.hs

499446 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

500447 Default-Extensions: OverloadedStrings

501− GHC-Options: -Wall

448+ GHC-Options: -Wall -threaded

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

503450

504451Test-Suite test-transactiongraph-automerge

@@ -508,7 +455,7 @@ Test-Suite test-transactiongraph-automerge

508455 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

509456 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

510457 Default-Extensions: OverloadedStrings

511− GHC-Options: -Wall

458+ GHC-Options: -Wall -threaded

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

513460

514461Test-Suite test-tupleable

@@ -517,7 +464,7 @@ Test-Suite test-tupleable

517464 main-is: test/Relation/Tupleable.hs

518465 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

519466 Default-Extensions: OverloadedStrings

520− GHC-Options: -Wall

467+ GHC-Options: -Wall -threaded

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

522469

523470Test-Suite test-client-simple

@@ -526,7 +473,7 @@ Test-Suite test-client-simple

526473 type: exitcode-stdio-1.0

527474 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

528475 Default-Extensions: OverloadedStrings

529− GHC-Options: -Wall

476+ GHC-Options: -Wall -threaded

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

531478

532479-- test for file handle leaks

src/bin/ProjectM36/Server/WebSocket.hs+1−1

@@ -14,7 +14,7 @@ import ProjectM36.Relation.Show.Term

1414import ProjectM36.Relation.Show.HTML

1515import Data.Aeson

1616import TutorialD.Interpreter

17−import TutorialD.Interpreter.Base

17+import TutorialD.Interpreter.Base (TutorialDOperatorResult(..))

1818import ProjectM36.Client

1919import Control.Exception

2020import Data.Attoparsec.Text

src/bin/ProjectM36/Server/WebSocket/websocket-server.hs+2

@@ -5,11 +5,13 @@ import ProjectM36.Server.ParseArgs

55import ProjectM36.Server

66import Control.Concurrent

77import qualified Network.WebSockets as WS

89#if MIN_VERSION_network_transport_tcp(0,6,0)

910import Network.Transport.TCP.Internal (decodeEndPointAddress)

1011#else

1112import Network.Transport.TCP (decodeEndPointAddress)

1213#endif

14+

1315import Control.Exception

1416

1517main :: IO ()

src/bin/TutorialD/Interpreter.hs+2−4

@@ -24,8 +24,6 @@ import ProjectM36.TransactionGraph

2424import qualified ProjectM36.Client as C

2525import ProjectM36.Relation (attributes)

2626

27−import Text.Megaparsec

28−import Text.Megaparsec.Text

2927import System.Console.Haskeline

3028import System.Directory (getHomeDirectory)

3129import qualified Data.Text as T

@@ -79,11 +77,11 @@ promptText eHeadName eSchemaName = "TutorialD (" <> transInfo <> "): "

7977 where

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

8179

82−parseTutorialD :: T.Text -> Either (ParseError Char Dec) ParsedOperation

80+parseTutorialD :: T.Text -> Either ParserError ParsedOperation

8381parseTutorialD = parse interpreterParserP ""

8482

8583--only parse tutoriald which doesn't result in file I/O

86−safeParseTutorialD :: T.Text -> Either (ParseError Char Dec) ParsedOperation

84+safeParseTutorialD :: T.Text -> Either ParserError ParsedOperation

8785safeParseTutorialD = parse safeInterpreterParserP ""

8886

8987data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)

src/bin/TutorialD/Interpreter/Base.hs+44−10

@@ -1,12 +1,30 @@

11{-# LANGUAGE DeriveGeneric, CPP #-}

2−module TutorialD.Interpreter.Base where

2+module TutorialD.Interpreter.Base (

3+ module TutorialD.Interpreter.Base,

4+ module Text.Megaparsec,

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

6+ module Text.Megaparsec.Char,

7+ module Control.Applicative

8+#else

9+ module Text.Megaparsec.Text

10+#endif

11+ )

12+ where

313import ProjectM36.Base

414import ProjectM36.AtomType

515import ProjectM36.Relation

616

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

18+import Text.Megaparsec.Char

19+import qualified Text.Megaparsec.Char.Lexer as Lex

720import Text.Megaparsec

21+import Data.Void

22+import Control.Applicative hiding (many, some)

23+#else

824import Text.Megaparsec.Text

925import qualified Text.Megaparsec.Lexer as Lex

26+#endif

27+

1028import Data.Text hiding (count)

1129import System.Random

1230import qualified Data.Text as T

@@ -44,16 +62,23 @@ displayOpResult (DisplayParseErrorResult mPromptLength err) = do

4462displayOpResult (DisplayDataFrameResult dFrame) = do

4563 TIO.putStrLn (showRelation $ fromDataFrame dFrame)

4664

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

66+type Parser = Parsec Void Text

67+type ParseStr = Text

68+#else

69+type ParseStr = String

70+#endif

71+

4772spaceConsumer :: Parser ()

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

4974

5075opChar :: Parser Char

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

5277

53−reserved :: String -> Parser ()

78+reserved :: ParseStr -> Parser ()

5479reserved word = try (string word *> notFollowedBy opChar *> spaceConsumer)

5580

56−reservedOp :: String -> Parser ()

81+reservedOp :: ParseStr -> Parser ()

5782reservedOp op = try (spaceConsumer *> string op *> notFollowedBy opChar *> spaceConsumer)

5883

5984parens :: Parser a -> Parser a

@@ -69,8 +94,12 @@ identifier = do

6994 spaceConsumer

7095 pure (pack (istart:irest))

7196

72−symbol :: String -> Parser Text

97+symbol :: ParseStr -> Parser Text

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

99+symbol sym = Lex.symbol spaceConsumer sym

100+#else

73101symbol sym = pack <$> Lex.symbol spaceConsumer sym

102+#endif

74103

75104comma :: Parser Text

76105comma = symbol ","

@@ -90,13 +119,12 @@ arrow = symbol "->"

90119semi :: Parser Text

91120semi = symbol ";"

92121

93−{-

94−whiteSpace :: Parser ()

95−whiteSpace = Token.whiteSpace lexer

96−-}

97−

98122integer :: Parser Integer

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

124+integer = Lex.signed spaceConsumer Lex.decimal

125+#else

99126integer = Lex.signed spaceConsumer Lex.integer

127+#endif

100128

101129float :: Parser Double

102130float = Lex.float

@@ -125,13 +153,19 @@ showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ L.map showA

125153

126154type PromptLength = Int

127155

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

157+type ParserError = ParseError Char Void

158+#else

159+type ParserError = ParseError Char Dec

160+#endif

161+

128162data TutorialDOperatorResult = QuitResult |

129163 DisplayResult StringType |

130164 DisplayIOResult (IO ()) |

131165 DisplayRelationResult Relation |

132166 DisplayDataFrameResult DataFrame |

133167 DisplayErrorResult StringType |

134− DisplayParseErrorResult (Maybe PromptLength) (ParseError Char Dec) | -- Int refers to length of prompt text

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

135169 QuietSuccessResult

136170 deriving (Generic)

137171

src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs−2

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

11module TutorialD.Interpreter.DatabaseContextExpr where

2−import Text.Megaparsec

3−import Text.Megaparsec.Text

42import ProjectM36.Base

53import TutorialD.Interpreter.Base

64import qualified Data.Text as T

src/bin/TutorialD/Interpreter/DatabaseContextIOOperator.hs+1−4

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

11--compiling the script requires the IO monad because it must load modules from the filesystem, so we create the function and generate the requisite DatabaseExpr here.

22module TutorialD.Interpreter.DatabaseContextIOOperator where

33import ProjectM36.Base

4−

54import TutorialD.Interpreter.Base

65import TutorialD.Interpreter.Types

7−import Text.Megaparsec

8−import Text.Megaparsec.Text

96import Data.Text

107

118addAtomFunctionExprP :: Parser DatabaseContextIOExpr

@@ -24,7 +21,7 @@ createArbitraryRelationP = do

2421 max' <- fromInteger <$> integer

2522 pure $ CreateArbitraryRelation relVarName attrExprs (min',max')

2623

27−dbioexprP :: String -> (Text -> [TypeConstructor] -> Text -> DatabaseContextIOExpr) -> Parser DatabaseContextIOExpr

24+dbioexprP :: ParseStr -> (Text -> [TypeConstructor] -> Text -> DatabaseContextIOExpr) -> Parser DatabaseContextIOExpr

2825dbioexprP res adt = do

2926 reserved res

3027 funcName <- quotedString

src/bin/TutorialD/Interpreter/Export/CSV.hs+1−2

@@ -2,10 +2,9 @@ module TutorialD.Interpreter.Export.CSV where

22import ProjectM36.Relation.Show.CSV

33import TutorialD.Interpreter.Export.Base

44import TutorialD.Interpreter.RelationalExpr

5−import TutorialD.Interpreter.Base

5+import TutorialD.Interpreter.Base hiding (try)

66import ProjectM36.Base

77import ProjectM36.Error

8−import Text.Megaparsec.Text

98import qualified Data.ByteString.Lazy as BS

109import Control.Exception (try)

1110import qualified Data.Text as T

src/bin/TutorialD/Interpreter/Import/BasicExamples.hs+4

@@ -1,10 +1,14 @@

1+{-# LANGUAGE CPP #-}

12--includes some hardcoded examples which can be imported even during safe evaluation (no file I/O)

23module TutorialD.Interpreter.Import.BasicExamples where

34import ProjectM36.DateExamples

45import ProjectM36.Base

56import ProjectM36.DatabaseContext

67import TutorialD.Interpreter.Base

9+#if !MIN_VERSION_megaparsec(6,0,0)

710import Text.Megaparsec.Text

11+#endif

812

913data ImportBasicExampleOperator = ImportBasicDateExampleOperator

1014 deriving (Show)

src/bin/TutorialD/Interpreter/Import/CSV.hs+2−2

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

1+{-# LANGUAGE CPP #-}

12module TutorialD.Interpreter.Import.CSV where

23import TutorialD.Interpreter.Import.Base

34import ProjectM36.Base

@@ -5,8 +6,7 @@ import ProjectM36.Error

56import ProjectM36.Relation.Parse.CSV hiding (quotedString)

67import qualified Data.ByteString.Lazy as BS

78import qualified Data.Text as T

8−import Text.Megaparsec.Text

9−import TutorialD.Interpreter.Base

9+import TutorialD.Interpreter.Base hiding (try)

1010import Control.Exception

1111

1212importCSVRelation :: RelVarName -> TypeConstructorMapping -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr)

src/bin/TutorialD/Interpreter/Import/TutorialD.hs+1−3

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

11module TutorialD.Interpreter.Import.TutorialD where

22import ProjectM36.Base

33import TutorialD.Interpreter.Import.Base

4−import TutorialD.Interpreter.Base

4+import TutorialD.Interpreter.Base hiding (try)

55import TutorialD.Interpreter.DatabaseContextExpr

6−import Text.Megaparsec.Text

7−import Text.Megaparsec hiding (try)

86import ProjectM36.Error

97import qualified ProjectM36.Error as PM36E

108import qualified Data.Text as T

src/bin/TutorialD/Interpreter/InformationOperator.hs−1

@@ -2,7 +2,6 @@

22module TutorialD.Interpreter.InformationOperator where

33import Data.Text

44import Text.Megaparsec

5−import Text.Megaparsec.Text

65import TutorialD.Interpreter.Base

76-- older versions of stack fail to

87#if !defined(VERSION_project_m36)

src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs−2

@@ -7,8 +7,6 @@ import ProjectM36.Relation (attributes)

77import ProjectM36.Error

88import ProjectM36.InclusionDependency

99import qualified ProjectM36.Client as C

10−import Text.Megaparsec

11−import Text.Megaparsec.Text

1210import TutorialD.Interpreter.Base

1311import TutorialD.Interpreter.RelationalExpr

1412import TutorialD.Interpreter.DatabaseContextExpr

src/bin/TutorialD/Interpreter/RelationalExpr.hs−1

@@ -2,7 +2,6 @@ module TutorialD.Interpreter.RelationalExpr where

22import Text.Megaparsec

33import Text.Megaparsec.Expr

44import ProjectM36.Base

5−import Text.Megaparsec.Text

65import TutorialD.Interpreter.Base

76import TutorialD.Interpreter.Types

87import qualified Data.Text as T

src/bin/TutorialD/Interpreter/SchemaOperator.hs−2

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

11module TutorialD.Interpreter.SchemaOperator where

22import Text.Megaparsec

3−import Text.Megaparsec.Text

4−

53import ProjectM36.Base

64import ProjectM36.IsomorphicSchema

75import ProjectM36.Session

src/bin/TutorialD/Interpreter/TransGraphRelationalOperator.hs−3

@@ -9,9 +9,6 @@ import qualified ProjectM36.Client as C

99import TutorialD.Interpreter.Base

1010import TutorialD.Interpreter.RelationalExpr

1111

12−import Text.Megaparsec

13−import Text.Megaparsec.Text

14−

1512import qualified Data.Text as T

1613

1714instance RelationalMarkerExpr TransactionIdLookup where

src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs−2

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

11{-# LANGUAGE GADTs #-}

22module TutorialD.Interpreter.TransactionGraphOperator where

33import TutorialD.Interpreter.Base

4−import Text.Megaparsec.Text

5−import Text.Megaparsec

64import ProjectM36.TransactionGraph hiding (autoMergeToHead)

75import ProjectM36.Client

86import ProjectM36.Base

src/bin/TutorialD/Interpreter/Types.hs+3−7

@@ -1,7 +1,6 @@

11--parse type and data constructors

22module TutorialD.Interpreter.Types where

33import ProjectM36.Base

4−import Text.Megaparsec.Text

54import Text.Megaparsec

65import TutorialD.Interpreter.Base

@@ -25,8 +24,7 @@ dataConstructorDefP = DataConstructorDef <$> capitalizedIdentifier <*> many data

2524

2625-- data *Either a b* = Left *a* | Right *b*

2726dataConstructorDefArgP :: Parser DataConstructorDefArg

28−dataConstructorDefArgP = parens (DataConstructorDefTypeConstructorArg <$> typeConstructorP) <|>

29− DataConstructorDefTypeConstructorArg <$> typeConstructorP <|>

27+dataConstructorDefArgP = DataConstructorDefTypeConstructorArg <$> (monoTypeConstructorP <|> parens typeConstructorP) <|>

3028 DataConstructorDefTypeVarNameArg <$> uncapitalizedIdentifier

3129

3230-- relation{a Int} in type construction (no tuples parsed)

@@ -41,14 +39,12 @@ makeAttributeExprsP = braces (sepBy attributeAndTypeNameP comma)

4139

4240attributeAndTypeNameP :: RelationalMarkerExpr a => Parser (AttributeExprBase a)

4341attributeAndTypeNameP = AttributeAndTypeNameExpr <$> identifier <*> typeConstructorP <*> parseMarkerP

44−

4542

4643-- *Either Int Text*, *Int*

4744typeConstructorP :: Parser TypeConstructor

4845typeConstructorP = relationTypeConstructorP <|>

49− TypeVariable <$> uncapitalizedIdentifier <|>

50− ADTypeConstructor <$> capitalizedIdentifier <*> many (parens typeConstructorP <|>

51− monoTypeConstructorP)

46+ ADTypeConstructor <$> capitalizedIdentifier <*> many (monoTypeConstructorP <|> parens typeConstructorP) <|>

47+ monoTypeConstructorP

5248

5349monoTypeConstructorP :: Parser TypeConstructor

5450monoTypeConstructorP = ADTypeConstructor <$> capitalizedIdentifier <*> pure [] <|>

src/bin/benchmark/Handles.hs+1−2

@@ -4,9 +4,8 @@ import ProjectM36.Client

44import ProjectM36.Persist

55import Options.Applicative

66import TutorialD.Interpreter

7−import TutorialD.Interpreter.Base

7+import TutorialD.Interpreter.Base hiding (Parser, option)

88import qualified Data.Text as T

9−import Text.Megaparsec hiding (option)

109import Data.Monoid

1110import Control.Monad

1211

src/bin/benchmark/bigrel.hs+8−4

@@ -83,10 +83,9 @@ intmapMatrixRelation :: Int -> Int -> HS.HashSet (IM.IntMap Atom)

8383intmapMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]

8484 where

8585 mapper tupCount = IM.fromList $ map (\c-> (c, IntAtom (fromIntegral tupCount))) [0..attributeCount]

86−

87−instance Hash.Hashable (IM.IntMap Atom) where

88− hashWithSalt salt tupMap = Hash.hashWithSalt salt (show tupMap)

8986-}

87+-- instance Hash.Hashable (IM.IntMap Atom) where

88+-- hashWithSalt salt tupMap = Hash.hashWithSalt salt (show tupMap)

9089

9190{-

9291vectorMatrixRun :: IO ()

@@ -94,15 +93,20 @@ vectorMatrixRun = do

9493 let matrix = vectorMatrixRelation 100 100000

9594 print matrix

9695-}

96+-- 20 s 90 MBs- a clear win- ideal size is 10 * 100000 * 8 bytes = 80 MB! without IntAtom wrapper

97+--with IntAtom wrapper: 1m12s 90 MB

98+{-

99+

97100

98101-- 20 s 90 MBs- a clear win- ideal size is 10 * 100000 * 8 bytes = 80 MB! without IntAtom wrapper

99102--with IntAtom wrapper: 1m12s 90 MB

100103{-

104+

101105vectorMatrixRelation :: Int -> Int -> HS.HashSet (V.Vector Atom)

102106vectorMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]

103107 where

104108 mapper tupCount = V.replicate attributeCount (IntAtom (fromIntegral tupCount))

105−

109+-}

106110instance Hash.Hashable (V.Vector Atom) where

107111 hashWithSalt salt vec = Hash.hashWithSalt salt (show vec)

108112-}

src/lib/ProjectM36/Arbitrary.hs+2−13

@@ -10,8 +10,9 @@ import ProjectM36.Attribute (atomType)

1010import ProjectM36.DataConstructorDef as DCD

1111import ProjectM36.DataTypes.Interval

1212import qualified Data.Vector as V

13−import Data.Text (Text,pack)

13+import Data.Text (Text)

1414import Test.QuickCheck

15+import Test.QuickCheck.Instances ()

1516import qualified Data.ByteString.Char8 as B

1617import Data.Time

1718import Control.Monad.Reader

@@ -75,18 +76,6 @@ maybeToRight :: b -> Maybe a -> Either b a

7576maybeToRight _ (Just x) = Right x

7677maybeToRight y Nothing = Left y

7778

78−instance Arbitrary Text where

79− arbitrary = pack <$> elements (map (replicate 3) ['A'..'Z'])

80−

81−instance Arbitrary Day where

82− arbitrary = ModifiedJulianDay <$> (arbitrary :: Gen Integer)

83−

84−instance Arbitrary UTCTime where

85− arbitrary = UTCTime <$> arbitrary <*> (secondsToDiffTime <$> choose(0,86400))

86−

87−instance Arbitrary B.ByteString where

88− arbitrary = B.pack <$> (arbitrary :: Gen String)

89−

9079arbitraryRelationTuple :: Attributes -> WithTCMap Gen (Either RelationalError RelationTuple)

9180arbitraryRelationTuple attris = do

9281 tcMap <- ask

src/lib/ProjectM36/Atomable.hs+21−7

@@ -4,7 +4,6 @@ module ProjectM36.Atomable where

44--http://stackoverflow.com/questions/13448361/type-families-with-ghc-generics-or-data-data

55--instances to marshal Haskell ADTs to ConstructedAtoms and back

66import ProjectM36.Base

7−import ProjectM36.DataTypes.Primitive

87import ProjectM36.DataTypes.List

98import ProjectM36.DataTypes.NonEmptyList

109import ProjectM36.DataTypes.Maybe

@@ -12,13 +11,13 @@ import ProjectM36.DataTypes.Either

1211import GHC.Generics

1312import qualified Data.Map as M

1413import qualified Data.Text as T

14+import qualified Data.Vector as V

1515import Control.DeepSeq (NFData)

1616import Data.Binary

1717import Control.Applicative

1818import Data.Time.Calendar

1919import Data.ByteString (ByteString)

2020import Data.Time.Clock

21−import Data.Maybe

2221import Data.Proxy

2322import qualified Data.List.NonEmpty as NE

2423

@@ -55,7 +54,7 @@ class (Eq a, NFData a, Binary a, Show a) => Atomable a where

5554 toAtomType _ = toAtomTypeG (from (undefined :: a))

5655

5756 -- | Creates DatabaseContextExpr necessary to load the type constructor and data constructor into the database.

58− toAddTypeExpr :: Proxy a -> DatabaseContextExpr

57+ toAddTypeExpr :: proxy a -> DatabaseContextExpr

5958 default toAddTypeExpr :: (Generic a, AtomableG (Rep a)) => proxy a -> DatabaseContextExpr

6059 toAddTypeExpr _ = toAddTypeExprG (from (undefined :: a)) (toAtomType (Proxy :: Proxy a))

6160

@@ -242,10 +241,25 @@ instance (Atomable a) => AtomableG (K1 c a) where

242241 getConstructorsG = undefined

243242 getConstructorArgsG (K1 _) = [DataConstructorDefTypeConstructorArg tCons]

244243 where

245− tCons = PrimitiveTypeConstructor primitiveATypeName primitiveAType

246− primitiveAType = toAtomType (Proxy :: Proxy a)

247− primitiveATypeName = fromMaybe (error ("primitive type missing: " ++ show primitiveAType)) (foldr (\(PrimitiveTypeConstructorDef name typ, _) acc -> if typ == primitiveAType then Just name else acc) Nothing primitiveTypeConstructorMapping)

248−

244+ tCons = typeToTypeConstructor $ toAtomType (Proxy :: Proxy a)

245+

246+typeToTypeConstructor :: AtomType -> TypeConstructor

247+typeToTypeConstructor x@IntAtomType = PrimitiveTypeConstructor "Int" x

248+typeToTypeConstructor x@IntegerAtomType = PrimitiveTypeConstructor "Integer" x

249+typeToTypeConstructor x@DoubleAtomType = PrimitiveTypeConstructor "Double" x

250+typeToTypeConstructor x@TextAtomType = PrimitiveTypeConstructor "Text" x

251+typeToTypeConstructor x@DayAtomType = PrimitiveTypeConstructor "Day" x

252+typeToTypeConstructor x@DateTimeAtomType = PrimitiveTypeConstructor "DateTime" x

253+typeToTypeConstructor x@ByteStringAtomType = PrimitiveTypeConstructor "ByteString" x

254+typeToTypeConstructor x@BoolAtomType = PrimitiveTypeConstructor "Bool" x

255+typeToTypeConstructor (RelationAtomType attrs)

256+ = RelationAtomTypeConstructor $ map attrToAttrExpr $ V.toList attrs

257+ where

258+ attrToAttrExpr (Attribute n t) = AttributeAndTypeNameExpr n (typeToTypeConstructor t) ()

259+typeToTypeConstructor (ConstructedAtomType tcName tvMap)

260+ = ADTypeConstructor tcName $ map typeToTypeConstructor (M.elems tvMap)

261+typeToTypeConstructor (TypeVariableType tvName) = TypeVariable tvName

262+

249263instance AtomableG U1 where

250264 toAtomG = undefined

251265 fromAtomG _ _ = pure U1

src/lib/ProjectM36/Client.hs+34−24

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

1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, ScopedTypeVariables, BangPatterns #-}

1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, ScopedTypeVariables, BangPatterns, PackageImports #-}

22{-|

33Module: ProjectM36.Client

@@ -128,6 +128,7 @@ import Control.Exception.Base

128128import GHC.Conc.Sync

129129

130130import Network.Transport (Transport(closeTransport))

131+

131132#if MIN_VERSION_network_transport_tcp(0,6,0)

132133import Network.Transport.TCP (createTransport, defaultTCPParameters)

133134import Network.Transport.TCP.Internal (encodeEndPointAddress)

@@ -146,12 +147,17 @@ import Control.Exception (IOException, handle, AsyncException, throwIO, fromExce

146147import Control.Concurrent.MVar

147148import qualified Data.Map as M

148149import Control.Distributed.Process.Serializable (Serializable)

149−import qualified STMContainers.Map as STMMap

150−import qualified STMContainers.Set as STMSet

150+#if MIN_VERSION_stm_containers(1,0,0)

151+import qualified StmContainers.Map as StmMap

152+import qualified StmContainers.Set as StmSet

153+#else

154+import qualified STMContainers.Map as StmMap

155+import qualified STMContainers.Set as StmSet

156+#endif

151157import qualified ProjectM36.Session as Sess

152158import ProjectM36.Session

153159import ProjectM36.Sessions

154−import ListT

160+import "list-t" ListT

155161import Data.Binary (Binary)

156162import GHC.Generics (Generic)

157163import Control.DeepSeq (force)

@@ -223,7 +229,7 @@ defaultRemoteConnectionInfo :: ConnectionInfo

223229defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (createNodeId "127.0.0.1" defaultServerPort) emptyNotificationCallback

224230

225231-- | The 'Connection' represents either local or remote access to a database. All operations flow through the connection.

226−type ClientNodes = STMSet.Set ProcessId

232+type ClientNodes = StmSet.Set ProcessId

227233

228234-- internal structure specific to in-process connections

229235data InProcessConnectionConf = InProcessConnectionConf {

@@ -306,8 +312,8 @@ connectProjectM36 (InProcessConnectionInfo strat notificationCallback ghcPkgPath

306312 --create date examples graph for now- probably should be empty context in the future

307313 NoPersistence -> do

308314 graphTvar <- newTVarIO freshGraph

309− clientNodes <- STMSet.newIO

310− sessions <- STMMap.newIO

315+ clientNodes <- StmSet.newIO

316+ sessions <- StmMap.newIO

311317 (localNode, transport) <- createLocalNode

312318 notificationPid <- startNotificationListener localNode notificationCallback

313319 mScriptSession <- createScriptSession ghcPkgPaths

@@ -363,8 +369,8 @@ connectPersistentProjectM36 strat sync dbdir freshGraph notificationCallback ghc

363369 Left err' -> return $ Left (SetupDatabaseDirectoryError err')

364370 Right graph' -> do

365371 tvarGraph <- newTVarIO graph'

366− sessions <- STMMap.newIO

367− clientNodes <- STMSet.newIO

372+ sessions <- StmMap.newIO

373+ clientNodes <- StmSet.newIO

368374 (localNode, transport) <- createLocalNode

369375 lockMVar <- newMVar digest

370376 let conn = InProcessConnection InProcessConnectionConf {

@@ -398,11 +404,11 @@ createSessionAtCommit_ commitId newSessionId (InProcessConnection conf) = do

398404 Left err -> pure (Left err)

399405 Right transaction -> do

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

401− keyDuplication <- STMMap.lookup newSessionId sessions

407+ keyDuplication <- StmMap.lookup newSessionId sessions

402408 case keyDuplication of

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

404410 Nothing -> do

405− STMMap.insert (Session freshDiscon defaultSchemaName) newSessionId sessions

411+ StmMap.insert (Session freshDiscon defaultSchemaName) newSessionId sessions

406412 pure $ Right newSessionId

407413createSessionAtCommit_ _ _ (RemoteProcessConnection _) = error "createSessionAtCommit_ called on remote connection"

408414

@@ -421,12 +427,12 @@ createSessionAtHead conn@(RemoteProcessConnection _) headn = remoteCall conn (Cr

421427-- | Used internally for server connections to keep track of remote nodes for the purpose of sending notifications later.

422428addClientNode :: Connection -> ProcessId -> IO ()

423429addClientNode (RemoteProcessConnection _) _ = error "addClientNode called on remote connection"

424−addClientNode (InProcessConnection conf) newProcessId = atomically (STMSet.insert newProcessId (ipClientNodes conf))

430+addClientNode (InProcessConnection conf) newProcessId = atomically (StmSet.insert newProcessId (ipClientNodes conf))

425431

426432-- | Discards a session, eliminating any uncommitted changes present in the session.

427433closeSession :: SessionId -> Connection -> IO ()

428434closeSession sessionId (InProcessConnection conf) =

429− atomically $ STMMap.delete sessionId (ipSessions conf)

435+ atomically $ StmMap.delete sessionId (ipSessions conf)

430436closeSession sessionId conn@(RemoteProcessConnection _) = remoteCall conn (CloseSession sessionId)

431437

432438-- | 'close' cleans up the database access connection and closes any relevant sockets.

@@ -434,7 +440,11 @@ close :: Connection -> IO ()

434440close (InProcessConnection conf) = do

435441 atomically $ do

436442 let sessions = ipSessions conf

437− STMMap.deleteAll sessions

443+#if MIN_VERSION_stm_containers(1,0,0)

444+ StmMap.reset sessions

445+#else

446+ StmMap.deleteAll sessions

447+#endif

438448 pure ()

439449 closeLocalNode (ipLocalNode conf)

440450 closeTransport (ipTransport conf)

@@ -494,7 +504,7 @@ remoteCall (RemoteProcessConnection conf) arg = runProcessResult localNode $ do

494504

495505sessionForSessionId :: SessionId -> Sessions -> STM (Either RelationalError Session)

496506sessionForSessionId sessionId sessions =

497− maybe (Left $ NoSuchSessionError sessionId) Right <$> STMMap.lookup sessionId sessions

507+ maybe (Left $ NoSuchSessionError sessionId) Right <$> StmMap.lookup sessionId sessions

498508

499509schemaForSessionId :: Session -> STM (Either RelationalError Schema)

500510schemaForSessionId session = do

@@ -536,7 +546,7 @@ setCurrentSchemaName sessionId (InProcessConnection conf) sname = atomically $ d

536546 Left err -> pure (Left err)

537547 Right session -> case Sess.setSchemaName sname session of

538548 Left err -> pure (Left err)

539− Right newSession -> STMMap.insert newSession sessionId sessions >> pure (Right ())

549+ Right newSession -> StmMap.insert newSession sessionId sessions >> pure (Right ())

540550setCurrentSchemaName sessionId conn@(RemoteProcessConnection _) sname = remoteCall conn (ExecuteSetCurrentSchema sessionId sname)

541551

542552-- | Execute a relational expression in the context of the session and connection. Relational expressions are queries and therefore cannot alter the database.

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

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

590600 newSchemas = Schemas context' newSubschemas

591601 newSession = Session newDiscon (Sess.schemaName session)

592− STMMap.insert newSession sessionId sessions

602+ StmMap.insert newSession sessionId sessions

593603 pure (Right ())

594604executeDatabaseContextExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)

595605

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

639649 let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas True

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

641651 newSession = Session newDiscon (Sess.schemaName session)

642− atomically $ STMMap.insert newSession sessionId sessions

652+ atomically $ StmMap.insert newSession sessionId sessions

643653 pure (Right ())

644654executeDatabaseContextIOExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextIOExpr sessionId dbExpr)

645655

@@ -750,7 +760,7 @@ executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do

750760 Left err -> pure $ Left err

751761 Right previousTrans -> do

752762 (evaldNots, nodes) <- executeCommitExprSTM_ (Trans.concreteDatabaseContext previousTrans) (Sess.concreteDatabaseContext session) clientNodes

753− nodesToNotify <- toList (STMSet.stream nodes)

763+ nodesToNotify <- toList (StmSet.stream nodes)

754764 pure $ Right (evaldNots, nodesToNotify, newGraph)

755765 else

756766 pure $ Right (M.empty, [], newGraph)

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

792802 let discon = Sess.disconnectedTransaction session

793803 newSchemas = Schemas newContext newSubschemas

794804 newSession = Session (DisconnectedTransaction (Discon.parentId discon) newSchemas True) (Sess.schemaName session)

795− STMMap.insert newSession sessionId sessions

805+ StmMap.insert newSession sessionId sessions

796806 pure (Right ())

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

798808

@@ -1020,7 +1030,7 @@ transactionGraph_ _ = error "remote connection used"

10201030disconnectedTransaction_ :: SessionId -> Connection -> IO DisconnectedTransaction

10211031disconnectedTransaction_ sessionId (InProcessConnection conf) = do

10221032 let sessions = ipSessions conf

1023− mSession <- atomically $ STMMap.lookup sessionId sessions

1033+ mSession <- atomically $ StmMap.lookup sessionId sessions

10241034 case mSession of

10251035 Nothing -> error "No such session"

10261036 Just (Sess.Session discon _) -> pure discon

@@ -1078,13 +1088,13 @@ commitLock_ sessionId conf stmBlock = do

10781088 Right (discon', graph', transactionIdsToPersist) -> do

10791089 writeTVar graphTvar graph'

10801090 let newSession = Session discon' (Sess.schemaName session)

1081− STMMap.insert newSession sessionId sessions

1091+ StmMap.insert newSession sessionId sessions

10821092 case transactionForId (Sess.parentId session) oldGraph of

10831093 Left err -> pure $ Left err

10841094 Right previousTrans ->

10851095 if not (Prelude.null transactionIdsToPersist) then do

10861096 (evaldNots, nodes) <- executeCommitExprSTM_ (Trans.concreteDatabaseContext previousTrans) (Sess.concreteDatabaseContext session) clientNodes

1087− nodesToNotify <- toList (STMSet.stream nodes)

1097+ nodesToNotify <- stmSetToList nodes

10881098 pure $ Right (evaldNots, nodesToNotify, graph', transactionIdsToPersist)

10891099 else pure (Right (M.empty, [], graph', []))

10901100

@@ -1101,7 +1111,7 @@ writeDisconAndGraph_ :: TVar TransactionGraph -> SessionId -> Session -> Session

11011111writeDisconAndGraph_ graphTvar sessionId session sessions discon graph = do

11021112 writeTVar graphTvar graph

11031113 let newSession = Session discon (Sess.schemaName session)

1104− STMMap.insert newSession sessionId sessions

1114+ StmMap.insert newSession sessionId sessions

11051115-}

11061116

11071117-- | Runs an IO monad, commits the result when the monad returns no errors, otherwise, rolls back the changes and the error.

src/lib/ProjectM36/IsomorphicSchema.hs+4−6

@@ -14,9 +14,7 @@ import Data.Binary

1414import qualified Data.Map as M

1515import qualified Data.Set as S

1616import qualified Data.List as L

17−import qualified Data.Text as T

1817import Data.Monoid

19−--import Debug.Trace

2018-- isomorphic schemas offer bi-directional functors between two schemas

2119

2220--TODO: note that renaming a relvar should alter any stored isomorphisms as well

@@ -304,11 +302,11 @@ validate morph underlyingRvNames = if S.size invalidRvNames > 0 then

304302

305303-- | Create inclusion dependencies mainly for IsoRestrict because the predicate should hold in the base schema.

306304createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies

307−createIncDepsForIsomorph sname (IsoRestrict _ predi (rvTrue, rvFalse)) = let

305+createIncDepsForIsomorph sname (IsoRestrict origRv predi (rvTrue, rvFalse)) = let

308306 newIncDep predicate rv = InclusionDependency (Project AN.empty (Restrict predicate (RelationVariable rv ()))) (ExistingRelation relationTrue)

309− incDepName b = "schema" <> "_" <> sname <> "_" <> T.pack (show b) in

310− M.fromList [(incDepName True, newIncDep predi rvTrue),

311− (incDepName False, newIncDep (NotPredicate predi) rvFalse)]

307+ incDepName b = "schema" <> "_" <> sname <> "_" <> b in

308+ M.fromList [(incDepName (origRv <> "_true"), newIncDep predi rvTrue),

309+ (incDepName (origRv <> "_false"), newIncDep (NotPredicate predi) rvFalse)]

312310createIncDepsForIsomorph _ _ = M.empty

313311

314312-- in the case of IsoRestrict, the database context should be updated with the restriction so that if the restriction does not hold, then the schema cannot be created

src/lib/ProjectM36/Persist.hs+8−5

@@ -66,7 +66,13 @@ renameSync sync srcPath dstPath = do

6666atomicRename :: FilePath -> FilePath -> IO ()

6767atomicRename srcPath dstPath =

6868#if defined(mingw32_HOST_OS)

69− Win32.moveFileEx srcPath dstPath Win32.mOVEFILE_REPLACE_EXISTING

69+#if MIN_VERSION_Win32(2,6,0)

70+ let dst = Just dstPath

71+#else

72+ let dst = dstPath

73+#endif

74+ in

75+ Win32.moveFileEx srcPath dst Win32.mOVEFILE_REPLACE_EXISTING

7076#else

7177 Posix.rename srcPath dstPath

7278#endif

@@ -119,13 +125,10 @@ printFdCount =

119125 putStrLn "Fd count not supported on this OS."

120126#endif

121127

122−

123−fdCount :: IO Int

124128#if FDCOUNTSUPPORTED

129+fdCount :: IO Int

125130fdCount = do

126131 fds <- getDirectoryContents FDDIR

127132 pure ((length fds) - 2)

128−#else

129133--not supported on non-linux

130−fdCount = pure 0

131134#endif

src/lib/ProjectM36/Relation.hs+4

@@ -64,6 +64,10 @@ mkRelationDeferVerify :: Attributes -> RelationTupleSet -> Either RelationalErro

6464mkRelationDeferVerify attrs tupleSet = return $ Relation attrs (RelationTupleSet (filter tupleFilter (asList tupleSet)))

6565 where

6666 tupleFilter tuple = isRight (verifyTuple attrs tuple)

67+

68+--return a relation of the same type except without any tuples

69+relationWithEmptyTupleSet :: Relation -> Relation

70+relationWithEmptyTupleSet (Relation attrs _) = emptyRelationWithAttrs attrs

6771

6872mkRelationFromTuples :: Attributes -> [RelationTuple] -> Either RelationalError Relation

6973mkRelationFromTuples attrs tupleSetList = do

src/lib/ProjectM36/RelationalExpression.hs+14−9

@@ -663,7 +663,10 @@ typeForRelationalExpr expr = do

663663 --replace the relationVariables context element with a cloned set of relation devoid of tuples

664664 let context' = contextWithEmptyTupleSets context

665665 rstate' = setStateElemsContext rstate context'

666− pure (runReader (evalRelationalExpr expr) rstate')

666+ --evalRelationalExpr could still return an existing relation with tuples, so strip them

667+ pure $ case runReader (evalRelationalExpr expr) rstate' of

668+ Left err -> Left err

669+ Right typeRel -> Right (relationWithEmptyTupleSet typeRel)

667670

668671--returns a database context with all tuples removed

669672--this is useful for type checking and optimization

@@ -750,18 +753,18 @@ predicateRestrictionFilter attrs (AtomExprPredicate atomExpr) = do

750753 --merge attrs into the state attributes

751754 rstate <- ask

752755 runExceptT $ do

753− aType <- liftE (typeFromAtomExpr attrs atomExpr)

756+ aType <- liftE (typeFromAtomExpr attrs atomExpr)

754757 if aType /= BoolAtomType then

755758 throwE (AtomTypeMismatchError aType BoolAtomType)

756759 else

757760 pure (\tupleIn ->

758− pure $ case runReader (evalAtomExpr tupleIn atomExpr) rstate of

759− Left _ -> False

760− Right boolAtomValue -> boolAtomValue == BoolAtom True)

761+ case runReader (evalAtomExpr tupleIn atomExpr) rstate of

762+ Left err -> Left err

763+ Right boolAtomValue -> pure (boolAtomValue == BoolAtom True))

761764

762765tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation

763766tupleExprCheckNewAttrName attrName rel = if isRight (attributeForName attrName rel) then

764− Left (error "SPAMMIT" $ AttributeNameInUseError attrName)

767+ Left (AttributeNameInUseError attrName)

765768 else

766769 Right rel

767770

@@ -800,13 +803,15 @@ evalAtomExpr tupIn (FunctionAtomExpr funcName arguments ()) = do

800803 func <- either throwE pure (atomFunctionForName funcName functions)

801804 let expectedArgCount = length (atomFuncType func) - 1

802805 actualArgCount = length argTypes

803− safeInit [_] = []

804806 safeInit [] = [] -- different behavior from normal init

805− safeInit (_:xs) = safeInit xs

807+ safeInit xs = init xs

806808 if expectedArgCount /= actualArgCount then

807809 throwE (FunctionArgumentCountMismatchError expectedArgCount actualArgCount)

808810 else do

809− mapM_ (\(expType, actType) -> either throwE pure (atomTypeVerify expType actType)) (safeInit (zip (atomFuncType func) argTypes))

811+ let zippedArgs = zip (safeInit (atomFuncType func)) argTypes

812+ mapM_ (\(expType, eActType) -> do

813+ actType <- either throwE pure eActType

814+ either throwE pure (atomTypeVerify expType actType)) zippedArgs

810815 evaldArgs <- mapM (liftE . evalAtomExpr tupIn) arguments

811816 case evalAtomFunction func evaldArgs of

812817 Left err -> throwE (AtomFunctionUserError err)

src/lib/ProjectM36/ScriptSession.hs+31−1

@@ -22,12 +22,20 @@ import GHCi.ObjLink

2222#else

2323import ObjLink

2424#endif

25+#if __GLASGOW_HASKELL__ >= 802

26+import BasicTypes

27+#endif

2528import DynFlags

2629import Panic

2730import Outputable --hiding ((<>))

2831import PprTyThing

2932import Unsafe.Coerce

33+#if __GLASGOW_HASKELL__ >= 802

3034import Type

35+#elif __GLASGOW_HASKELL__ >= 710

36+import Type hiding (pprTyThing)

37+#else

38+#endif

3139

3240import GHC.Exts (addrToAny#)

3341import GHC.Ptr (Ptr(..))

@@ -75,7 +83,12 @@ initScriptSession ghcPkgPaths = do

7583 trustFlags = map TrustPackage required_packages,

7684#endif

7785 packageFlags = packageFlags dflags ++ packages,

86+#if __GLASGOW_HASKELL__ >= 802

87+ packageDBFlags = map PackageDB localPkgPaths

88+#else

7889 extraPkgConfs = const (localPkgPaths ++ [UserPkgConf, GlobalPkgConf])

90+#endif

91+

7992 }

8093 applyGopts flags = foldl gopt_set flags gopts

8194 applyXopts flags = foldl xopt_set flags xopts

@@ -107,7 +120,11 @@ initScriptSession ghcPkgPaths = do

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

108121 _ <- setSessionDynFlags dflags'

109122 let safeImportDecl mn mQual = ImportDecl {

123+#if __GLASGOW_HASKELL__ >= 802

124+ ideclSourceSrc = NoSourceText,

125+#else

110126 ideclSourceSrc = Nothing,

127+#endif

111128 ideclName = noLoc mn,

112129 ideclPkgQual = Nothing,

113130 ideclSource = False,

@@ -129,7 +146,12 @@ initScriptSession ghcPkgPaths = do

129146 "ProjectM36.DatabaseContextFunctionError",

130147 "ProjectM36.DatabaseContextFunctionUtils",

131148 "ProjectM36.RelationalExpression"]

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

149+#if __GLASGOW_HASKELL__ >= 802

150+ mkModName = noLoc . mkModuleName

151+#else

152+ mkModName = mkModuleName

153+#endif

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

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

134156 ]

135157 setContext (unqualifiedModules ++ qualifiedModules)

@@ -177,7 +199,11 @@ typeCheckScript :: Type -> Text -> Ghc (Maybe ScriptCompilationError)

177199typeCheckScript expectedType inp = do

178200 dflags <- getSessionDynFlags

179201 --catch exception for SyntaxError

202+#if __GLASGOW_HASKELL__ >= 802

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

204+#else

180205 funcType <- GHC.exprType (unpack inp)

206+#endif

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

182208 if eqType funcType expectedType then

183209 pure Nothing

@@ -197,7 +223,11 @@ data LoadSymbolError = LoadSymbolError

197223

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

199225loadFunction modName funcName objPath = do

226+#if __GLASGOW_HASKELL__ >= 802

227+ initObjLinker RetainCAFs

228+#else

200229 initObjLinker

230+#endif

201231 loadObj objPath

202232 _ <- resolveObjs

203233 ptr <- lookupSymbol (mangleSymbol Nothing modName funcName)

src/lib/ProjectM36/Server.hs−1

@@ -136,4 +136,3 @@ launchServer daemonConfig mAddressMVar = do

136136 serve (conn, databaseName daemonConfig, mAddressMVar, address endpoint) initServer (serverDefinition testBool reqTimeout)

137137 liftIO $ putStrLn "serve returned"

138138 pure True

139−

src/lib/ProjectM36/Sessions.hs+28−5

@@ -1,18 +1,41 @@

1+{-# LANGUAGE PackageImports #-}

12module ProjectM36.Sessions where

23import Control.Concurrent.STM

3−import qualified STMContainers.Map as STMMap

4−import ListT

4+#if MIN_VERSION_stm_containers(1,0,0)

5+import qualified StmContainers.Map as StmMap

6+import qualified StmContainers.Set as StmSet

7+#else

8+import qualified STMContainers.Map as StmMap

9+import qualified STMContainers.Set as StmSet

10+#endif

11+import "list-t" ListT

512import ProjectM36.Attribute

613import ProjectM36.Base

714import ProjectM36.Session

815import ProjectM36.Relation

916import ProjectM36.Error

1017import qualified Data.UUID as U

18+import qualified Control.Foldl as Foldl

19+#if MIN_VERSION_stm_containers(1,0,0)

20+import qualified DeferredFolds.UnfoldlM as UF

21+#endif

1122

12−type Sessions = STMMap.Map SessionId Session

23+type Sessions = StmMap.Map SessionId Session

1324

14−stmMapToList :: STMMap.Map k v -> STM [(k, v)]

15−stmMapToList = ListT.fold (\l -> return . (:l)) [] . STMMap.stream

25+--from https://github.com/nikita-volkov/stm-containers/blob/master/test/Main/MapTests.hs

26+stmMapToList :: StmMap.Map k v -> STM [(k, v)]

27+#if MIN_VERSION_stm_containers(1,0,0)

28+stmMapToList = UF.foldM (Foldl.generalize Foldl.list) . StmMap.unfoldlM

29+#else

30+stmMapToList = ListT.fold (\l -> return . (:l)) [] . StmMap.stream

31+#endif

32+

33+stmSetToList :: StmSet.Set v -> STM [v]

34+#if MIN_VERSION_stm_containers(1,0,0)

35+stmSetToList = UF.foldM (Foldl.generalize Foldl.list) . StmSet.unfoldlM

36+#else

37+stmSetToList = ListT.fold (\l -> return . (:l)) [] . StmSet.stream

38+#endif

1639

1740uuidAtom :: U.UUID -> Atom

1841uuidAtom = TextAtom . U.toText

src/lib/ProjectM36/Win32Handle.hs+4−1

@@ -53,5 +53,8 @@ withHandleToHANDLE haskell_handle action =

5353 -- Do what the user originally wanted

5454 action windows_handle

5555

56+#if MIN_VERSION_Win32(2,5,1)

57+#else

5658withStablePtr :: a -> (StablePtr a -> IO b) -> IO b

57−withStablePtr value = bracket (newStablePtr value) freeStablePtr

59+withStablePtr value = bracket (newStablePtr value) freeStablePtr

60+#endif

stack.yaml → stack.ghc8.0.yamlrenamed+1−1

@@ -19,8 +19,8 @@ extra-deps:

1919- distributed-process-async-0.2.4

2020- distributed-process-client-server-0.2.3

2121- distributed-process-extras-0.3.2

22+- deferred-folds-0.6.12

2223- rset-1.0.0

23−- binary-0.8.5.1

2424

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

2626flags: {}

stack.ghc7.10.yaml → stack.ghc8.2.yamlrenamed+6−6

@@ -2,7 +2,7 @@

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

44# 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-6.35

5+resolver: lts-11.20

77# Local packages, usually specified by relative directory name

88packages:

@@ -15,16 +15,16 @@ extra-deps:

1515- gnuplot-0.5.4.1

1616- text-1.2.2.1

1717- aeson-1.2.1.00

18−- distributed-process-0.6.6

19−- distributed-process-async-0.2.4

18+- distributed-process-0.7.3

19+- distributed-process-async-0.2.4.1

2020- distributed-process-client-server-0.2.3

2121- distributed-process-extras-0.3.2

22−- cryptohash-sha256-0.11.100.1

23−- megaparsec-5.3.1

2422- rset-1.0.0

2523

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

27−flags: {}

25+flags:

26+ project-m36:

27+ stack: true

2828

2929# Extra package databases containing global packages

3030extra-package-dbs: []

stack.ghc8.4.yamlnew file+53

@@ -0,0 +1,53 @@

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

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+- data-accessor-transformers-0.2.1.7

13+- data-interval-1.2.0

14+- extended-reals-0.2.1.0

15+- gnuplot-0.5.5.3

16+- aeson-1.2.1.00

17+- distributed-process-0.7.4

18+- distributed-process-async-0.2.4.1

19+- distributed-process-client-server-0.2.3

20+- distributed-process-extras-0.3.2

21+#- deferred-folds-0.9.7.1

22+- rset-1.0.0

23+- hashable-time-0.2.0.2

24+- network-transport-tcp-0.6.0

25+

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

27+flags:

28+ project-m36:

29+ stack: true

30+

31+# Extra package databases containing global packages

32+extra-package-dbs: []

33+

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

35+# system-ghc: true

36+

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

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

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

40+

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

42+# arch: i386

43+# arch: x86_64

44+

45+# Extra directories used by stack for building

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

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

48+

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

50+# compiler-check: newer-minor

51+

52+allow-newer: true

53+

test/IsomorphicSchema.hs+6−6

@@ -105,15 +105,15 @@ testIsoUnion = TestCase $ do

105105 --create motors relation which is split into low-power (<50 horsepower) and high-power (>=50 horsepower) motors

106106 --the schema is contains the split relvars

107107 motorsRel <- assertEither $ mkRelationFromList (A.attributesFromList [Attribute "name" TextAtomType,

108− Attribute "power" IntAtomType])

109− [[TextAtom "Puny", IntAtom 10],

110− [TextAtom "Scooter", IntAtom 49],

111− [TextAtom "Auto", IntAtom 200],

112− [TextAtom "Tractor", IntAtom 500]]

108+ Attribute "power" IntegerAtomType])

109+ [[TextAtom "Puny", IntegerAtom 10],

110+ [TextAtom "Scooter", IntegerAtom 49],

111+ [TextAtom "Auto", IntegerAtom 200],

112+ [TextAtom "Tractor", IntegerAtom 500]]

113113 let baseSchema = mkRelationalExprState DBC.basicDatabaseContext {

114114 relationVariables = M.singleton "motor" motorsRel

115115 }

116− splitPredicate = AtomExprPredicate (FunctionAtomExpr "lt" [AttributeAtomExpr "power", NakedAtomExpr (IntAtom 50)] ())

116+ splitPredicate = AtomExprPredicate (FunctionAtomExpr "lt" [AttributeAtomExpr "power", NakedAtomExpr (IntegerAtom 50)] ())

117117 splitIsomorphs = [IsoUnion ("lowpower", "highpower") splitPredicate "motor",

118118 IsoRename "true" "true",

119119 IsoRename "false" "false"]

test/Relation/Atomable.hs+9−1

@@ -44,6 +44,9 @@ data Test6T = Test6C (Maybe Integer)

4444

4545data Test7T = Test7C (Either Integer Integer)

4646 deriving (Show, Generic, Eq, Binary, NFData, Atomable)

47+

48+data Test8T = Test8C Test1T

49+ deriving (Show, Generic, Eq, Binary, NFData, Atomable)

4750

4851main :: IO ()

4952main = do

@@ -51,7 +54,7 @@ main = do

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

5255

5356testList :: Test

54−testList = TestList [testHaskell2DB, testADT1, testADT2, testADT3, testADT4, testADT5, testBasicMarshaling, testListInstance, testNonEmptyInstance, testADT6Maybe, testADT7Either]

57+testList = TestList [testHaskell2DB, testADT1, testADT2, testADT3, testADT4, testADT5, testBasicMarshaling, testListInstance, testNonEmptyInstance, testADT6Maybe, testADT7Either, testNonPrimitiveValues]

5558

5659

5760-- test some basic data types like int, day, etc.

@@ -141,3 +144,8 @@ testNonEmptyInstance :: Test

141144testNonEmptyInstance = TestCase $ do

142145 let example = TestNonEmptyC [3,4,5]

143146 assertEqual "NonEmpty instance" example (fromAtom (toAtom example))

147+

148+testNonPrimitiveValues :: Test

149+testNonPrimitiveValues = TestCase $ do

150+ let example = Test8C (Test1C 3)

151+ assertEqual "non-primitive values" example (fromAtom (toAtom example))

test/Relation/Basic.hs+8−2

@@ -25,7 +25,8 @@ testList = TestList [testRelation "relationTrue" relationTrue, testRelation "rel

2525 testRelation "products" productsRel,

2626 testRelation "supplierProducts" supplierProductsRel,

2727 testMkRelationFromExprsBadAttrs,

28− testDuplicateAttributes

28+ testDuplicateAttributes,

29+ testExistingRelationType

2930 ]

3031

3132main :: IO ()

@@ -103,4 +104,9 @@ testDuplicateAttributes :: Test

103104testDuplicateAttributes = TestCase $ do

104105 let eRel = mkRelation attrs emptyTupleSet

105106 attrs = attributesFromList [Attribute "a" IntAtomType, Attribute "a" TextAtomType]

106− assertEqual "duplicate attribute names" (Left (DuplicateAttributeNamesError (S.singleton "a"))) eRel

107+ assertEqual "duplicate attribute names" (Left (DuplicateAttributeNamesError (S.singleton "a"))) eRel

108+

109+testExistingRelationType :: Test

110+testExistingRelationType = TestCase $ do

111+ let typeResult = runReader (typeForRelationalExpr (ExistingRelation relationTrue)) (RelationalExprStateElems DBC.empty)

112+ assertEqual "ExistingRelation with tuples type" (Right relationFalse) typeResult

test/Server/Main.hs+4−2

@@ -17,11 +17,13 @@ import System.Exit

1717

1818import Control.Concurrent

1919import Network.Transport (EndPointAddress)

20+

2021#if MIN_VERSION_network_transport_tcp(0,6,0)

2122import Network.Transport.TCP.Internal (encodeEndPointAddress, decodeEndPointAddress)

2223#else

2324import Network.Transport.TCP (encodeEndPointAddress, decodeEndPointAddress)

2425#endif

26+

2527import Data.Either (isRight)

2628import Control.Exception

2729import System.IO.Temp

@@ -220,12 +222,12 @@ testFileDescriptorCount :: Test

220222#if defined(linux_HOST_OS)

221223--validate that creating a server, connecting a client, and then disconnecting doesn't leak file descriptors

222224testFileDescriptorCount = TestCase $ do

223− (serverAddress, serverTid) <- launchTestServer 1000

225+ (serverAddress, serverTid) <- launchTestServer 0

224226 unusedMVar <- newEmptyMVar

225227 startCount <- fdCount

226228 Right (sess, testConn) <- testConnection serverAddress unusedMVar

227229 --add a test commit to trigger the fsync machinery

228− executeDatabaseContextExpr sess testConn (Assign "x" (ExistingRelation relationFalse)) >>= eitherFail

230+ executeDatabaseContextExpr sess testConn (Assign "x" (ExistingRelation relationFalse)) >>= eitherFail

229231 commit sess testConn >>= eitherFail

230232 close testConn

231233 endCount <- fdCount

test/Server/WebSocket.hs+1

@@ -24,6 +24,7 @@ import Network.Transport.TCP.Internal (decodeEndPointAddress)

2424import Network.Transport.TCP (decodeEndPointAddress)

2525#endif

2626

27+

2728--start the websocket server

2829-- run some tutoriald against it

2930

test/TransactionGraph/Persist.hs+5−4

@@ -25,8 +25,9 @@ main = do

2525

2626testList :: Test

2727testList = TestList [testBootstrapDB,

28− testDBSimplePersistence,

28+ testDBSimplePersistence,

2929 testFunctionPersistence]

30+

3031

3132stamp :: UTCTime

3233stamp = UTCTime (fromGregorian 1980 01 01) (secondsToDiffTime 1000)

@@ -74,7 +75,8 @@ testDBSimplePersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \temp

7475

7576--only Haskell-scripted dbc and atom functions can be serialized

7677testFunctionPersistence :: Test

77−testFunctionPersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \tempdir -> do

78+testFunctionPersistence = TestCase $

79+ withSystemTempDirectory "m36testdb" $ \tempdir -> do

7880 let dbdir = tempdir </> "dbdir"

7981 connInfo = InProcessConnectionInfo (MinimalPersistence dbdir) emptyNotificationCallback []

8082 conn <- assertIOEither $ connectProjectM36 connInfo

@@ -85,9 +87,8 @@ testFunctionPersistence = TestCase $ withSystemTempDirectory "m36testdb" $ \temp

8587 ADTypeConstructor "Either" [ADTypeConstructor "AtomFunctionError" [],

8688 intTCons]] "(\\(x:_) -> pure x) :: [Atom] -> Either AtomFunctionError Atom"

8789 _ <- assertIOEither $ executeDatabaseContextIOExpr sess conn addfunc

88−

8990 _ <- assertIOEither $ commit sess conn

90− close conn

91+ --close conn - pauses indefinitely on Windows

9192 --re-open the connection to reload the graph

9293 conn2 <- assertIOEither $ connectProjectM36 connInfo

9394 sess2 <- assertIOEither $ createSessionAtHead conn2 "master"

test/TutorialD/Interpreter.hs+11−2

@@ -72,7 +72,8 @@ main = do

7272 testArbitraryRelation,

7373 testNonEmptyListType,

7474 testUnresolvedAtomTypes,

75− testWithClause

75+ testWithClause,

76+ testAtomFunctionArgumentMismatch

7677 ]

7778 simpleRelTests = [("x:=true", Right relationTrue),

7879 ("x:=false", Right relationFalse),

@@ -631,4 +632,12 @@ testWithClause = TestCase $ do

631632

632633 expectTutorialDErr sessionId dbconn (T.isPrefixOf err1) "x:=with (s as sp) s"

633634

634−

635+testAtomFunctionArgumentMismatch :: Test

636+testAtomFunctionArgumentMismatch = TestCase $ do

637+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

638+ let err1 = "AtomTypeMismatchError"

639+ --atom function type mismatch

640+ expectTutorialDErr sessionId dbconn (T.isPrefixOf err1) "x:=relation{tuple{a 5}} where ^gt(@a,1.5)"

641+ --wrong argument count

642+ let err2 = "FunctionArgumentCountMismatchError"

643+ expectTutorialDErr sessionId dbconn (T.isPrefixOf err2) "x:=relation{tuple{a 5}} where ^gt(@a,1,3)"

test/TutorialD/Interpreter/DatabaseContextFunctionScript.hs−2

@@ -19,9 +19,7 @@ testBasicDBCFunction = TestCase $ do

1919 (sess, conn) <- dateExamplesConnection emptyNotificationCallback

2020 let addfunc = "adddatabasecontextfunction \"addTrue2\" DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext \"\"\"(\\[] ctx -> executeDatabaseContextExpr (Assign \"true2\" (ExistingRelation relationTrue)) ctx) :: [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext\"\"\""

2121 executeTutorialD sess conn addfunc

22− putStrLn "spam1"

2322 executeTutorialD sess conn "execute addTrue2()"

24− putStrLn "spam2"

2523 {-

2624 let true2Expr = RelationVariable "true2" ()

2725 result <- executeRelationalExpr sess conn true2Expr