4b341b5 · project-m36 · git.iko.soy

git.iko.soy/project-m36

Merge branch 'master' into curryer_integration

# Conflicts: # project-m36.cabal # src/lib/ProjectM36/Base.hs

commit4b341b5a29974c41819c7480a62f5507e993047b authorAgentM <agentm@themactionfaction.com> dateSun 27 Dec 2020, 14:21 (6 years ago) parent99c11a8 66f4d99

25 files changed+601−145

compare with master

unifiedsplit

.github/workflows/ci.yaml+3−3

@@ -7,10 +7,10 @@ jobs:

77 runs-on: ubuntu-latest

88 steps:

99 - uses: actions/checkout@v2.3.1

10− - uses: cachix/install-nix-action@v10

10+ - uses: cachix/install-nix-action@v12

1111 with:

12− skip_adding_nixpkgs_channel: true

13− - uses: cachix/cachix-action@v6

12+ nix_path: nixpkgs=channel:nixos-unstable

13+ - uses: cachix/cachix-action@v8

1414 with:

1515 name: project-m36

1616 signingKey: '${{ secrets.CACHIX_SIGNING_KEY }}'

.gitignore+2−1

@@ -18,4 +18,5 @@ persistence-notes

1818jupyter/itutd.egg-info

1919jupyter/build

2020juyter/dist

21−.ipynb_checkpoints

21+.ipynb_checkpoints

22+project-m36.nix

Changelog.markdown+8

@@ -1,3 +1,11 @@

1+# 2020-11-21 (v0.8.2)

3+* support multiple extend expressions in TutorialD

4+* fix parsing of Bool atoms in TutorialD

5+* fix database context expressions which include self-references such as `s:=s union s`

6+* show constraints as TutorialD when using tutd console

7+* add `RelationalExprAtom` data type useful for storing `RelationalExpr` within the database

19# 2020-10-05 (v0.8.1)

210

311* support GHC 8.10

docs/15_minute_tutorial.markdown+61−60

@@ -10,6 +10,12 @@ Thank you for evaluating Project:M36, a new relational algebra engine written in

1010

1111## Download and Install

1212

13+Run a pre-built docker image:

14+

15+```docker run -it projectm36/project-m36 tutd```

16+

17+or build it yourself:

18+

1319```bash

1420git clone https://github.com/agentm/project-m36.git

1521cabal sandbox init

@@ -29,15 +35,7 @@ Note that TutorialD is strongly-typed- no type coercions take place automaticall

2935TutorialD (master/main): :importexample date

3036```

3137

32−or

33−

34−```

35−TutorialD (master/main): :importtud "scripts/DateExamples.tutd"

36−```

37−

38−```:importtutd``` (do not skip typing the preceding colon), loads a file which contains a script written in the TutorialD dialect used by Project:M36 and executes it to change the state of the database. In this case, the relations "s" (supplier), "p" (product), and "sp" (suppliers-products) are now loaded.

39−

40−```:importexample date``` loads the date example directly without any file I/O, so it is safe to use with the websocket server.

38+```:importexample``` (do not skip typing the preceding colon), loads a built-in example schema and executes it to change the state of the database. In this case, the relations "s" (supplier), "p" (product), and "sp" (suppliers-products) are now loaded.

4139

4240### Execute Relational Expressions

4341

@@ -164,7 +162,7 @@ Database context expressions change the state of the database, much like "CREATE

164162#### Create a Relation Variable

165163

166164```

167−TutorialD (master/main): x:=relation{name Text, age Int}{tuple{name "Steve", age 40},tuple{name "Mike", age 31}}

165+TutorialD (master/main): x:=relation{name Text, age Integer}{tuple{name "Steve", age 40},tuple{name "Mike", age 31}}

168166TutorialD (master/main): :showexpr x

169167┌────────┬──────────┐

170168│age::Int│name::Text│

@@ -179,23 +177,25 @@ This is similar to SQL's "CREATE TABLE" operator.

179177#### Insert Additional Tuples

180178

181179```

182−TutorialD (master/main): x:=relation{name Text, age Int}{tuple{name "Steve", age 40},tuple{name "Mike", age 31}}

180+TutorialD (master/main): x:=relation{name Text, age Integer}{tuple{name "Steve", age 40},tuple{name "Mike", age 31}}

183181TutorialD (master/main): :showexpr x

184−┌────────┬──────────┐

185−│age::Int│name::Text│

186−├────────┼──────────┤

187−│40 │"Steve" │

188−│31 │"Mike" │

189−└────────┴──────────┘

182+┌────────────┬──────────┐

183+│age::Integer│name::Text│

184+├────────────┼──────────┤

185+│31 │"Mike" │

186+│40 │"Steve" │

187+└────────────┴──────────┘

188+

190189TutorialD (master/main): insert x relation{tuple{name "Bob", age 24}}

191190TutorialD (master/main): :showexpr x

192−┌────────┬──────────┐

193−│age::Int│name::Text│

194−├────────┼──────────┤

195−│40 │"Steve" │

196−│24 │"Bob" │

197−│31 │"Mike" │

198−└────────┴──────────┘

191+┌────────────┬──────────┐

192+│age::Integer│name::Text│

193+├────────────┼──────────┤

194+│31 │"Mike" │

195+│40 │"Steve" │

196+│24 │"Bob" │

197+└────────────┴──────────┘

198+

199199```

200200

201201Note that the relational insertion is identical to "x:=x union relation{...}".

@@ -204,50 +204,51 @@ Note that the relational insertion is identical to "x:=x union relation{...}".

204204

205205```

206206TutorialD (master/main): :showexpr s

207−┌──────────┬────────┬───────────┬───────────┐

208−│city::Text│s#::Text│sname::Text│status::Int│

209−├──────────┼────────┼───────────┼───────────┤

210−│"Paris" │"S2" │"Jones" │10 │

211−│"Paris" │"S3" │"Blake" │30 │

212−│"London" │"S1" │"Smith" │20 │

213−│"London" │"S4" │"Clark" │20 │

214−│"Athens" │"S5" │"Adams" │30 │

215−└──────────┴────────┴───────────┴───────────┘

207+┌──────────┬────────┬───────────┬───────────────┐

208+│city::Text│s#::Text│sname::Text│status::Integer│

209+├──────────┼────────┼───────────┼───────────────┤

210+│"London" │"S1" │"Smith" │20 │

211+│"Athens" │"S5" │"Adams" │30 │

212+│"Paris" │"S3" │"Blake" │30 │

213+│"London" │"S4" │"Clark" │20 │

214+│"Paris" │"S2" │"Jones" │10 │

215+└──────────┴────────┴───────────┴───────────────┘

216216TutorialD (master/main): update s where city="London" (status:=35)

217217TutorialD (master/main): :showexpr s

218−┌──────────┬────────┬───────────┬───────────┐

219−│city::Text│s#::Text│sname::Text│status::Int│

220−├──────────┼────────┼───────────┼───────────┤

221−│"London" │"S4" │"Clark" │35 │

222−│"London" │"S1" │"Smith" │35 │

223−│"Paris" │"S2" │"Jones" │10 │

224−│"Paris" │"S3" │"Blake" │30 │

225−│"Athens" │"S5" │"Adams" │30 │

226−└──────────┴────────┴───────────┴───────────┘

218+┌──────────┬────────┬───────────┬───────────────┐

219+│city::Text│s#::Text│sname::Text│status::Integer│

220+├──────────┼────────┼───────────┼───────────────┤

221+│"Athens" │"S5" │"Adams" │30 │

222+│"London" │"S1" │"Smith" │35 │

223+│"London" │"S4" │"Clark" │35 │

224+│"Paris" │"S3" │"Blake" │30 │

225+│"Paris" │"S2" │"Jones" │10 │

226+└──────────┴────────┴───────────┴───────────────┘

227+

227228```

228229#### Deleting Tuples from a Relation Variable

229230

230231```

231232TutorialD (master/main): :showexpr s

232−┌──────────┬────────┬───────────┬───────────┐

233−│city::Text│s#::Text│sname::Text│status::Int│

234−├──────────┼────────┼───────────┼───────────┤

235−│"Paris" │"S2" │"Jones" │10 │

236−│"Paris" │"S3" │"Blake" │30 │

237−│"London" │"S1" │"Smith" │20 │

238−│"London" │"S4" │"Clark" │20 │

239−│"Athens" │"S5" │"Adams" │30 │

240−└──────────┴────────┴───────────┴───────────┘

233+┌──────────┬────────┬───────────┬───────────────┐

234+│city::Text│s#::Text│sname::Text│status::Integer│

235+├──────────┼────────┼───────────┼───────────────┤

236+│"Paris" │"S2" │"Jones" │10 │

237+│"Paris" │"S3" │"Blake" │30 │

238+│"London" │"S1" │"Smith" │20 │

239+│"Athens" │"S5" │"Adams" │30 │

240+│"London" │"S4" │"Clark" │20 │

241+└──────────┴────────┴───────────┴───────────────┘

241242TutorialD (master/main): delete s where sname="Adams"

242243TutorialD (master/main): :showexpr s

243−┌──────────┬────────┬───────────┬───────────┐

244−│city::Text│s#::Text│sname::Text│status::Int│

245−├──────────┼────────┼───────────┼───────────┤

246−│"Paris" │"S2" │"Jones" │10 │

247−│"Paris" │"S3" │"Blake" │30 │

248−│"London" │"S1" │"Smith" │20 │

249−│"London" │"S4" │"Clark" │20 │

250−└──────────┴────────┴───────────┴───────────┘

244+┌──────────┬────────┬───────────┬───────────────┐

245+│city::Text│s#::Text│sname::Text│status::Integer│

246+├──────────┼────────┼───────────┼───────────────┤

247+│"Paris" │"S2" │"Jones" │10 │

248+│"London" │"S4" │"Clark" │20 │

249+│"Paris" │"S3" │"Blake" │30 │

250+│"London" │"S1" │"Smith" │20 │

251+└──────────┴────────┴───────────┴───────────────┘

251252```

252253

253254### Execute Transaction Graph Expressions

@@ -270,7 +271,7 @@ TutorialD (master/main): :rollback

270271

271272```

272273TutorialD (master/main): :branch experimental

273−TutorialD (experimental): employee:=relation{name Text, salary Int}

274+TutorialD (experimental): employee:=relation{name Text, salary Integer}

274275TutorialD (experimental): :commit

275276```

276277

docs/tutd_tutorial.markdown+37−1

@@ -197,7 +197,7 @@ TutorialD (master/main): :showexpr s{all but city}

197197└────────┴───────────┴───────────────┘

198198```

199199

200−Projection attributes can also be derived from a relational expression using `all from`:

200+Projection attributes can be derived from a relational expression using `all from`:

201201

202202```

203203TutorialD (master/main): :showexpr (s join sp){all from s}

@@ -213,6 +213,42 @@ TutorialD (master/main): :showexpr (s join sp){all from s}

213213

214214Above, we join `s` and `sp` but project the result back onto the attributes of `s`.

215215

216+Projection attributes can be unioned from multiple sources using `union of`:

217+

218+```

219+TutorialD (master/main): :showexpr (s join sp){union of {all from s} {all but p#}}

220+┌──────────┬────────────┬────────┬───────────┬───────────────┐

221+│city::Text│qty::Integer│s#::Text│sname::Text│status::Integer│

222+├──────────┼────────────┼────────┼───────────┼───────────────┤

223+│"Paris" │400 │"S2" │"Jones" │10 │

224+│"London" │400 │"S1" │"Smith" │20 │

225+│"Paris" │200 │"S3" │"Blake" │30 │

226+│"London" │200 │"S4" │"Clark" │20 │

227+│"London" │200 │"S1" │"Smith" │20 │

228+│"Paris" │300 │"S2" │"Jones" │10 │

229+│"London" │100 │"S1" │"Smith" │20 │

230+│"London" │300 │"S4" │"Clark" │20 │

231+│"London" │300 │"S1" │"Smith" │20 │

232+│"London" │400 │"S4" │"Clark" │20 │

233+└──────────┴────────────┴────────┴───────────┴───────────────┘

234+```

235+

236+Here, after joining `s` and `p`, the union of all attributes from `s` and all attributes from `p` except for `p#` are returned.all

237+

238+Finally, projection attributes can be intersected using `intersection of`:

239+

240+```

241+TutorialD (master/main): :showexpr (s join sp){intersection of {all from s} {all from p}}

242+┌──────────┐

243+│city::Text│

244+├──────────┤

245+│"London" │

246+│"Paris" │

247+└──────────┘

248+```

249+

250+Here, after joining `s` and `p`, we project on the intersection of attributes from `s` and `p` which happens to be `city`.

251+

216252#### Restriction

217253

218254Restriction is applied using a "where" clause, much like in SQL.

project-m36.cabal+29−19

@@ -34,7 +34,7 @@ Flag haskell-scripting

3434 Default: True

3535

3636Library

37− Build-Depends: base>=4.8 && < 4.15, ghc-paths, mtl, containers, unordered-containers, hashable, haskeline, directory, MonadRandom, random-shuffle, uuid >= 1.3.12, cassava >= 0.4.5.1 && < 0.6, text, bytestring, deepseq, deepseq-generics, vector, parallel, monad-parallel, exceptions, transformers, gnuplot, filepath, zlib, directory, 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, list-t, stm-containers >= 0.2.15, foldl, optparse-applicative, Glob, cryptohash-sha256, text-manipulate >= 0.2.0.1 && < 0.3, winery, curryer, network, async

37+ Build-Depends: base>=4.8 && < 4.15, ghc-paths, mtl, containers, unordered-containers, hashable, haskeline, directory, MonadRandom, random-shuffle, uuid >= 1.3.12, cassava >= 0.4.5.1 && < 0.6, text, bytestring, deepseq, deepseq-generics, vector, parallel, monad-parallel, exceptions, transformers, gnuplot, filepath, zlib, directory, 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, list-t, stm-containers >= 0.2.15, foldl, optparse-applicative, Glob, cryptohash-sha256, text-manipulate >= 0.2.0.1 && < 0.3, winery, curryer, network, async, vector-instances

3838 if flag(haskell-scripting)

3939 Build-Depends: ghc >= 8.2 && < 8.11

4040 CPP-Options: -DPM36_HASKELL_SCRIPTING

@@ -182,7 +182,8 @@ Executable tutd

182182 stm-containers >= 1.0.0,

183183 list-t,

184184 parser-combinators,

185− curryer

185+ curryer,

186+ prettyprinter

186187 Other-Modules: TutorialD.Interpreter,

187188 TutorialD.Interpreter.Base,

188189 TutorialD.Interpreter.DatabaseContextExpr,

@@ -201,6 +202,7 @@ Executable tutd

201202 TutorialD.Interpreter.SchemaOperator,

202203 TutorialD.Interpreter.TransGraphRelationalOperator,

203204 TutorialD.Interpreter.SchemaOperator

205+ TutorialD.Printer

204206 main-is: TutorialD/tutd.hs

205207 CC-Options: -fPIC

206208 GHC-Options: -Wall -threaded

@@ -262,7 +264,7 @@ Executable bigrel

262264

263265Common commontest

264266 Default-Language: Haskell2010

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

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

266268 Default-Extensions: OverloadedStrings

267269 GHC-Options: -Wall -threaded

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

@@ -282,18 +284,19 @@ Test-Suite test-tutoriald

282284 import: commontest

283285 type: exitcode-stdio-1.0

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

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

287+ Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer

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

286289

287290Test-Suite test-tutoriald-atomfunctionscript

288291 import: commontest

289292 type: exitcode-stdio-1.0

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

293+ Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer

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

292295

293296Test-Suite test-tutoriald-databasecontextfunctionscript

294297 import: commontest

295298 type: exitcode-stdio-1.0

296− Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.SchemaOperator

299+ Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer

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

298301

299302Test-Suite test-relation

@@ -310,7 +313,7 @@ Test-Suite test-transactiongraph-persist

310313 import: commontest

311314 type: exitcode-stdio-1.0

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

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

316+ Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Printer

314317

315318Test-Suite test-relation-import-csv

316319 import: commontest

@@ -321,8 +324,7 @@ Test-Suite test-tutoriald-import-tutoriald

321324 import: commontest

322325 type: exitcode-stdio-1.0

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

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

325−

327+ Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Printer

326328

327329Test-Suite test-relation-export-csv

328330 import: commontest

@@ -335,6 +337,12 @@ Test-Suite test-transactiongraph-merge

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

336338

337339

340+Test-Suite test-prettyprinter

341+ import: commontest

342+ type: exitcode-stdio-1.0

343+ main-is: test/TutorialD/Printer.hs

344+ Other-Modules: TutorialD.Printer, TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types

345+

338346benchmark bench

339347 import: commontest

340348 type: exitcode-stdio-1.0

@@ -395,13 +403,14 @@ Test-Suite test-scripts

395403 import: commontest

396404 type: exitcode-stdio-1.0

397405 main-is: test/scripts.hs

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

406+ 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, TutorialD.Printer

399407

400408Executable project-m36-websocket-server

401409 Default-Language: Haskell2010

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

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

411+ 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, TutorialD.Printer

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

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

413+ 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, TutorialD.Printer

405414 GHC-Options: -Wall -threaded

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

407416 Default-Extensions: OverloadedStrings

@@ -410,7 +419,7 @@ Test-Suite test-websocket-server

410419 import: commontest

411420 type: exitcode-stdio-1.0

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

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

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

414423

415424Test-Suite test-isomorphic-schemas

416425 import: commontest

@@ -421,7 +430,7 @@ Test-Suite test-atomable

421430 import: commontest

422431 type: exitcode-stdio-1.0

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

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

433+ Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.SchemaOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Printer

425434

426435Test-Suite test-multiprocess-access

427436 import: commontest

@@ -432,7 +441,7 @@ Test-Suite test-transactiongraph-automerge

432441 import: commontest

433442 type: exitcode-stdio-1.0

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

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

444+ Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.SchemaOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Printer

436445

437446Test-Suite test-tupleable

438447 import: commontest

@@ -448,7 +457,7 @@ Test-Suite test-client-simple

448457Executable handles

449458 Default-Language: Haskell2010

450459 Default-Extensions: OverloadedStrings

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

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

452461 main-is: benchmark/Handles.hs

453462 Other-Modules: TutorialD.Interpreter,

454463 TutorialD.Interpreter.Base,

@@ -467,13 +476,14 @@ Executable handles

467476 TutorialD.Interpreter.TransGraphRelationalOperator,

468477 TutorialD.Interpreter.TransactionGraphOperator,

469478 TutorialD.Interpreter.Types

479+ TutorialD.Printer

470480 GHC-Options: -Wall -threaded -rtsopts

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

472482 if flag(profiler)

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

474484

475485Test-Suite test-dataframe

476− import: commontest

486+ import: commontest

487+ type: exitcode-stdio-1.0

477488 Main-Is: test/DataFrame.hs

478− type: exitcode-stdio-1.0

479−

489+ Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.SchemaOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Printer

src/bin/ProjectM36/Server/RemoteCallTypes/Json.hs+3

@@ -99,6 +99,8 @@ instance ToJSON Atom where

9999 "val" .= i ]

100100 toJSON atom@(RelationAtom i) = object [ "type" .= atomTypeForAtom atom,

101101 "val" .= i ]

102+ toJSON atom@(RelationalExprAtom i) = object [ "type" .= atomTypeForAtom atom,

103+ "val" .= i ]

102104 toJSON (ConstructedAtom dConsName atomtype atomlist) = object [

103105 "dataconstructorname" .= dConsName,

104106 "type" .= toJSON atomtype,

@@ -126,6 +128,7 @@ instance FromJSON Atom where

126128 Left err -> fail ("Failed to parse base64-encoded ByteString: " ++ err)

127129 Right bs -> pure (ByteStringAtom bs)

128130 BoolAtomType -> BoolAtom <$> o .: "val"

131+ RelationalExprAtomType -> RelationalExprAtom <$> o .: "val"

129132

130133instance ToJSON Notification

131134instance FromJSON Notification

src/bin/TutorialD/Interpreter/Base.hs+8−2

@@ -137,9 +137,9 @@ semi = symbol ";"

137137

138138integer :: Parser Integer

139139#if MIN_VERSION_megaparsec(6,0,0)

140−integer = Lex.signed spaceConsumer Lex.decimal

140+integer = Lex.signed (pure ()) Lex.decimal <* spaceConsumer

141141#else

142−integer = Lex.signed spaceConsumer Lex.integer

142+integer = Lex.signed (pure ()) Lex.integer <* spaceConsumer

143143#endif

144144

145145natural :: Parser Integer

@@ -222,3 +222,9 @@ utcTimeP = do

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

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

224224 Just stamp' -> pure stamp'

225+

226+

227+colonOp :: Text -> Parser ()

228+colonOp opStr = do

229+ _ <- string opStr <* (void spaceChar <|> eof) <* spaceConsumer

230+ pure ()

src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+33−16

@@ -1,13 +1,16 @@

11{-# LANGUAGE GADTs #-}

22module TutorialD.Interpreter.RODatabaseContextOperator where

33import ProjectM36.Base

4+import ProjectM36.Relation

45import qualified ProjectM36.DataFrame as DF

56import ProjectM36.Error

7+import ProjectM36.Tuple

68import ProjectM36.InclusionDependency

79import qualified ProjectM36.Client as C

810import TutorialD.Interpreter.Base

911import TutorialD.Interpreter.RelationalExpr

1012import TutorialD.Interpreter.DatabaseContextExpr

13+import TutorialD.Printer

1114import Control.Monad.State

1215import qualified Data.Text as T

1316import ProjectM36.Relation.Show.Gnuplot

@@ -19,7 +22,7 @@ data RODatabaseContextOperator where

1922 ShowRelation :: RelationalExpr -> RODatabaseContextOperator

2023 PlotRelation :: RelationalExpr -> RODatabaseContextOperator

2124 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator

22− ShowConstraint :: StringType -> RODatabaseContextOperator

25+ ShowConstraints :: StringType -> RODatabaseContextOperator

2326 ShowPlan :: DatabaseContextExpr -> RODatabaseContextOperator

2427 ShowTypes :: RODatabaseContextOperator

2528 ShowRelationVariables :: RODatabaseContextOperator

@@ -31,44 +34,44 @@ data RODatabaseContextOperator where

3134

3235typeP :: Parser RODatabaseContextOperator

3336typeP = do

34− reservedOp ":type"

37+ colonOp ":type"

3538 ShowRelationType <$> relExprP

3639

3740showRelP :: Parser RODatabaseContextOperator

3841showRelP = do

39− reservedOp ":showexpr"

42+ colonOp ":showexpr"

4043 ShowRelation <$> relExprP

4144

4245showPlanP :: Parser RODatabaseContextOperator

4346showPlanP = do

44− reservedOp ":showplan"

47+ colonOp ":showplan"

4548 ShowPlan <$> databaseContextExprP

4649

4750showTypesP :: Parser RODatabaseContextOperator

48−showTypesP = reserved ":showtypes" >> pure ShowTypes

51+showTypesP = colonOp ":showtypes" >> pure ShowTypes

4952

5053showRelationVariables :: Parser RODatabaseContextOperator

51−showRelationVariables = reserved ":showrelvars" >> pure ShowRelationVariables

54+showRelationVariables = colonOp ":showrelvars" >> pure ShowRelationVariables

5255

5356showAtomFunctionsP :: Parser RODatabaseContextOperator

54−showAtomFunctionsP = reserved ":showatomfunctions" >> pure ShowAtomFunctions

57+showAtomFunctionsP = colonOp ":showatomfunctions" >> pure ShowAtomFunctions

5558

5659showDatabaseContextFunctionsP :: Parser RODatabaseContextOperator

57−showDatabaseContextFunctionsP = reserved ":showdatabasecontextfunctions" >> pure ShowDatabaseContextFunctions

60+showDatabaseContextFunctionsP = colonOp ":showdatabasecontextfunctions" >> pure ShowDatabaseContextFunctions

5861

5962quitP :: Parser RODatabaseContextOperator

6063quitP = do

61− reservedOp ":quit"

64+ colonOp ":quit"

6265 return Quit

6366

6467showConstraintsP :: Parser RODatabaseContextOperator

6568showConstraintsP = do

66− reservedOp ":constraints"

67− ShowConstraint <$> option "" identifier

69+ colonOp ":constraints"

70+ ShowConstraints <$> option "" identifier

6871

6972plotRelExprP :: Parser RODatabaseContextOperator

7073plotRelExprP = do

71− reserved ":plotexpr"

74+ colonOp ":plotexpr"

7275 PlotRelation <$> relExprP

7376

7477roDatabaseContextOperatorP :: Parser RODatabaseContextOperator

@@ -106,15 +109,16 @@ evalRODatabaseContextOp sessionId conn (PlotRelation expr) = do

106109 err <- plotRelation rel

107110 when (isJust err) $ print err

108111

109−evalRODatabaseContextOp sessionId conn (ShowConstraint name) = do

112+evalRODatabaseContextOp sessionId conn (ShowConstraints name) = do

110113 eIncDeps <- C.inclusionDependencies sessionId conn

111114 let val = case eIncDeps of

112115 Left err -> Left err

113116 Right incDeps -> case name of

114− "" -> inclusionDependenciesAsRelation incDeps

117+ "" -> inclusionDependenciesAsRelation incDeps >>= renderRelExprsInIncDeps

115118 depName -> case M.lookup depName incDeps of

116119 Nothing -> Left (InclusionDependencyNameNotInUseError depName)

117− Just dep -> inclusionDependenciesAsRelation (M.singleton depName dep)

120+ Just dep ->

121+ inclusionDependenciesAsRelation (M.singleton depName dep) >>= renderRelExprsInIncDeps

118122 pure $ case val of

119123 Left err -> DisplayErrorResult (T.pack (show err))

120124 Right rel -> DisplayRelationResult rel

@@ -164,7 +168,7 @@ interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseCo

164168

165169showDataFrameP :: Parser RODatabaseContextOperator

166170showDataFrameP = do

167− reservedOp ":showdataframe"

171+ colonOp ":showdataframe"

168172 relExpr <- relExprP

169173 reservedOp "orderby"

170174 attrOrdersExpr <- attrOrdersExprP

@@ -191,3 +195,16 @@ attrOrderExprP = DF.AttributeOrderExpr <$> identifier <*> orderP

191195

192196orderP :: Parser DF.Order

193197orderP = try (reservedOp "ascending" >> pure DF.AscendingOrder) <|> try (reservedOp "descending" >> pure DF.DescendingOrder) <|> pure DF.AscendingOrder

198+

199+-- render RelationalExprAtoms as TutorialD

200+renderRelExprsInIncDeps :: Relation -> Either RelationalError Relation

201+renderRelExprsInIncDeps = relMogrify tupMapper attrs

202+ where

203+ tupMapper tup = pure $ mkRelationTupleFromMap (M.map mapper (tupleToMap tup))

204+ mapper (RelationalExprAtom expr) = TextAtom (T.pack (show (prettyRelationalExpr expr)))

205+ mapper atom = atom

206+ attrs = C.attributesFromList [Attribute "name" TextAtomType,

207+ Attribute "sub" TextAtomType,

208+ Attribute "super" TextAtomType

209+ ]

210+

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

@@ -20,9 +20,18 @@ attributeListP :: RelationalMarkerExpr a => Parser (AttributeNamesBase a)

2020attributeListP =

2121 (reservedOp "all but" >>

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

23+

2324 (reservedOp "all from" >>

2425 RelationalExprAttributeNames <$> relExprP) <|>

25− (AttributeNames . S.fromList <$> sepBy attributeNameP comma)

26+

27+ (reservedOp "union of" >>

28+ UnionAttributeNames <$> braces attributeListP <*> braces attributeListP) <|>

29+

30+ (reservedOp "intersection of" >>

31+ IntersectAttributeNames <$> braces attributeListP <*> braces attributeListP) <|>

32+

33+ (AttributeNames . S.fromList <$> sepBy attributeNameP comma)

34+

2635

2736makeRelationP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

2837makeRelationP = do

@@ -102,7 +111,11 @@ ungroupP = do

102111extendP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

103112extendP = do

104113 reservedOp ":"

105− Extend <$> braces extendTupleExpressionP

114+ extends <- braces (sepBy extendTupleExpressionP comma)

115+ case extends of

116+ [] -> pure (Restrict TruePredicate)

117+ extends' ->

118+ pure $ \expr -> foldl (flip Extend) expr extends'

106119

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

108121semijoinP = do

@@ -129,7 +142,8 @@ relOperators = [

129142 [InfixL antijoinP],

130143 [InfixL (reservedOp "union" >> return Union)],

131144 [InfixL (reservedOp "minus" >> return Difference)],

132− [InfixN (reservedOp "=" >> return Equals)],

145+ [InfixN (reservedOp "=" >> return Equals),

146+ InfixN (reservedOp "/=" >> return NotEquals)],

133147 [Postfix extendP]

134148 ]

135149

@@ -200,7 +214,7 @@ consumeAtomExprP consume = try functionAtomExprP <|>

200214 try (parens (constructedAtomExprP True)) <|>

201215 constructedAtomExprP consume <|>

202216 attributeAtomExprP <|>

203− nakedAtomExprP <|>

217+ try nakedAtomExprP <|>

204218 relationalAtomExprP

205219

206220attributeAtomExprP :: Parser (AtomExprBase a)

@@ -242,8 +256,12 @@ integerAtomP = IntegerAtom <$> integer

242256

243257boolAtomP :: Parser Atom

244258boolAtomP = do

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

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

259+ v <- identifier

260+ if v == "t" || v == "f" then

261+ pure $ BoolAtom (v == "t")

262+ else

263+ fail "invalid boolAtom"

264+

247265

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

249267relationAtomExprP = RelationAtomExpr <$> makeRelationP

src/bin/TutorialD/Printer.hsnew file+165

@@ -0,0 +1,165 @@

1+{-# OPTIONS_GHC -fno-warn-orphans #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE TypeApplications #-}

6+module TutorialD.Printer where

7+import ProjectM36.Base

8+import ProjectM36.Attribute hiding (null)

9+import Data.Text.Prettyprint.Doc

10+import qualified Data.Set as S hiding (fromList)

11+import qualified Data.Vector as V

12+import qualified Data.Map.Strict as M

13+import Data.Time.Calendar

14+import Data.Time.Clock.POSIX

15+import qualified Data.ByteString.Base64 as B64

16+import qualified Data.Text.Encoding as TE

17+

18+instance Pretty Atom where

19+ pretty (IntegerAtom x) = pretty x

20+ pretty (IntAtom x) = "int" <> parensList [pretty x]

21+ pretty (DoubleAtom x) = pretty x

22+ pretty (TextAtom x) = dquotes (pretty x)

23+ pretty (DayAtom x) = "fromGregorian" <> parensList [pretty a, pretty b, pretty c]

24+ where

25+ (a,b,c) = toGregorian x

26+ pretty (DateTimeAtom time) = "dateTimeFromEpochSeconds" <> parensList [pretty @Integer (round (utcTimeToPOSIXSeconds time))]

27+ pretty (ByteStringAtom bs) = "bytestring" <> parensList [dquotes (pretty (TE.decodeUtf8 (B64.encode bs)))]

28+ pretty (BoolAtom x) = if x then "t" else "f"

29+ pretty (RelationAtom x) = pretty x

30+ pretty (RelationalExprAtom re) = pretty re

31+ pretty (ConstructedAtom n _ as) = pretty n <+> prettyList as

32+

33+instance Pretty AtomExpr where

34+ pretty (AttributeAtomExpr attrName) = pretty attrName

35+ pretty (NakedAtomExpr atom) = pretty atom

36+ pretty (FunctionAtomExpr atomFuncName' atomExprs _) = pretty atomFuncName' <> prettyAtomExprsAsArguments atomExprs

37+ pretty (RelationAtomExpr relExpr) = pretty relExpr

38+ pretty (ConstructedAtomExpr dName [] _) = pretty dName

39+ pretty (ConstructedAtomExpr dName atomExprs _) = pretty dName <+> hsep (map prettyAtomExpr atomExprs)

40+

41+prettyAtomExpr :: AtomExpr -> Doc ann

42+prettyAtomExpr atomExpr =

43+ case atomExpr of

44+ AttributeAtomExpr attrName -> "@" <> pretty attrName

45+ ConstructedAtomExpr dConsName [] () -> pretty dConsName

46+ ConstructedAtomExpr dConsName atomExprs () -> parens (pretty dConsName <+> hsep (map prettyAtomExpr atomExprs))

47+ _ -> pretty atomExpr

48+

49+prettyAtomExprsAsArguments :: [AtomExpr] -> Doc ann

50+prettyAtomExprsAsArguments = align . parensList . map addAt

51+ where addAt (atomExpr :: AtomExpr) =

52+ case atomExpr of

53+ AttributeAtomExpr attrName -> "@" <> pretty attrName

54+ _ -> pretty atomExpr

55+

56+instance Pretty TupleExpr where

57+ pretty (TupleExpr map') = "tuple" <> bracesList (Prelude.map (\(attrName,atom)-> pretty attrName <+> pretty atom) (M.toList map'))

58+

59+instance Pretty RelationTuple where

60+ pretty (RelationTuple attrs atoms) = "tuple" <> bracesList (zipWith (\x y-> pretty x <+> pretty y) (V.toList (attributeNames attrs)) (V.toList atoms))

61+

62+instance Pretty Relation where

63+ pretty (Relation attrs tupSet) | attrs == V.empty && null (asList tupSet) = "false"

64+ pretty (Relation attrs tupSet) | attrs == V.empty && asList tupSet == [RelationTuple V.empty V.empty] = "true"

65+ pretty (Relation attrs tupSet) = "relation" <> prettyBracesList (V.toList attrs) <> prettyBracesList (asList tupSet)

66+

67+instance Pretty Attribute where

68+ pretty (Attribute n aTy) = pretty n <+> pretty (show aTy) -- workaround

69+

70+instance Pretty RelationalExpr where

71+ pretty (RelationVariable n _) = pretty n

72+ pretty (ExistingRelation r) = pretty r

73+ pretty (NotEquals a b) = pretty' a <+> "!=" <+> pretty' b

74+ pretty (Equals a b) = pretty' a <+> "==" <+> pretty' b

75+ pretty (Project ns r) = pretty' (ignoreProjects r) <> pretty ns

76+ pretty (Extend ext r) = collectExtends r <> pretty ext <> "}"

77+ pretty (MakeRelationFromExprs Nothing (TupleExprs () tupExprs)) = "relation" <> prettyBracesList tupExprs

78+ pretty (MakeRelationFromExprs (Just attrExprs) (TupleExprs () tupExprs)) = "relation" <> prettyBracesList attrExprs <> prettyBracesList tupExprs

79+ pretty (MakeStaticRelation attrs tupSet) = "relation" <> prettyBracesList (V.toList attrs) <> prettyBracesList (asList tupSet)

80+ pretty (Union a b) = parens $ pretty' a <+> "union" <+> pretty' b

81+ pretty (Join a b) = parens $ pretty' a <+> "join" <+> pretty' b

82+ pretty (Rename n1 n2 relExpr) = parens $ pretty relExpr <+> "rename" <+> braces (pretty n1 <+> "as" <+> pretty n2)

83+ pretty (Difference a b) = parens $ pretty' a <+> "minus" <+> pretty' b

84+ pretty (Group attrNames attrName relExpr) = parens $ pretty relExpr <+> "group" <+> parens (pretty attrNames <+> "as" <+> pretty attrName)

85+ pretty (Ungroup attrName relExpr) = parens $ pretty' relExpr <+> "ungroup" <+> pretty attrName

86+ pretty (Restrict resPreExpr relExpr) = parens $ pretty' relExpr <+> "where" <+> pretty resPreExpr

87+ pretty (With pairs a) = "with" <+> parensList (map (\(name,expr)-> pretty name <+> "as" <+> pretty expr) pairs) <+> pretty' a

88+

89+-- relvar:{a:=?}:{b:=?}:... in ADTs => relvar:{a:=?, b:=?, ...} in Doc ann

90+collectExtends :: RelationalExpr -> Doc ann

91+collectExtends (Extend ext r) = collectExtends r <> pretty ext <> ", "

92+collectExtends r = pretty r <> ":{"

93+

94+--relvar{a,b,c,...}{a,b,...}..{a} => relvar{a}

95+ignoreProjects :: RelationalExpr -> RelationalExpr

96+ignoreProjects (Project _ r) = ignoreProjects r

97+ignoreProjects r = r

98+

99+prettyRelationalExpr :: RelationalExpr -> Doc n

100+prettyRelationalExpr (RelationVariable n _) = pretty n

101+prettyRelationalExpr r = parens (pretty r)

102+

103+pretty' :: RelationalExpr -> Doc n

104+pretty' = prettyRelationalExpr

105+

106+instance Pretty AttributeNames where

107+ pretty (AttributeNames attrNames) = prettyBracesList (S.toList attrNames)

108+ pretty (InvertedAttributeNames attrNames) = braces $ "all but" <+> concatWith (surround ", ") (map pretty (S.toList attrNames))

109+ pretty (RelationalExprAttributeNames relExpr) = braces $ "all from" <+> pretty relExpr

110+ pretty (UnionAttributeNames aAttrNames bAttrNames) = braces ("union of" <+> pretty aAttrNames <+> pretty bAttrNames)

111+ pretty (IntersectAttributeNames aAttrNames bAttrNames) = braces ("intersection of" <+> pretty aAttrNames <+> pretty bAttrNames)

112+

113+instance Pretty AttributeExpr where

114+ pretty (NakedAttributeExpr attr) = pretty attr

115+ pretty (AttributeAndTypeNameExpr name typeCons _) = pretty name <+> pretty typeCons

116+

117+instance Pretty TypeConstructor where

118+ pretty (ADTypeConstructor tcName []) = pretty tcName

119+ pretty (ADTypeConstructor tcName tConsArgs) = pretty tcName <+> hsep (map pretty tConsArgs)

120+ pretty (PrimitiveTypeConstructor tcName atomType') = pretty tcName <+> pretty atomType'

121+ pretty (RelationAtomTypeConstructor attrExprs) = "relation" <> prettyBracesList attrExprs

122+ pretty (TypeVariable x) = pretty x

123+

124+instance Pretty AtomType where

125+ pretty IntAtomType = "Int"

126+ pretty IntegerAtomType = "Integer"

127+ pretty DoubleAtomType = "Double"

128+ pretty TextAtomType = "Text"

129+ pretty DayAtomType = "Day"

130+ pretty DateTimeAtomType = "DateTime"

131+ pretty ByteStringAtomType = "ByteString"

132+ pretty BoolAtomType = "Bool"

133+ pretty (RelationAtomType attrs) = "relation " <+> prettyBracesList (V.toList attrs)

134+ pretty (ConstructedAtomType tcName tvMap) = pretty tcName <+> hsep (map pretty (M.toList tvMap)) --order matters

135+ pretty RelationalExprAtomType = "RelationalExpr"

136+ pretty (TypeVariableType x) = pretty x

137+

138+instance Pretty ExtendTupleExpr where

139+ pretty (AttributeExtendTupleExpr attrName atomExpr) = pretty attrName <> ":=" <> pretty atomExpr

140+

141+

142+instance Pretty RestrictionPredicateExpr where

143+ pretty TruePredicate = "true"

144+ pretty (AndPredicate a b) = pretty a <+> "and" <+> pretty b

145+ pretty (OrPredicate a b) = pretty a <+> "or" <+> pretty b

146+ pretty (NotPredicate a) = "not" <+> pretty a

147+ pretty (RelationalExprPredicate relExpr) = pretty relExpr

148+ pretty (AtomExprPredicate atomExpr) = pretty atomExpr

149+ pretty (AttributeEqualityPredicate attrName atomExpr) = pretty attrName <> "=" <> pretty atomExpr

150+

151+instance Pretty WithNameExpr where

152+ pretty (WithNameExpr name _) = pretty name

153+

154+bracesList :: [Doc ann] -> Doc ann

155+bracesList = group . encloseSep (flatAlt "{ " "{") (flatAlt " }" "}") ", "

156+

157+prettyBracesList :: Pretty a => [a] -> Doc ann

158+prettyBracesList = align . bracesList . map pretty

159+

160+parensList :: [Doc ann] -> Doc ann

161+parensList = group . encloseSep (flatAlt "( " "(") (flatAlt " )" ")") ", "

162+

163+prettyParensList :: Pretty a => [a] -> Doc ann

164+prettyParensList = align . parensList . map pretty

165+

src/lib/ProjectM36/Arbitrary.hs+5

@@ -9,6 +9,7 @@ import ProjectM36.AtomType

99import ProjectM36.Attribute (atomType)

1010import ProjectM36.DataConstructorDef as DCD

1111import ProjectM36.DataTypes.Interval

12+import ProjectM36.Relation

1213import qualified Data.Vector as V

1314import Data.Text (Text)

1415import Test.QuickCheck

@@ -48,6 +49,10 @@ arbitrary' ByteStringAtomType =

4849

4950arbitrary' BoolAtomType =

5051 Right . BoolAtom <$> lift (arbitrary :: Gen Bool)

52+

53+arbitrary' RelationalExprAtomType =

54+ pure (Right (RelationalExprAtom (ExistingRelation relationTrue))) -- don't bother with arbitrary relational expressions

55+

5156arbitrary' constructedAtomType@(ConstructedAtomType tcName tvMap)

5257 --special-casing for Interval type

5358 | isIntervalAtomType constructedAtomType = createArbitraryInterval (intervalSubType constructedAtomType)

src/lib/ProjectM36/Atom.hs+1

@@ -20,6 +20,7 @@ atomToText (DayAtom i) = (T.pack . show) i

2020atomToText (DateTimeAtom i) = (T.pack . show) i

2121atomToText (ByteStringAtom i) = (T.pack . show) i

2222atomToText (BoolAtom i) = (T.pack . show) i

23+atomToText (RelationalExprAtom re) = (T.pack . show) re

2324

2425atomToText (RelationAtom i) = (T.pack . show) i

2526atomToText (ConstructedAtom dConsName typ atoms)

src/lib/ProjectM36/AtomType.hs+1

@@ -442,6 +442,7 @@ isResolvedType typ =

442442 DateTimeAtomType -> True

443443 ByteStringAtomType -> True

444444 BoolAtomType -> True

445+ RelationalExprAtomType -> True

445446 RelationAtomType attrs -> isResolvedAttributes attrs

446447 ConstructedAtomType _ tvMap -> all isResolvedType (M.elems tvMap)

447448 TypeVariableType _ -> False

src/lib/ProjectM36/Atomable.hs+1

@@ -235,6 +235,7 @@ typeToTypeConstructor x@DayAtomType = PrimitiveTypeConstructor "Day" x

235235typeToTypeConstructor x@DateTimeAtomType = PrimitiveTypeConstructor "DateTime" x

236236typeToTypeConstructor x@ByteStringAtomType = PrimitiveTypeConstructor "ByteString" x

237237typeToTypeConstructor x@BoolAtomType = PrimitiveTypeConstructor "Bool" x

238+typeToTypeConstructor x@RelationalExprAtomType = PrimitiveTypeConstructor "RelationalExpr" x

238239typeToTypeConstructor (RelationAtomType attrs)

239240 = RelationAtomTypeConstructor $ map attrToAttrExpr $ V.toList attrs

240241 where

src/lib/ProjectM36/Base.hs+59−26

@@ -24,6 +24,7 @@ import Data.Time.Calendar (Day)

2424import Data.Typeable

2525import Data.ByteString (ByteString)

2626import qualified Data.List.NonEmpty as NE

27+import Data.Vector.Instances ()

2728

2829type StringType = Text

2930

@@ -39,8 +40,9 @@ data Atom = IntegerAtom Integer |

3940 ByteStringAtom ByteString |

4041 BoolAtom Bool |

4142 RelationAtom Relation |

43+ RelationalExprAtom RelationalExpr | --used for returning inc deps

4244 ConstructedAtom DataConstructorName AtomType [Atom]

43− deriving (Eq, Show, Typeable, NFData, Generic)

45+ deriving (Eq, Show, Typeable, NFData, Generic, Read)

4446

4547instance Hashable Atom where

4648 hashWithSalt salt (ConstructedAtom dConsName _ atoms) = salt `hashWithSalt` atoms

@@ -54,6 +56,7 @@ instance Hashable Atom where

5456 hashWithSalt salt (ByteStringAtom bs) = salt `hashWithSalt` bs

5557 hashWithSalt salt (BoolAtom b) = salt `hashWithSalt` b

5658 hashWithSalt salt (RelationAtom r) = salt `hashWithSalt` r

59+ hashWithSalt salt (RelationalExprAtom re) = salt `hashWithSalt` re

5760

5861-- I suspect the definition of ConstructedAtomType with its name alone is insufficient to disambiguate the cases; for example, one could create a type named X, remove a type named X, and re-add it using different constructors. However, as long as requests are served from only one DatabaseContext at-a-time, the type name is unambiguous. This will become a problem for time-travel, however.

5962-- | The AtomType uniquely identifies the type of a atom.

@@ -67,13 +70,15 @@ data AtomType = IntAtomType |

6770 BoolAtomType |

6871 RelationAtomType Attributes |

6972 ConstructedAtomType TypeConstructorName TypeVarMap |

73+ RelationalExprAtomType |

7074 TypeVariableType TypeVarName

7175 --wildcard used in Atom Functions and tuples for data constructors which don't provide all arguments to the type constructor

72− deriving (Eq, NFData, Generic, Show)

76+ deriving (Eq, NFData, Generic, Show, Read, Hashable)

7377

7478instance Ord AtomType where

7579 compare = undefined

76−

80+

81+-- this should probably be an ordered dictionary in order to be able to round-trip these arguments

7782type TypeVarMap = M.Map TypeVarName AtomType

7883

7984instance Hashable TypeVarMap where

@@ -88,7 +93,7 @@ isRelationAtomType _ = False

8893type AttributeName = StringType

8994

9095-- | A relation's type is composed of attribute names and types.

91−data Attribute = Attribute AttributeName AtomType deriving (Eq, Show, Generic, NFData)

96+data Attribute = Attribute AttributeName AtomType deriving (Eq, Show, Read, Generic, NFData)

9297

9398instance Hashable Attribute where

9499 hashWithSalt salt (Attribute attrName _) = hashWithSalt salt attrName

@@ -106,7 +111,10 @@ sortedAttributesIndices :: Attributes -> [(Int, Attribute)]

106111sortedAttributesIndices attrs = L.sortBy (\(_, Attribute name1 _) (_,Attribute name2 _) -> compare name1 name2) $ V.toList (V.indexed attrs)

107112

108113-- | The relation's tuple set is the body of the relation.

109−newtype RelationTupleSet = RelationTupleSet { asList :: [RelationTuple] } deriving (Hashable, Show, Generic)

114+newtype RelationTupleSet = RelationTupleSet { asList :: [RelationTuple] } deriving (Hashable, Show, Generic, Read)

115+

116+instance Read Relation where

117+ readsPrec = error "relation read not supported"

110118

111119instance Eq RelationTupleSet where

112120 set1 == set2 = hset set1 == hset set2

@@ -131,7 +139,7 @@ instance Hashable RelationTuple where

131139 sortedTupVec = V.map (\(index, _) -> tupVec V.! index) $ V.fromList sortedAttrsIndices

132140

133141-- | A tuple is a set of attributes mapped to their 'Atom' values.

134−data RelationTuple = RelationTuple Attributes (V.Vector Atom) deriving (Show, Generic)

142+data RelationTuple = RelationTuple Attributes (V.Vector Atom) deriving (Show, Read, Generic)

135143

136144instance Eq RelationTuple where

137145 (==) tuple1@(RelationTuple attrs1 _) tuple2@(RelationTuple attrs2 _) = attributesEqual attrs1 attrs2 && atomsEqual

@@ -201,10 +209,12 @@ data RelationalExprBase a =

201209 --Summarize :: AtomExpr -> AttributeName -> RelationalExpr -> RelationalExpr -> RelationalExpr -- a special case of Extend

202210 --Evaluate relationalExpr with scoped views

203211 With [(WithNameExprBase a, RelationalExprBase a)] (RelationalExprBase a)

204− deriving (Show, Eq, Generic, NFData, Foldable, Functor, Traversable)

205−

212+ deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable)

213+

214+instance Hashable RelationalExpr

215+

206216data WithNameExprBase a = WithNameExpr RelVarName a

207− deriving (Show, Eq, Generic, NFData, Foldable, Functor, Traversable)

217+ deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable, Hashable)

208218

209219type WithNameExpr = WithNameExprBase ()

210220

@@ -226,15 +236,15 @@ type TypeVarName = StringType

226236-- | Metadata definition for type constructors such as @data Either a b@.

227237data TypeConstructorDef = ADTypeConstructorDef TypeConstructorName [TypeVarName] |

228238 PrimitiveTypeConstructorDef TypeConstructorName AtomType

229− deriving (Show, Generic, Eq, NFData)

239+ deriving (Show, Generic, Eq, NFData, Hashable, Read)

230240

231241-- | Found in data constructors and type declarations: Left (Either Int Text) | Right Int

232242type TypeConstructor = TypeConstructorBase ()

233243data TypeConstructorBase a = ADTypeConstructor TypeConstructorName [TypeConstructor] |

234− PrimitiveTypeConstructor TypeConstructorName AtomType |

235− RelationAtomTypeConstructor [AttributeExprBase a] |

236− TypeVariable TypeVarName

237− deriving (Show, Generic, Eq, NFData)

244+ PrimitiveTypeConstructor TypeConstructorName AtomType |

245+ RelationAtomTypeConstructor [AttributeExprBase a] |

246+ TypeVariable TypeVarName

247+ deriving (Show, Generic, Eq, NFData, Hashable, Read)

238248

239249type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)]

240250

@@ -244,13 +254,13 @@ type DataConstructorName = StringType

244254type AtomTypeName = StringType

245255

246256-- | Used to define a data constructor in a type constructor context such as @Left a | Right b@

247−data DataConstructorDef = DataConstructorDef DataConstructorName [DataConstructorDefArg] deriving (Eq, Show, Generic, NFData)

257+data DataConstructorDef = DataConstructorDef DataConstructorName [DataConstructorDefArg] deriving (Eq, Show, Generic, NFData, Hashable, Read)

248258

249259type DataConstructorDefs = [DataConstructorDef]

250260

251261data DataConstructorDefArg = DataConstructorDefTypeConstructorArg TypeConstructor |

252262 DataConstructorDefTypeVarNameArg TypeVarName

253− deriving (Show, Generic, Eq, NFData)

263+ deriving (Show, Generic, Eq, NFData, Hashable, Read)

254264

255265type InclusionDependencies = M.Map IncDepName InclusionDependency

256266type RelationVariables = M.Map RelVarName GraphRefRelationalExpr

@@ -295,7 +305,7 @@ data DatabaseContext = DatabaseContext {

295305type IncDepName = StringType

296306

297307-- | Inclusion dependencies represent every possible database constraint. Constraints enforce specific, arbitrarily-complex rules to which the database context's relation variables must adhere unconditionally.

298−data InclusionDependency = InclusionDependency RelationalExpr RelationalExpr deriving (Show, Eq, Generic, NFData)

308+data InclusionDependency = InclusionDependency RelationalExpr RelationalExpr deriving (Show, Eq, Generic, NFData, Hashable, Read)

299309

300310type AttributeNameAtomExprMap = M.Map AttributeName AtomExpr

301311

@@ -304,6 +314,8 @@ type DatabaseContextExprName = StringType

304314

305315type DatabaseContextExpr = DatabaseContextExprBase ()

306316

317+instance Hashable DatabaseContextExpr

318+

307319type GraphRefDatabaseContextExpr = DatabaseContextExprBase GraphRefTransactionMarker

308320

309321-- | Database context expressions modify the database context.

@@ -333,7 +345,10 @@ data DatabaseContextExprBase a =

333345 ExecuteDatabaseContextFunction DatabaseContextFunctionName [AtomExprBase a] |

334346

335347 MultipleExpr [DatabaseContextExprBase a]

336− deriving (Show, Eq, Generic)

348+ deriving (Show, Read, Eq, Generic, NFData)

349+

350+instance Hashable (M.Map AttributeName AtomExpr) where

351+ hashWithSalt salt m = salt `hashWithSalt` M.toList m

337352

338353type ObjModuleName = StringType

339354type ObjFunctionName = StringType

@@ -353,6 +368,8 @@ type DatabaseContextIOExpr = DatabaseContextIOExprBase ()

353368

354369type RestrictionPredicateExpr = RestrictionPredicateExprBase ()

355370

371+instance Hashable RestrictionPredicateExpr

372+

356373type GraphRefRestrictionPredicateExpr = RestrictionPredicateExprBase GraphRefTransactionMarker

357374

358375-- | Restriction predicates are boolean algebra components which, when composed, indicate whether or not a tuple should be retained during a restriction (filtering) operation.

@@ -364,7 +381,7 @@ data RestrictionPredicateExprBase a =

364381 RelationalExprPredicate (RelationalExprBase a) | --type must be same as true and false relations (no attributes)

365382 AtomExprPredicate (AtomExprBase a) | --atom must evaluate to boolean

366383 AttributeEqualityPredicate AttributeName (AtomExprBase a) -- relationalexpr must result in relation with single tuple

367− deriving (Show, Eq, Generic, NFData, Foldable, Functor, Traversable)

384+ deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable)

368385

369386-- child + parent links

370387-- | A transaction graph's head name references the leaves of the transaction graph and can be used during session creation to indicate at which point in the graph commits should persist.

@@ -425,6 +442,8 @@ instance Ord Transaction where

425442

426443type AtomExpr = AtomExprBase ()

427444

445+instance Hashable AtomExpr

446+

428447type GraphRefAtomExpr = AtomExprBase GraphRefTransactionMarker

429448

430449-- | An atom expression represents an action to take when extending a relation or when statically defining a relation or a new tuple.

@@ -433,13 +452,16 @@ data AtomExprBase a = AttributeAtomExpr AttributeName |

433452 FunctionAtomExpr AtomFunctionName [AtomExprBase a] a |

434453 RelationAtomExpr (RelationalExprBase a) |

435454 ConstructedAtomExpr DataConstructorName [AtomExprBase a] a

436− deriving (Eq,Show,Generic, NFData, Foldable, Functor, Traversable)

455+ deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)

437456

438457-- | Used in tuple creation when creating a relation.

439458data ExtendTupleExprBase a = AttributeExtendTupleExpr AttributeName (AtomExprBase a)

440− deriving (Show, Eq, Generic, NFData, Foldable, Functor, Traversable)

459+ deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable)

441460

442461type ExtendTupleExpr = ExtendTupleExprBase ()

462+

463+instance Hashable ExtendTupleExpr

464+

443465type GraphRefExtendTupleExpr = ExtendTupleExprBase GraphRefTransactionMarker

444466

445467--enumerates the list of functions available to be run as part of tuple expressions

@@ -487,7 +509,12 @@ data AttributeNamesBase a = AttributeNames (S.Set AttributeName) |

487509 UnionAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |

488510 IntersectAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |

489511 RelationalExprAttributeNames (RelationalExprBase a) -- use attribute names from the relational expression's type

490− deriving (Eq, Show, Generic, NFData, Foldable, Functor, Traversable)

512+ deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)

513+

514+instance Hashable AttributeNames

515+

516+instance Hashable (S.Set AttributeName) where

517+ hashWithSalt salt s = salt `hashWithSalt` S.toList s

491518

492519type AttributeNames = AttributeNamesBase ()

493520

@@ -505,18 +532,22 @@ type GraphRefAttributeExpr = AttributeExprBase GraphRefTransactionMarker

505532-- | Create attributes dynamically.

506533data AttributeExprBase a = AttributeAndTypeNameExpr AttributeName TypeConstructor a |

507534 NakedAttributeExpr Attribute

508− deriving (Eq, Show, Generic, NFData, Foldable, Functor, Traversable)

535+ deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable, Hashable)

509536

510537-- | Dynamically create a tuple from attribute names and 'AtomExpr's.

511538newtype TupleExprBase a = TupleExpr (M.Map AttributeName (AtomExprBase a))

512− deriving (Eq, Show, Generic, NFData, Foldable, Functor, Traversable)

513−

539+ deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)

540+

541+instance Hashable TupleExpr

542+

514543type TupleExpr = TupleExprBase ()

515544

516545type GraphRefTupleExpr = TupleExprBase GraphRefTransactionMarker

517546

518547data TupleExprsBase a = TupleExprs a [TupleExprBase a]

519− deriving (Eq, Show, Generic, NFData, Foldable, Functor, Traversable)

548+ deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)

549+

550+instance Hashable TupleExprs

520551

521552type GraphRefTupleExprs = TupleExprsBase GraphRefTransactionMarker

522553

@@ -566,6 +597,7 @@ attrTypeVars (Attribute _ aType) = case aType of

566597 DateTimeAtomType -> S.empty

567598 ByteStringAtomType -> S.empty

568599 BoolAtomType -> S.empty

600+ RelationalExprAtomType -> S.empty

569601 (RelationAtomType attrs) -> S.unions (map attrTypeVars (V.toList attrs))

570602 (ConstructedAtomType _ tvMap) -> M.keysSet tvMap

571603 (TypeVariableType nam) -> S.singleton nam

@@ -589,6 +621,7 @@ atomTypeVars DayAtomType = S.empty

589621atomTypeVars DateTimeAtomType = S.empty

590622atomTypeVars ByteStringAtomType = S.empty

591623atomTypeVars BoolAtomType = S.empty

624+atomTypeVars RelationalExprAtomType = S.empty

592625atomTypeVars (RelationAtomType attrs) = S.unions (map attrTypeVars (V.toList attrs))

593626atomTypeVars (ConstructedAtomType _ tvMap) = M.keysSet tvMap

594627atomTypeVars (TypeVariableType nam) = S.singleton nam

src/lib/ProjectM36/DataTypes/Interval.hs+2

@@ -37,6 +37,7 @@ supportsInterval typ = case typ of

3737 BoolAtomType -> False

3838 RelationAtomType _ -> False

3939 ConstructedAtomType _ _ -> False --once we support an interval-style typeclass, we might enable this

40+ RelationalExprAtomType -> False

4041 TypeVariableType _ -> False

4142

4243supportsOrdering :: AtomType -> Bool

@@ -50,6 +51,7 @@ supportsOrdering typ = case typ of

5051 ByteStringAtomType -> False

5152 BoolAtomType -> False

5253 RelationAtomType _ -> False

54+ RelationalExprAtomType -> False

5355 ConstructedAtomType _ _ -> False --once we support an interval-style typeclass, we might enable this

5456 TypeVariableType _ -> False

5557

src/lib/ProjectM36/DataTypes/Primitive.hs+1

@@ -42,3 +42,4 @@ atomTypeForAtom (ByteStringAtom _) = ByteStringAtomType

4242atomTypeForAtom (BoolAtom _) = BoolAtomType

4343atomTypeForAtom (RelationAtom (Relation attrs _)) = RelationAtomType attrs

4444atomTypeForAtom (ConstructedAtom _ aType _) = aType

45+atomTypeForAtom (RelationalExprAtom _) = RelationalExprAtomType

src/lib/ProjectM36/DataTypes/Sorting.hs+1

@@ -24,6 +24,7 @@ isSortableAtomType typ = case typ of

2424 DateTimeAtomType -> True

2525 ByteStringAtomType -> False

2626 BoolAtomType -> True

27+ RelationalExprAtomType -> False

2728 RelationAtomType _ -> False

2829 ConstructedAtomType _ _ -> False

2930 TypeVariableType _ -> False

src/lib/ProjectM36/InclusionDependency.hs+5−6

@@ -4,17 +4,16 @@ import ProjectM36.Attribute

44import ProjectM36.Error

55import ProjectM36.Relation

66import qualified Data.Map as M

7−import qualified Data.Text as T

98inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation

109inclusionDependenciesAsRelation incDeps =

1110 mkRelationFromList attrs (map incDepAsAtoms (M.toList incDeps))

1211 where

1312 attrs = attributesFromList [Attribute "name" TextAtomType,

14− Attribute "sub" TextAtomType,

15− Attribute "super" TextAtomType

13+ Attribute "sub" RelationalExprAtomType,

14+ Attribute "super" RelationalExprAtomType

1615 ]

1716 incDepAsAtoms (name, InclusionDependency exprA exprB) = [TextAtom name,

18− TextAtom (T.pack (show exprA)),

19− TextAtom (T.pack (show exprB))]

20−

17+ RelationalExprAtom exprA,

18+ RelationalExprAtom exprB]

19+

src/lib/ProjectM36/Relation/Parse/CSV.hs+5

@@ -83,6 +83,11 @@ parseCSVAtomP _ _ BoolAtomType = do

8383 case readMaybe bString of

8484 Nothing -> fail ("invalid BoolAtom string: " ++ bString)

8585 Just b -> pure (Right (BoolAtom b))

86+parseCSVAtomP _ _ RelationalExprAtomType = do

87+ reString <- T.unpack <$> takeToEndOfData

88+ case readMaybe reString of

89+ Nothing -> fail ("invalid RelationalExprAtom string: " ++ reString)

90+ Just b -> pure (Right (RelationalExprAtom b))

8691parseCSVAtomP attrName tConsMap typ@(ConstructedAtomType _ tvmap)

8792 | isIntervalAtomType typ = do

8893 begin <- (APT.char '[' >> pure False) <|> (APT.char '(' >> pure True)

src/lib/ProjectM36/RelationalExpression.hs+71−2

@@ -367,8 +367,9 @@ evalRelationalExpr (Extend tupleExpression relExpr) = do

367367setRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()

368368setRelVar relVarName relExpr = do

369369 currentContext <- getStateContext

370− --prevent recursive relvar definition

371− let newRelVars = M.insert relVarName relExpr $ relationVariables currentContext

370+ --prevent recursive relvar definition by resolving references to relvars in previous states

371+ relExpr' <- resolve relExpr

372+ let newRelVars = M.insert relVarName relExpr' $ relationVariables currentContext

372373 potentialContext = currentContext { relationVariables = newRelVars }

373374 --optimization: if the relexpr is unchanged, skip the update

374375 if M.lookup relVarName (relationVariables currentContext) == Just relExpr then

@@ -1544,3 +1545,71 @@ relVarByName rvName = do

15441545 Nothing -> throwError (RelVarNotDefinedError rvName)

15451546 Just gfexpr -> pure gfexpr

15461547

1548+-- | resolve UncommittedTransactionMarker whenever possible- this is important in the DatabaseContext in order to mitigate self-referencing loops for updates

1549+class ResolveGraphRefTransactionMarker a where

1550+ resolve :: a -> DatabaseContextEvalMonad a

1551+

1552+-- s := s union t

1553+instance ResolveGraphRefTransactionMarker GraphRefRelationalExpr where

1554+ resolve (MakeRelationFromExprs mAttrs tupleExprs) =

1555+ MakeRelationFromExprs mAttrs <$> resolve tupleExprs

1556+ resolve orig@MakeStaticRelation{} = pure orig

1557+ resolve orig@ExistingRelation{} = pure orig

1558+ resolve orig@(RelationVariable rvName UncommittedContextMarker) = do

1559+ rvMap <- relationVariables <$> getStateContext

1560+ case M.lookup rvName rvMap of

1561+ Nothing -> pure orig

1562+ Just resolvedRv -> resolve resolvedRv

1563+ resolve orig@RelationVariable{} = pure orig

1564+ resolve (Project attrNames relExpr) = Project <$> resolve attrNames <*> resolve relExpr

1565+ resolve (Union exprA exprB) = Union <$> resolve exprA <*> resolve exprB

1566+ resolve (Join exprA exprB) = Join <$> resolve exprA <*> resolve exprB

1567+ resolve (Rename attrA attrB expr) = Rename attrA attrB <$> resolve expr

1568+ resolve (Difference exprA exprB) = Difference <$> resolve exprA <*> resolve exprB

1569+ resolve (Group namesA nameB expr) = Group <$> resolve namesA <*> pure nameB <*> resolve expr

1570+ resolve (Ungroup nameA expr) = Ungroup nameA <$> resolve expr

1571+ resolve (Restrict restrictExpr relExpr) = Restrict <$> resolve restrictExpr <*> resolve relExpr

1572+ resolve (Equals exprA exprB) = Equals <$> resolve exprA <*> resolve exprB

1573+ resolve (NotEquals exprA exprB) = NotEquals <$> resolve exprA <*> resolve exprB

1574+ resolve (Extend extendExpr relExpr) = Extend <$> resolve extendExpr <*> resolve relExpr

1575+ resolve (With withExprs relExpr) = With <$> mapM (\(nam, expr) -> (,) <$> resolve nam <*> resolve expr) withExprs <*> resolve relExpr

1576+

1577+instance ResolveGraphRefTransactionMarker GraphRefTupleExprs where

1578+ resolve (TupleExprs marker tupleExprs) =

1579+ TupleExprs marker <$> mapM resolve tupleExprs

1580+

1581+instance ResolveGraphRefTransactionMarker GraphRefTupleExpr where

1582+ resolve (TupleExpr tupMap) = do

1583+ tupMap' <- mapM (\(attrName, expr) -> (,) attrName <$> resolve expr ) (M.toList tupMap)

1584+ pure (TupleExpr (M.fromList tupMap'))

1585+

1586+instance ResolveGraphRefTransactionMarker GraphRefAttributeNames where

1587+ resolve orig@AttributeNames{} = pure orig

1588+ resolve orig@InvertedAttributeNames{} = pure orig

1589+ resolve (UnionAttributeNames namesA namesB) = UnionAttributeNames <$> resolve namesA <*> resolve namesB

1590+ resolve (IntersectAttributeNames namesA namesB) = IntersectAttributeNames <$> resolve namesA <*> resolve namesB

1591+ resolve (RelationalExprAttributeNames expr) = RelationalExprAttributeNames <$> resolve expr

1592+

1593+instance ResolveGraphRefTransactionMarker GraphRefRestrictionPredicateExpr where

1594+ resolve TruePredicate = pure TruePredicate

1595+ resolve (AndPredicate exprA exprB) = AndPredicate <$> resolve exprA <*> resolve exprB

1596+ resolve (OrPredicate exprA exprB) = OrPredicate <$> resolve exprA <*> resolve exprB

1597+ resolve (NotPredicate expr) = NotPredicate <$> resolve expr

1598+ resolve (RelationalExprPredicate expr) = RelationalExprPredicate <$> resolve expr

1599+ resolve (AtomExprPredicate expr) = AtomExprPredicate <$> resolve expr

1600+ resolve (AttributeEqualityPredicate nam expr)= AttributeEqualityPredicate nam <$> resolve expr

1601+

1602+instance ResolveGraphRefTransactionMarker GraphRefExtendTupleExpr where

1603+ resolve (AttributeExtendTupleExpr nam atomExpr) = AttributeExtendTupleExpr nam <$> resolve atomExpr

1604+

1605+instance ResolveGraphRefTransactionMarker GraphRefWithNameExpr where

1606+ resolve orig@WithNameExpr{} = pure orig -- match uncommitted marker?

1607+

1608+instance ResolveGraphRefTransactionMarker GraphRefAtomExpr where

1609+ resolve orig@AttributeAtomExpr{} = pure orig

1610+ resolve orig@NakedAtomExpr{} = pure orig

1611+ resolve (FunctionAtomExpr nam atomExprs marker) =

1612+ FunctionAtomExpr nam <$> mapM resolve atomExprs <*> pure marker

1613+ resolve (RelationAtomExpr expr) = RelationAtomExpr <$> resolve expr

1614+ resolve (ConstructedAtomExpr dConsName atomExprs marker) =

1615+ ConstructedAtomExpr dConsName <$> mapM resolve atomExprs <*> pure marker

stack.ghc8.8.yaml+2

@@ -11,6 +11,8 @@ packages:

1111extra-deps:

1212- git: https://github.com/agentm/curryer.git

1313 commit: 1e60c0580ca33d6ae1e97aaddc32189fdfe3ef6c

14+- git: https://github.com/composewell/streamly.git

15+ commit: ac3af8749194f1788704dda8667d0b3807075cc2

1416- extended-reals-0.2.3.0

1517- data-interval-2.0.1

1618- stm-containers-1.1.0.4

test/TutorialD/Interpreter.hs+27−3

@@ -79,7 +79,9 @@ main = do

7979 testInvalidDataConstructor,

8080 testBasicList,

8181 testRelationDeclarationMismatch,

82− testInvalidTuples

82+ testInvalidTuples,

83+ testSelfReferencingUncommittedContext,

84+ testUnionAndIntersectionAttributeExprs

8385 ]

8486

8587simpleRelTests :: Test

@@ -120,7 +122,8 @@ simpleRelTests = TestCase $ do

120122 ("x:=relation{tuple{a 5}} : {b:=6}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntegerAtom 5, IntegerAtom 6])]),

121123 ("x:=relation{tuple{a 5}} : {b:=add(@a,5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntegerAtom 5, IntegerAtom 10])]),

122124 ("x:=relation{tuple{a 5}} : {b:=add(@a,\"spam\")}", Left (AtomFunctionTypeError "add" 2 IntegerAtomType TextAtomType)),

123− ("x:=relation{tuple{a 5}} : {b:=add(add(@a,2),5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntegerAtom 5, IntegerAtom 12])])

125+ ("x:=relation{tuple{a 5}} : {b:=add(add(@a,2),5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntegerAtom 5, IntegerAtom 12])]),

126+ ("x:=false:{a:=1,b:=2}", mkRelationFromTuples simpleDAttributes [])

124127 ]

125128 simpleAAttributes = A.attributesFromList [Attribute "a" IntegerAtomType]

126129 simpleBAttributes = A.attributesFromList [Attribute "d" IntegerAtomType]

@@ -230,7 +233,7 @@ transactionGraphAddCommitTest = TestCase $ do

230233 commit sessionId dbconn >>= eitherFail

231234 discon <- disconnectedTransaction_ sessionId dbconn

232235 let context = Discon.concreteDatabaseContext discon

233− assertEqual "ensure x was added" (M.lookup "x" (relationVariables context)) (Just (RelationVariable "s" UncommittedContextMarker))

236+ assertEqual "ensure x was added" (M.lookup "x" (relationVariables context)) (Just (ExistingRelation suppliersRel))

234237

235238transactionRollbackTest :: Test

236239transactionRollbackTest = TestCase $ do

@@ -700,3 +703,24 @@ testInvalidTuples = TestCase $ do

700703 expectTutorialDErr sessionId dbconn (T.isPrefixOf "AttributeNamesMismatchError") ":showexpr relation{tuple{a 1},tuple{b 2}}"

701704 expectTutorialDErr sessionId dbconn (T.isPrefixOf "AttributeNamesMismatchError") ":showexpr relation{tuple{a 1},tuple{a 2, b 3}}"

702705-- expectTutorialDErr sessionId dbconn (T.isPrefixOf "ParseErrorBundle") ":showexpr relation{tuple{a 2, a 3}}" --parse failure can't be validated with this function

706+

707+testSelfReferencingUncommittedContext :: Test

708+testSelfReferencingUncommittedContext = TestCase $ do

709+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

710+ executeTutorialD sessionId dbconn "s:=s union s"

711+ eS <- executeRelationalExpr sessionId dbconn (RelationVariable "s" ())

712+ _ <- rollback sessionId dbconn

713+ eSorig <- executeRelationalExpr sessionId dbconn (RelationVariable "s" ())

714+ assertEqual "s=s'" eSorig eS

715+

716+testUnionAndIntersectionAttributeExprs :: Test

717+testUnionAndIntersectionAttributeExprs = TestCase $ do

718+ (sessionId, dbconn) <- dateExamplesConnection emptyNotificationCallback

719+ executeTutorialD sessionId dbconn "x:=s{intersection of {all but sname} {sname}}"

720+ xRel <- executeRelationalExpr sessionId dbconn (RelationVariable "x" ())

721+ assertEqual "intersection attrs" (Right relationTrue) xRel

722+

723+ executeTutorialD sessionId dbconn "y:=s{union of {all but sname} {sname}}"

724+ yRel <- executeRelationalExpr sessionId dbconn (RelationVariable "y" ())

725+ assertEqual "union attrs" (Right suppliersRel) yRel

726+

test/TutorialD/Printer.hsnew file+47

@@ -0,0 +1,47 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+import Test.HUnit

3+import ProjectM36.Base

4+import System.Exit

5+import Data.Text.Prettyprint.Doc

6+import Data.Map (fromList)

7+import TutorialD.Printer ()

8+import TutorialD.Interpreter.RelationalExpr

9+import Text.Megaparsec

10+import Data.Text (pack)

11+

12+testList :: Test

13+testList = TestList [

14+ testPretty "true" (RelationVariable "true" ()),

15+ testPretty "relation{tuple{a 3, b \"x\"}, tuple{a 4, b \"y\"}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",NakedAtomExpr (IntegerAtom 3)),("b",NakedAtomExpr (TextAtom "x"))]),TupleExpr (fromList [("a",NakedAtomExpr (IntegerAtom 4)),("b",NakedAtomExpr (TextAtom "y"))])])),

16+ testPretty "true:{a:=1, b:=1}" (Extend (AttributeExtendTupleExpr "b" (NakedAtomExpr (IntegerAtom 1))) (Extend (AttributeExtendTupleExpr "a" (NakedAtomExpr (IntegerAtom 1))) (RelationVariable "true" ()))),

17+ testPretty "relation{tuple{a fromGregorian(2014, 2, 4)}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",FunctionAtomExpr "fromGregorian" [NakedAtomExpr (IntegerAtom 2014),NakedAtomExpr (IntegerAtom 2),NakedAtomExpr (IntegerAtom 4)] ())])])),

18+ testPretty "relation{tuple{a bytestring(\"dGVzdGRhdGE=\")}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",FunctionAtomExpr "bytestring" [NakedAtomExpr (TextAtom "dGVzdGRhdGE=")] ())])])),

19+ testPretty "relation{tuple{a t}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",NakedAtomExpr (BoolAtom True))])])),

20+ testPretty "relation{tuple{a Cons 4 (Cons 5 Empty)}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",ConstructedAtomExpr "Cons" [NakedAtomExpr (IntegerAtom 4),ConstructedAtomExpr "Cons" [NakedAtomExpr (IntegerAtom 5),ConstructedAtomExpr "Empty" [] ()] ()] ())])])),

21+ testPretty "relation{a Int, b Text, c Bool}{}" (MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "a" (ADTypeConstructor "Int" []) (),AttributeAndTypeNameExpr "b" (ADTypeConstructor "Text" []) (),AttributeAndTypeNameExpr "c" (ADTypeConstructor "Bool" []) ()]) (TupleExprs () [])),

22+ testPretty "relation{a relation{b Int}}{}" (MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "a" (RelationAtomTypeConstructor [AttributeAndTypeNameExpr "b" (ADTypeConstructor "Int" []) ()]) ()]) (TupleExprs () []))

23+ ]

24+

25+main :: IO ()

26+main = do

27+ tcounts <- runTestTT testList

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

29+

30+testPretty :: String -> RelationalExpr -> Test

31+testPretty tutdStr relExprADT =

32+ TestCase $ do

33+ let relExprStr = show (pretty relExprADT)

34+ print relExprStr

35+ roundTrip <- parseRelExpr relExprStr

36+ {-tutdIn <- parseRelExpr tutdStr

37+ print ("tutd parsed", tutdIn)-}

38+ assertEqual ("pretty ADT " <> tutdStr) tutdStr relExprStr

39+ assertEqual ("round-trip " <> tutdStr) relExprADT roundTrip

40+

41+--round trip tutoriald

42+parseRelExpr :: String -> IO RelationalExpr

43+parseRelExpr tutdStr =

44+ case parse relExprP "test" (pack tutdStr) of

45+ Left err ->

46+ assertFailure (show err)

47+ Right parsed -> pure parsed