807ec5c...master · project-m36

git.iko.soy/project-m36

on master help sign in

.appveyor.ymlnew file+39

since splitsnapshots

unifiedsplit

@@ -0,0 +1,39 @@

1+build: off

3+version: 1.0.{build}-{branch}

5+image: Visual Studio 2017

7+before_test:

8+# http://help.appveyor.com/discussions/problems/6312-curl-command-not-found

9+- set PATH=C:\Program Files\Git\mingw64\bin;%PATH%

10+

11+- curl -sS -ostack.zip -L --insecure http://www.stackage.org/stack/windows-x86_64

12+- 7z x stack.zip stack.exe

13+

14+clone_folder: "c:\\project-m36"

15+clone_depth: 2

16+environment:

17+ global:

18+ STACK_ROOT: "c:\\sr"

19+ matrix:

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

21+

22+platform:

23+ - x64

24+

25+cache:

26+ - "c:\\sr"

27+ - "%LocalAppData%\\Programs\\stack"

28+# - ".stack-work" # send us over the 1 GB limit

29+

30+test_script:

31+ - stack setup > nul

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

33+# descriptor

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

35+# - 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

36+

37+#artifacts:

38+# - path: project-m36.7z

39+# name: project-m36.7z

.github/workflows/ci.yamlnew file+69

@@ -0,0 +1,69 @@

1+name: "CI"

2+on:

3+ pull_request:

4+ push:

5+jobs:

6+ dockerimage:

7+ runs-on: ubuntu-latest

8+ steps:

9+ - uses: actions/checkout@v2.3.1

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

11+ with:

12+ nix_path: nixpkgs=channel:nixos-unstable

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

14+ with:

15+ name: project-m36

16+ signingKey: "${{ secrets.CACHIX_SIGNING_KEY }}"

17+ - run: cachix use iohk

18+ - name: docker load

19+ run: docker load < $(nix-build docker.nix)

20+ - name: docker login

21+ if: ${{ github.ref == 'refs/heads/master' }}

22+ run: echo ${{secrets.DOCKERHUB_PASSWORD}} | docker login --username ${{secrets.DOCKERHUB_USER}} --password-stdin

23+ - name: docker tag with version

24+ run: docker tag project-m36:latest projectm36/project-m36:$(awk '/^Version:/ {print $2}' project-m36.cabal)

25+ if: ${{ github.ref == 'refs/heads/master' }}

26+ - name: docker tag latest

27+ run: docker tag project-m36:latest projectm36/project-m36:latest

28+ if: ${{ github.ref == 'refs/heads/master' }}

29+ - run: docker push projectm36/project-m36

30+ if: ${{ github.ref == 'refs/heads/master' }}

31+

32+ stack-build:

33+ runs-on: ${{ matrix.os }}

34+ strategy:

35+ matrix:

36+ os: [ubuntu-latest]

37+ ghc:

38+ - ghc8.10

39+ - ghc8.8

40+ - ghc8.6

41+ include:

42+ - os: macos-latest

43+ ghc: ghc8.10

44+ env:

45+ STACK_YAML: stack.${{ matrix.ghc }}.yaml

46+ steps:

47+ - uses: actions/checkout@v2

48+ - name: Cache

49+ uses: actions/cache@v1

50+ with:

51+ path: ~/.stack

52+ key: ${{ runner.os }}-build-stack-${{ matrix.ghc }}-${{ hashFiles(env.STACK_YAML) }}-${{ hashFiles('**/*.cabal') }}

53+ restore-keys: |

54+ ${{ runner.os }}-build-stack-${{ matrix.ghc }}-${{ hashFiles(env.STACK_YAML) }}

55+ ${{ runner.os }}-build-stack-${{ matrix.ghc }}

56+ - name: Fix macOS cache bug

57+ run: rm -rf ~/.stack/setup-exe-cache

58+ - name: Build

59+ run: stack build --ghc-options -O2 --local-bin-path out --copy-bins

60+ - name: Test

61+ run: stack test --stack-yaml=${{ env.STACK_YAML }}

62+ - name: HLint

63+ run: curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s .

64+ - name: Haddock

65+ run: stack --no-install-ghc --system-ghc --no-haddock-deps haddock

66+ - uses: actions/upload-artifact@v2

67+ with:

68+ name: project-m36-${{ matrix.os }}-${{ matrix.ghc }}

69+ path: out/

.gitignore+7−1

@@ -14,4 +14,10 @@ nextsteps

14\#*\#

15view-system-notes

16persistence-notes

17−*.pyc

17+*.pyc

18+jupyter/itutd.egg-info

19+jupyter/build

20+juyter/dist

21+.ipynb_checkpoints

22+project-m36.nix

23+stack.yaml

.travis.ymldeleted−58

@@ -1,58 +0,0 @@

1−# For more information, see https://github.com/hvr/multi-ghc-travis

2−language: c

3−sudo: false

4−

5−git:

6− submodules: false # whether to recursively clone submodules

7−

8−cache:

9− directories:

10− - $HOME/.cabal/packages

11− - $HOME/.cabal/store

12−

13−before_cache:

14− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

15− # remove files that are regenerated by 'cabal update'

16− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

17− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

18− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

19− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

20− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx

21−

22−matrix:

23− include:

24− #- compiler: "ghc-7.8.4"

25− # env: TEST=--disable-tests BENCH=--disable-benchmarks

26− # addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}

27− - compiler: "ghc-7.10.3"

28− # env: TEST=--disable-tests BENCH=--disable-benchmarks

29− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}

30− - compiler: "ghc-8.0.2"

31− # env: TEST=--disable-tests BENCH=--disable-benchmarks

32− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}

33− #- compiler: "ghc-8.2.1"

34− # env: TEST=--disable-tests BENCH=--disable-benchmarks

35− # addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}}

36−

37−before_install:

38− - HC=${CC}

39− - unset CC

40− - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH

41−

42−install:

43− - cabal --version

44− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

45− - travis_retry cabal update -v

46− - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config

47−

48− - cabal new-build -w ${HC} --enable-tests --dep -j2 all

49−

50−# Here starts the actual work to be performed for the package under test;

51−# any command which exits with a non-zero exit code causes the build to fail.

52−script:

53− - cabal sdist

54− - cabal new-build -w ${HC} -j1

55− - cabal new-test -w ${HC}

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

57− - cabal new-haddock

58−# EOF

Changelog.markdown+71

@@ -1,3 +1,74 @@

1+# 2021-04-01 (v0.9.3)

3+* add new ":importtutd <URI> <SHA256 hash>" feature to import TutorialD from a local file or a HTTP/HTTPS URI

5+# 2020-12-27 (v0.9.0)

7+* replace unmaintained distributed-process-client-server RPC package with new curryer RPC package

8+* drop support for GHC 8.2 and GHC 8.4 due to dependency on DerivingVia extension

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

11+

12+* support multiple extend expressions in TutorialD

13+* fix parsing of Bool atoms in TutorialD

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

15+* show constraints as TutorialD when using tutd console

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

17+

18+# 2020-10-05 (v0.8.1)

19+

20+* support GHC 8.10

21+

22+# 2020-05-25 (v0.8)

23+

24+* refactor backend to maximize laziness: [An Architecture for Data Independence](docs/data_independence.markdown)

25+

26+# 2019-09-07 (v0.7)

27+

28+* fix case sensitivity issue with relation variables in tutd

29+* fix multibyte escaping in data frames

30+* fix broken instances of `Atomable [a]`

31+* fix `TypeConstructor` validation of argument count

32+* add help option to executables

33+

34+# 2019-01-08 (v0.6)

35+

36+* fix atom type parsing to support more complex data types

37+* add [data frames](docs/dataframes.markdown) to support server-side sort ordering, limits, and offsets

38+

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

40+

41+* fix atom function type validation

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

43+

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

45+

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

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

48+* drop support for GHC 7.10

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

50+* add `NonEmptyList` list data type

51+

52+# 2018-06-04 (v0.4)

53+

54+* 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)

55+* fix type validation bug allowing concrete type with type variables in relations

56+* improve usability of `Interval a` data type

57+* allow `Integer` to be parsed as negative in `tutd` console

58+* support precompiled (Haskell) [`AtomFunction`s](https://github.com/agentm/project-m36/blob/master/docs/atomfunctions.markdown#pre-compiled-atom-functions) and [`DatabaseContextFunction`s](https://github.com/agentm/project-m36/blob/master/docs/database_context_functions.markdown#loading-precompiled-modules)

59+* make TutorialD scripts read from the filesystem unconditionally read as UTF-8

60+* improve support for display of multibyte characters in `tutd` console, especially Chinese

61+* fix file descriptor leak in file sychronization

62+* improve reliability by allowing fast-forward commits when using `autoMergeToHead`

63+* add [`semijoin` and `anitjoin`](https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown#join) support to `tutd`

64+* added various new static optimizations

65+

66+# 2017-11-14

67+

68+* alter websocket server API to allow for multiple representations (JSON, text, or HTML) to be selected and returned simultaneously

69+* add jupyter kernel for TutorialD interpreter

70+* fix warnings suggested by new hlint 2.0.10

71+

1# 2017-10-08 (v0.3)

72# 2017-10-08 (v0.3)

3* replaced overuse of `undefined` with `Proxy` in `Tupleable` and `Atomable` typeclasses

74* replaced overuse of `undefined` with `Proxy` in `Tupleable` and `Atomable` typeclasses

README.markdown+25−9

@@ -4,7 +4,9 @@

4[![Public Domain](https://img.shields.io/badge/license-Public%20Domain-brightgreen.svg)](http://unlicense.org)

5[![Hackage](https://img.shields.io/hackage/v/project-m36.svg)](http://hackage.haskell.org/package/project-m36)

6[![Hackage dependency status](https://img.shields.io/hackage-deps/v/project-m36.svg)](http://packdeps.haskellers.com/feed?needle=project-m36)

7−[![Build status](https://travis-ci.org/agentm/project-m36.svg?branch=master)](https://travis-ci.org/agentm/project-m36)

7+[![Windows Build status](https://ci.appveyor.com/api/projects/status/q7jyddd6dy1ibqdo/branch/master?svg=true)](https://ci.appveyor.com/project/agentm/project-m36)

8+[![Github Workflow status](https://github.com/agentm/project-m36/workflows/CI/badge.svg)](https://github.com/agentm/project-m36/actions?query=workflow%3ACI)

9*Software can always be made faster, but rarely can it be made more correct.*

11*Software can always be made faster, but rarely can it be made more correct.*

@@ -12,6 +14,12 @@

13Project:M36 implements a relational algebra engine as inspired by the writings of Chris Date.

15Project:M36 implements a relational algebra engine as inspired by the writings of Chris Date.

17+## Quick Install

18+

19+Project:M36 can be downloaded and run via docker, which supports Windows 10, macOS, and Linux.

20+

21+Run `docker run -it projectm36/project-m36 tutd` to start the TutorialD command line interface.

22+

15## Description

23## Description

17Unlike most database management systems (DBMS), Project:M36 is opinionated software which adheres strictly to the mathematics of the relational algebra. The purpose of this adherence is to prove that software which implements mathematically-sound design principles reaps benefits in the form of code clarity, consistency, performance, and future-proofing.

25Unlike most database management systems (DBMS), Project:M36 is opinionated software which adheres strictly to the mathematics of the relational algebra. The purpose of this adherence is to prove that software which implements mathematically-sound design principles reaps benefits in the form of code clarity, consistency, performance, and future-proofing.

@@ -24,10 +32,6 @@ Project:M36 is written entirely in the [Haskell programming language](https://ww

25[![asciicast](https://asciinema.org/a/3syu35c8cydm403292a74l1n5.png)](https://asciinema.org/a/3syu35c8cydm403292a74l1n5)

33[![asciicast](https://asciinema.org/a/3syu35c8cydm403292a74l1n5.png)](https://asciinema.org/a/3syu35c8cydm403292a74l1n5)

27−## Try It!

28−

29−You can experiment instantly with Project:M36 straight from your browser at [try.project-m36.io](https://try.project-m36.io)!

30−

31## Use-Cases

35## Use-Cases

33Project:M36 supports multiple frontends which target different audiences.

37Project:M36 supports multiple frontends which target different audiences.

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

41* [Developer's Blog](https://agentm.github.io/project-m36/)

45* [Developer's Blog](https://agentm.github.io/project-m36/)

42* [Mailing List/Discussion Group](https://groups.google.com/d/forum/project-m36)

46* [Mailing List/Discussion Group](https://groups.google.com/d/forum/project-m36)

43−* IRC Channel: chat.freenode.net #project-m36

47+* IRC Channel: irc.libera.chat #project-m36 -- [Chat via Web Client](http://kiwiirc.com/nextclient/irc.libera.chat:+6697/#project-m36)

44* [Hackage](https://hackage.haskell.org/package/project-m36)

48* [Hackage](https://hackage.haskell.org/package/project-m36)

45* [Diogo Biazus' Project:M36 Video Tutorial](https://www.youtube.com/watch?v=_GC_lxlVEnE)

49* [Diogo Biazus' Project:M36 Video Tutorial](https://www.youtube.com/watch?v=_GC_lxlVEnE)

@@ -50,35 +54,47 @@ Project:M36 supports multiple frontends which target different audiences.

511. [Installation and Introduction to Project:M36](docs/introduction_to_projectm36.markdown)

551. [Installation and Introduction to Project:M36](docs/introduction_to_projectm36.markdown)

521. [Introduction to the Relational Algebra](docs/introduction_to_the_relational_algebra.markdown)

561. [Introduction to the Relational Algebra](docs/introduction_to_the_relational_algebra.markdown)

57+1. [TutorialD Cheatsheet](docs/tutd_cheatsheet.markdown)

58+1. [TutorialD via Jupyter Notebook Walkthrough](jupyter/TutorialD%20Notebook%20Walkthrough.ipynb)

531. [TutorialD Tutorial](docs/tutd_tutorial.markdown)

591. [TutorialD Tutorial](docs/tutd_tutorial.markdown)

541. [15 Minute Tutorial](docs/15_minute_tutorial.markdown)

601. [15 Minute Tutorial](docs/15_minute_tutorial.markdown)

551. [Developer's Change Log](Changelog.markdown)

611. [Developer's Change Log](Changelog.markdown)

561. [Simple Client API](docs/simple_api.markdown)

621. [Simple Client API](docs/simple_api.markdown)

63+1. [CSV Import/Export](docs/import_export_csv.markdown)

58### Database Comparisons

65### Database Comparisons

601. [ACID Database Properties](docs/acid_assessment.markdown)

671. [ACID Database Properties](docs/acid_assessment.markdown)

611. [On NULL (in SQL)](docs/on_null.markdown)

681. [On NULL (in SQL)](docs/on_null.markdown)

621. [Reaching "Out of the Tarpit" with Project:M36](docs/reaching_out_of_the_tarpit.markdown)

691. [Reaching "Out of the Tarpit" with Project:M36](docs/reaching_out_of_the_tarpit.markdown)

70+1. [An Architecture for Data Independence](docs/data_independence.markdown)

64### Advanced Features

72### Advanced Features

661. [Transaction Graph Operators](docs/transaction_graph_operators.markdown)

741. [Transaction Graph Operators](docs/transaction_graph_operators.markdown)

671. [ProjectM36.Client Library](docs/projectm36_client_library.markdown)

751. [ProjectM36.Client Library](docs/projectm36_client_library.markdown)

76+1. [Data Frames for Sorting](docs/dataframes.markdown)

681. [Adding New Data Types](docs/new_datatypes.markdown)

771. [Adding New Data Types](docs/new_datatypes.markdown)

691. [Database-Manipulating Functions](docs/database_context_functions.markdown)

781. [Database-Manipulating Functions](docs/database_context_functions.markdown)

701. [Serving Remote ProjectM36 Databases](docs/server_mode.markdown)

791. [Serving Remote ProjectM36 Databases](docs/server_mode.markdown)

711. [Using Notifications](docs/using_notifications.markdown)

801. [Using Notifications](docs/using_notifications.markdown)

721. [Merge Transactions](docs/merge_transactions.markdown)

811. [Merge Transactions](docs/merge_transactions.markdown)

73−1. [WebSocket Server](docs/websocket_server.markdown)

741. [Atom (Value) Functions](docs/atomfunctions.markdown)

821. [Atom (Value) Functions](docs/atomfunctions.markdown)

751. [Trans-Graph Relational Expressions](docs/transgraphrelationalexpr.markdown)

831. [Trans-Graph Relational Expressions](docs/transgraphrelationalexpr.markdown)

761. [Isomorphic Schemas](docs/isomorphic_schemas.markdown)

841. [Isomorphic Schemas](docs/isomorphic_schemas.markdown)

771. [Replication](docs/replication.markdown)

851. [Replication](docs/replication.markdown)

86+1. [Basic Operator Benchmarks](https://rawgit.com/agentm/project-m36/master/docs/basic_benchmarks.html)

87+1. [Merkle Transaction Hashes](docs/merkle_transaction_graph.markdown)

88+

89+### Integrations

90+

91+1. [WebSocket Server](docs/websocket_server.markdown)

92+1. [Jupyter Notebook Kernel](docs/jupyter_kernel.markdown)

93+1. [Persistent Driver](https://github.com/YuMingLiao/persistent-project-m36)

79## Development

95## Development

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

97+Project:M36 is developed in Haskell and compiled with GHC 8.6 or later.

83## Related Projects

99## Related Projects

100

@@ -89,6 +105,6 @@ Project:M36 is developed in Haskell and compiled with GHC 7.10 or GHC 8.0.2 or l

105

90## Suggested Reading

106## Suggested Reading

107

92−* [Out of the Tarpit](http://shaffner.us/cs/papers/tarpit.pdf): a proposed software architecture which minimizes state and complexity. Project:M36 implements the requirements of this paper.

108+* [Out of the Tarpit](https://github.com/papers-we-love/papers-we-love/blob/2eb8d21/design/out-of-the-tar-pit.pdf): a proposed software architecture which minimizes state and complexity. Project:M36 implements the requirements of this paper.

93* [Database Design & Relational Theory: Normal Forms and All That Jazz](http://shop.oreilly.com/product/0636920025276.do): mathematical foundations for the principles of the relational algebra

109* [Database Design & Relational Theory: Normal Forms and All That Jazz](http://shop.oreilly.com/product/0636920025276.do): mathematical foundations for the principles of the relational algebra

94* [Database Explorations: Essays on the Third Manifesto and Related Topics](http://bookstore.trafford.com/Products/SKU-000177853/Database-Explorations.aspx): additional essays and debates on practical approaches to relational algebra engine design

110* [Database Explorations: Essays on the Third Manifesto and Related Topics](http://bookstore.trafford.com/Products/SKU-000177853/Database-Explorations.aspx): additional essays and debates on practical approaches to relational algebra engine design

cabal.project+9−2

@@ -1,3 +1,10 @@

1−-- this is needed for GHC8 until distributed-process-extras is updated on Hackage with increased upper bounds

2packages: project-m36.cabal

1packages: project-m36.cabal

3−allow-newer: distributed-process-extras:time,distributed-process-extras:binary,distributed-process-client-server:binary,distributed-process-client-server:time,distributed-process-async:time,distributed-process-async:binary

3+package *

4+ split-sections: True

6+--high-performance streaming library

7+source-repository-package

8+ type: git

9+ location: https://github.com/composewell/streamly.git

10+ tag: ac3af8749194f1788704dda8667d0b3807075cc2

cbits/DirectoryFsync.c+3

@@ -24,11 +24,13 @@ int cDirectoryFsync(char *path)

24 ret = fstat(fd,&fdstat);

25 if(ret < 0)

26 {

27+ close(fd);

27 return errno;

28 return errno;

28 }

29 }

30 if(!S_ISDIR(fdstat.st_mode))

31 if(!S_ISDIR(fdstat.st_mode))

31 {

32 {

33+ close(fd);

32 return ENOTDIR;

34 return ENOTDIR;

33 }

35 }

@@ -39,6 +41,7 @@ int cDirectoryFsync(char *path)

39#else

41#else

40 ret = fsync(fd);

42 ret = fsync(fd);

41#endif

43#endif

44+ close(fd);

42 if(ret < 0)

45 if(ret < 0)

43 {

46 {

44 return errno;

47 return errno;

default.nixnew file+1

@@ -0,0 +1 @@

1+(import ./release.nix { }).project

docker.nixnew file+18

@@ -0,0 +1,18 @@

1+{ compiler ? "ghc8104"

2+, sources ? import ./nix/sources.nix

3+, pkgs ? import sources.nixpkgs { }

4+}:

5+let

6+ release = import ./release.nix { inherit pkgs compiler sources; };

7+ static-project-m36 = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.justStaticExecutables release.project);

8+in

9+pkgs.dockerTools.buildImage {

10+ name = "project-m36";

11+ tag = "latest";

12+ contents = [ static-project-m36 ];

13+ # expose default project-m36 and websocket server ports

14+ config = {

15+ Env = [ "LC_ALL=en_US.UTF-8" ];

16+ ExposedPorts = { "6543/tcp" = { }; "8000/tcp" = { }; };

17+ };

18+}

docs/15_minute_tutorial.markdown+65−68

@@ -4,40 +4,34 @@ Thank you for evaluating Project:M36, a new relational algebra engine written in

5## Prerequisites

7−* any Linux

7+* any Linux, MacOS, or Windows computer with Docker installed

8−* GHC 7.10 or later version (Haskell compiler)

9−* cabal (package downloader) installed

11## Download and Install

9## Download and Install

11+Run a pre-built docker image:

12+

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

14+

15+or build it yourself with GHC >= 8.6:

16+

13```bash

17```bash

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

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

15−cabal sandbox init

16−cabal install --dependencies-only

17−cabal run tutd

19+cabal new-run tutd

18```

20```

20## Some Basic TutorialD

22## Some Basic TutorialD

22−When you run the ```tutd``` interpreter, you are interacting with an in-memory database using a dialect of the TutorialD language which is described in numerous book by Chris J. Date. It is a language specifically designed for human interaction with the relational algebra.

24+When you run the ```tutd``` interpreter, you are interacting with an in-memory database using a dialect of the TutorialD language which is described in numerous books by Chris J. Date. It is a language specifically designed for human interaction with the relational algebra.

24Note that TutorialD is strongly-typed- no type coercions take place automatically. For example, an integer will never be interpreted as a string or vice versa.

26Note that TutorialD is strongly-typed- no type coercions take place automatically. For example, an integer will never be interpreted as a string or vice versa.

26### Load the Canonical Chris Date Example

28### Load the Canonical Chris Date Example

28```

30```

29−TutorialD (master/main): :importexample date

31+TutorialD (master/main): :importexample cjdate

30−```

31−

32−or

33−

34−```

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

36```

32```

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.

34+```: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.

39−

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

42### Execute Relational Expressions

36### Execute Relational Expressions

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

164#### Create a Relation Variable

158#### Create a Relation Variable

165

159

166```

160```

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

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

168TutorialD (master/main): :showexpr x

162TutorialD (master/main): :showexpr x

169┌────────┬──────────┐

163┌────────┬──────────┐

170│age::Int│name::Text│

164│age::Int│name::Text│

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

179#### Insert Additional Tuples

173#### Insert Additional Tuples

180

174

181```

175```

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

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

183TutorialD (master/main): :showexpr x

177TutorialD (master/main): :showexpr x

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

178+┌────────────┬──────────┐

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

179+│age::Integer│name::Text│

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

180+├────────────┼──────────┤

181+│31 │"Mike" │

187−│40 │"Steve" │

182+│40 │"Steve" │

188−│31 │"Mike" │

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

183+└────────────┴──────────┘

184+

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

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

191TutorialD (master/main): :showexpr x

186TutorialD (master/main): :showexpr x

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

187+┌────────────┬──────────┐

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

188+│age::Integer│name::Text│

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

189+├────────────┼──────────┤

190+│31 │"Mike" │

195−│40 │"Steve" │

191+│40 │"Steve" │

196−│24 │"Bob" │

192+│24 │"Bob" │

197−│31 │"Mike" │

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

193+└────────────┴──────────┘

194+

199```

195```

200

196

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

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

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

204

200

205```

201```

206TutorialD (master/main): :showexpr s

202TutorialD (master/main): :showexpr s

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

203+┌──────────┬────────┬───────────┬───────────────┐

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

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

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

205+├──────────┼────────┼───────────┼───────────────┤

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

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

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

206+│"London" │"S1" │"Smith" │20 │

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

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

207+│"Athens" │"S5" │"Adams" │30 │

208+│"Paris" │"S3" │"Blake" │30 │

209+│"London" │"S4" │"Clark" │20 │

210+│"Paris" │"S2" │"Jones" │10 │

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

211+└──────────┴────────┴───────────┴───────────────┘

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

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

217TutorialD (master/main): :showexpr s

213TutorialD (master/main): :showexpr s

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

214+┌──────────┬────────┬───────────┬───────────────┐

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

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

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

216+├──────────┼────────┼───────────┼───────────────┤

217+│"Athens" │"S5" │"Adams" │30 │

218+│"London" │"S1" │"Smith" │35 │

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

219+│"London" │"S4" │"Clark" │35 │

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

220+│"Paris" │"S3" │"Blake" │30 │

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

221+│"Paris" │"S2" │"Jones" │10 │

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

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

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

222+└──────────┴────────┴───────────┴───────────────┘

223+

227```

224```

228#### Deleting Tuples from a Relation Variable

225#### Deleting Tuples from a Relation Variable

229

226

230```

227```

231TutorialD (master/main): :showexpr s

228TutorialD (master/main): :showexpr s

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

229+┌──────────┬────────┬───────────┬───────────────┐

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

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

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

231+├──────────┼────────┼───────────┼───────────────┤

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

232+│"Paris" │"S2" │"Jones" │10 │

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

233+│"Paris" │"S3" │"Blake" │30 │

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

234+│"London" │"S1" │"Smith" │20 │

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

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

235+│"Athens" │"S5" │"Adams" │30 │

236+│"London" │"S4" │"Clark" │20 │

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

237+└──────────┴────────┴───────────┴───────────────┘

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

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

242TutorialD (master/main): :showexpr s

239TutorialD (master/main): :showexpr s

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

240+┌──────────┬────────┬───────────┬───────────────┐

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

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

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

242+├──────────┼────────┼───────────┼───────────────┤

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

243+│"Paris" │"S2" │"Jones" │10 │

244+│"London" │"S4" │"Clark" │20 │

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

245+│"Paris" │"S3" │"Blake" │30 │

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

246+│"London" │"S1" │"Smith" │20 │

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

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

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

251```

248```

252

249

253### Execute Transaction Graph Expressions

250### Execute Transaction Graph Expressions

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

270

267

271```

268```

272TutorialD (master/main): :branch experimental

269TutorialD (master/main): :branch experimental

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

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

274TutorialD (experimental): :commit

271TutorialD (experimental): :commit

275```

272```

276

273

docs/atomfunctions.markdown+31−2

@@ -6,7 +6,7 @@ While Project:M36 includes a set of basic function which operate on relational v

7Other DBMSes also include this feature by way of stored functions such as with PL/pgsql, T-SQL, or PL/SQL.

9−Project:M36 allows users to implement strongly-typed and pure atom functions in the Haskell language at runtime. This facility makes use of GHC, the Haskell compiler, as a runtime service.

9+Project:M36 allows users to implement strongly-typed and pure atom functions in the Haskell language at runtime. This facility makes use of GHC, the Haskell compiler, as a runtime service. Alternatively, Haskell-based atom functions can be pre-compiled and loaded at runtime.

11## Atom Function Example

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

15We 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.

17```

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

19```

21Using 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.

@@ -41,6 +41,35 @@ Project:M36 also supports polymorphic types when used with atom functions. Here

41addatomfunction "idTest" a -> Either AtomFunctionError a "(\(x:_) -> pure x) :: [Atom] -> Either AtomFunctionError Atom"

42```

44+## Pre-compiled Atom Functions

45+

46+Compiling atom functions at runtime can incur a performance cost. To mitigate this, atom functions can be compiled by GHC to object files and then loaded into the Project:M36 server. Let's look at an [example](https://github.com/agentm/project-m36/):

47+

48+```haskell

49+module DynamicAtomFunctions where

50+import ProjectM36.Base

51+

52+someAtomFunctions :: [AtomFunction]

53+someAtomFunctions = [AtomFunction{

54+ atomFuncName = "constTrue",

55+ atomFuncType = [TypeVariableType "a", BoolAtomType],

56+ atomFuncBody = AtomFunctionBody Nothing (\(x:_) -> pure (BoolAtom True))}]

57+```

58+

59+Any function inside any module which returns a list of `AtomFunction`s can be used to load more atom functions. First, create the Haskell object file:

60+

61+`cabal exec ghc -- examples/DynamicAtomFunctions.hs -package project-m36`

62+

63+Use cabal or stack to invoke ghc so that the project-m36 installed package will be found.

64+

65+Finally, connect to your Project:M36 database using the `tutd` client and run:

66+

67+`TutorialD (master/main): loadatomfunctions "DynamicAtomFunctions" "someFunctions" "examples/DynamicAtomFunctions.o"`

68+

69+If you see an error such as "unknown symbol", the version of the "project-m36" library installed in your sandbox is different from that with which you linked the object file. Make sure that the same versions are used in linking the server and object file.

70+

71+The atom function is now loaded and ready-to-use. Note, however, that the function must be added every time the project-m36-server starts. This will probably be improved in a future release.

72+

44## Differences when compared to other DBMSes

73## Differences when compared to other DBMSes

46Project:M36 enforces strongly-typed atom functions. Specifically, atom functions must be pure (free of any side effects) and cannot operate on any variables other than the atoms passed in. This certainly sets stricter limits on what can be accomplished in an atom function when compared to stored functions in other DBMS products. For example, an atom function in Project:M36 would never be able to retrieve stock information from an external website because such a function cannot be pure and thus would be rejected by the atom function compiler. This restriction maintains the mathematical cohesiveness of the database and allows the DBMS to make performance-enhancing inferences it would not otherwise be able to make.

75Project:M36 enforces strongly-typed atom functions. Specifically, atom functions must be pure (free of any side effects) and cannot operate on any variables other than the atoms passed in. This certainly sets stricter limits on what can be accomplished in an atom function when compared to stored functions in other DBMS products. For example, an atom function in Project:M36 would never be able to retrieve stock information from an external website because such a function cannot be pure and thus would be rejected by the atom function compiler. This restriction maintains the mathematical cohesiveness of the database and allows the DBMS to make performance-enhancing inferences it would not otherwise be able to make.

docs/basic_benchmarks.htmlnew file+1230

@@ -0,0 +1,1230 @@

1+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">

2+<html>

3+ <head>

4+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8">

5+ <title>criterion report</title>

6+ <script language="javascript" type="text/javascript">

7+ /*! jQuery v3.2.1 | (c) JS Foundation and other contributors | jquery.org/license */

8+!function(a,b){"use strict";"object"==typeof module&&"object"==typeof module.exports?module.exports=a.document?b(a,!0):function(a){if(!a.document)throw new Error("jQuery requires a window with a document");return b(a)}:b(a)}("undefined"!=typeof window?window:this,function(a,b){"use strict";var c=[],d=a.document,e=Object.getPrototypeOf,f=c.slice,g=c.concat,h=c.push,i=c.indexOf,j={},k=j.toString,l=j.hasOwnProperty,m=l.toString,n=m.call(Object),o={};function p(a,b){b=b||d;var c=b.createElement("script");c.text=a,b.head.appendChild(c).parentNode.removeChild(c)}var q="3.2.1",r=function(a,b){return new r.fn.init(a,b)},s=/^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g,t=/^-ms-/,u=/-([a-z])/g,v=function(a,b){return b.toUpperCase()};r.fn=r.prototype={jquery:q,constructor:r,length:0,toArray:function(){return f.call(this)},get:function(a){return null==a?f.call(this):a<0?this[a+this.length]:this[a]},pushStack:function(a){var b=r.merge(this.constructor(),a);return b.prevObject=this,b},each:function(a){return r.each(this,a)},map:function(a){return this.pushStack(r.map(this,function(b,c){return a.call(b,c,b)}))},slice:function(){return this.pushStack(f.apply(this,arguments))},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},eq:function(a){var b=this.length,c=+a+(a<0?b:0);return this.pushStack(c>=0&&c<b?[this[c]]:[])},end:function(){return this.prevObject||this.constructor()},push:h,sort:c.sort,splice:c.splice},r.extend=r.fn.extend=function(){var a,b,c,d,e,f,g=arguments[0]||{},h=1,i=arguments.length,j=!1;for("boolean"==typeof g&&(j=g,g=arguments[h]||{},h++),"object"==typeof g||r.isFunction(g)||(g={}),h===i&&(g=this,h--);h<i;h++)if(null!=(a=arguments[h]))for(b in a)c=g[b],d=a[b],g!==d&&(j&&d&&(r.isPlainObject(d)||(e=Array.isArray(d)))?(e?(e=!1,f=c&&Array.isArray(c)?c:[]):f=c&&r.isPlainObject(c)?c:{},g[b]=r.extend(j,f,d)):void 0!==d&&(g[b]=d));return g},r.extend({expando:"jQuery"+(q+Math.random()).replace(/\D/g,""),isReady:!0,error:function(a){throw new Error(a)},noop:function(){},isFunction:function(a){return"function"===r.type(a)},isWindow:function(a){return null!=a&&a===a.window},isNumeric:function(a){var b=r.type(a);return("number"===b||"string"===b)&&!isNaN(a-parseFloat(a))},isPlainObject:function(a){var b,c;return!(!a||"[object Object]"!==k.call(a))&&(!(b=e(a))||(c=l.call(b,"constructor")&&b.constructor,"function"==typeof c&&m.call(c)===n))},isEmptyObject:function(a){var b;for(b in a)return!1;return!0},type:function(a){return null==a?a+"":"object"==typeof a||"function"==typeof a?j[k.call(a)]||"object":typeof a},globalEval:function(a){p(a)},camelCase:function(a){return a.replace(t,"ms-").replace(u,v)},each:function(a,b){var c,d=0;if(w(a)){for(c=a.length;d<c;d++)if(b.call(a[d],d,a[d])===!1)break}else for(d in a)if(b.call(a[d],d,a[d])===!1)break;return a},trim:function(a){return null==a?"":(a+"").replace(s,"")},makeArray:function(a,b){var c=b||[];return null!=a&&(w(Object(a))?r.merge(c,"string"==typeof a?[a]:a):h.call(c,a)),c},inArray:function(a,b,c){return null==b?-1:i.call(b,a,c)},merge:function(a,b){for(var c=+b.length,d=0,e=a.length;d<c;d++)a[e++]=b[d];return a.length=e,a},grep:function(a,b,c){for(var d,e=[],f=0,g=a.length,h=!c;f<g;f++)d=!b(a[f],f),d!==h&&e.push(a[f]);return e},map:function(a,b,c){var d,e,f=0,h=[];if(w(a))for(d=a.length;f<d;f++)e=b(a[f],f,c),null!=e&&h.push(e);else for(f in a)e=b(a[f],f,c),null!=e&&h.push(e);return g.apply([],h)},guid:1,proxy:function(a,b){var c,d,e;if("string"==typeof b&&(c=a[b],b=a,a=c),r.isFunction(a))return d=f.call(arguments,2),e=function(){return a.apply(b||this,d.concat(f.call(arguments)))},e.guid=a.guid=a.guid||r.guid++,e},now:Date.now,support:o}),"function"==typeof Symbol&&(r.fn[Symbol.iterator]=c[Symbol.iterator]),r.each("Boolean Number String Function Array Date RegExp Object Error Symbol".split(" "),function(a,b){j["[object "+b+"]"]=b.toLowerCase()});function w(a){var b=!!a&&"length"in a&&a.length,c=r.type(a);return"function"!==c&&!r.isWindow(a)&&("array"===c||0===b||"number"==typeof b&&b>0&&b-1 in a)}var x=function(a){var b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u="sizzle"+1*new Date,v=a.document,w=0,x=0,y=ha(),z=ha(),A=ha(),B=function(a,b){return a===b&&(l=!0),0},C={}.hasOwnProperty,D=[],E=D.pop,F=D.push,G=D.push,H=D.slice,I=function(a,b){for(var c=0,d=a.length;c<d;c++)if(a[c]===b)return c;return-1},J="checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|ismap|loop|multiple|open|readonly|required|scoped",K="[\\x20\\t\\r\\n\\f]",L="(?:\\\\.|[\\w-]|[^\0-\\xa0])+",M="\\["+K+"*("+L+")(?:"+K+"*([*^$|!~]?=)"+K+"*(?:'((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\"|("+L+"))|)"+K+"*\\]",N=":("+L+")(?:\$(('((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\")|((?:\\\\.|[^\\\\()[\\]]|"+M+")*)|.*)\$|)",O=new RegExp(K+"+","g"),P=new RegExp("^"+K+"+|((?:^|[^\\\\])(?:\\\\.)*)"+K+"+$","g"),Q=new RegExp("^"+K+"*,"+K+"*"),R=new RegExp("^"+K+"*([>+~]|"+K+")"+K+"*"),S=new RegExp("="+K+"*([^\\]'\"]*?)"+K+"*\\]","g"),T=new RegExp(N),U=new RegExp("^"+L+"$"),V={ID:new RegExp("^#("+L+")"),CLASS:new RegExp("^\\.("+L+")"),TAG:new RegExp("^("+L+"|[*])"),ATTR:new RegExp("^"+M),PSEUDO:new RegExp("^"+N),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\$"+K+"*(even|odd|(([+-]|)(\\d*)n|)"+K+"*(?:([+-]|)"+K+"*(\\d+)|))"+K+"*\$|)","i"),bool:new RegExp("^(?:"+J+")$","i"),needsContext:new RegExp("^"+K+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\$"+K+"*((?:-\\d)?\\d*)"+K+"*\$|)(?=[^-]|$)","i")},W=/^(?:input|select|textarea|button)$/i,X=/^h\d$/i,Y=/^[^{]+\{\s*\[native \w/,Z=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,$=/[+~]/,_=new RegExp("\\\\([\\da-f]{1,6}"+K+"?|("+K+")|.)","ig"),aa=function(a,b,c){var d="0x"+b-65536;return d!==d||c?b:d<0?String.fromCharCode(d+65536):String.fromCharCode(d>>10|55296,1023&d|56320)},ba=/([\0-\x1f\x7f]|^-?\d)|^-$|[^\0-\x1f\x7f-\uFFFF\w-]/g,ca=function(a,b){return b?"\0"===a?"\ufffd":a.slice(0,-1)+"\\"+a.charCodeAt(a.length-1).toString(16)+" ":"\\"+a},da=function(){m()},ea=ta(function(a){return a.disabled===!0&&("form"in a||"label"in a)},{dir:"parentNode",next:"legend"});try{G.apply(D=H.call(v.childNodes),v.childNodes),D[v.childNodes.length].nodeType}catch(fa){G={apply:D.length?function(a,b){F.apply(a,H.call(b))}:function(a,b){var c=a.length,d=0;while(a[c++]=b[d++]);a.length=c-1}}}function ga(a,b,d,e){var f,h,j,k,l,o,r,s=b&&b.ownerDocument,w=b?b.nodeType:9;if(d=d||[],"string"!=typeof a||!a||1!==w&&9!==w&&11!==w)return d;if(!e&&((b?b.ownerDocument||b:v)!==n&&m(b),b=b||n,p)){if(11!==w&&(l=Z.exec(a)))if(f=l[1]){if(9===w){if(!(j=b.getElementById(f)))return d;if(j.id===f)return d.push(j),d}else if(s&&(j=s.getElementById(f))&&t(b,j)&&j.id===f)return d.push(j),d}else{if(l[2])return G.apply(d,b.getElementsByTagName(a)),d;if((f=l[3])&&c.getElementsByClassName&&b.getElementsByClassName)return G.apply(d,b.getElementsByClassName(f)),d}if(c.qsa&&!A[a+" "]&&(!q||!q.test(a))){if(1!==w)s=b,r=a;else if("object"!==b.nodeName.toLowerCase()){(k=b.getAttribute("id"))?k=k.replace(ba,ca):b.setAttribute("id",k=u),o=g(a),h=o.length;while(h--)o[h]="#"+k+" "+sa(o[h]);r=o.join(","),s=$.test(a)&&qa(b.parentNode)||b}if(r)try{return G.apply(d,s.querySelectorAll(r)),d}catch(x){}finally{k===u&&b.removeAttribute("id")}}}return i(a.replace(P,"$1"),b,d,e)}function ha(){var a=[];function b(c,e){return a.push(c+" ")>d.cacheLength&&delete b[a.shift()],b[c+" "]=e}return b}function ia(a){return a[u]=!0,a}function ja(a){var b=n.createElement("fieldset");try{return!!a(b)}catch(c){return!1}finally{b.parentNode&&b.parentNode.removeChild(b),b=null}}function ka(a,b){var c=a.split("|"),e=c.length;while(e--)d.attrHandle[c[e]]=b}function la(a,b){var c=b&&a,d=c&&1===a.nodeType&&1===b.nodeType&&a.sourceIndex-b.sourceIndex;if(d)return d;if(c)while(c=c.nextSibling)if(c===b)return-1;return a?1:-1}function ma(a){return function(b){var c=b.nodeName.toLowerCase();return"input"===c&&b.type===a}}function na(a){return function(b){var c=b.nodeName.toLowerCase();return("input"===c||"button"===c)&&b.type===a}}function oa(a){return function(b){return"form"in b?b.parentNode&&b.disabled===!1?"label"in b?"label"in b.parentNode?b.parentNode.disabled===a:b.disabled===a:b.isDisabled===a||b.isDisabled!==!a&&ea(b)===a:b.disabled===a:"label"in b&&b.disabled===a}}function pa(a){return ia(function(b){return b=+b,ia(function(c,d){var e,f=a([],c.length,b),g=f.length;while(g--)c[e=f[g]]&&(c[e]=!(d[e]=c[e]))})})}function qa(a){return a&&"undefined"!=typeof a.getElementsByTagName&&a}c=ga.support={},f=ga.isXML=function(a){var b=a&&(a.ownerDocument||a).documentElement;return!!b&&"HTML"!==b.nodeName},m=ga.setDocument=function(a){var b,e,g=a?a.ownerDocument||a:v;return g!==n&&9===g.nodeType&&g.documentElement?(n=g,o=n.documentElement,p=!f(n),v!==n&&(e=n.defaultView)&&e.top!==e&&(e.addEventListener?e.addEventListener("unload",da,!1):e.attachEvent&&e.attachEvent("onunload",da)),c.attributes=ja(function(a){return a.className="i",!a.getAttribute("className")}),c.getElementsByTagName=ja(function(a){return a.appendChild(n.createComment("")),!a.getElementsByTagName("*").length}),c.getElementsByClassName=Y.test(n.getElementsByClassName),c.getById=ja(function(a){return o.appendChild(a).id=u,!n.getElementsByName||!n.getElementsByName(u).length}),c.getById?(d.filter.ID=function(a){var b=a.replace(_,aa);return function(a){return a.getAttribute("id")===b}},d.find.ID=function(a,b){if("undefined"!=typeof b.getElementById&&p){var c=b.getElementById(a);return c?[c]:[]}}):(d.filter.ID=function(a){var b=a.replace(_,aa);return function(a){var c="undefined"!=typeof a.getAttributeNode&&a.getAttributeNode("id");return c&&c.value===b}},d.find.ID=function(a,b){if("undefined"!=typeof b.getElementById&&p){var c,d,e,f=b.getElementById(a);if(f){if(c=f.getAttributeNode("id"),c&&c.value===a)return[f];e=b.getElementsByName(a),d=0;while(f=e[d++])if(c=f.getAttributeNode("id"),c&&c.value===a)return[f]}return[]}}),d.find.TAG=c.getElementsByTagName?function(a,b){return"undefined"!=typeof b.getElementsByTagName?b.getElementsByTagName(a):c.qsa?b.querySelectorAll(a):void 0}:function(a,b){var c,d=[],e=0,f=b.getElementsByTagName(a);if("*"===a){while(c=f[e++])1===c.nodeType&&d.push(c);return d}return f},d.find.CLASS=c.getElementsByClassName&&function(a,b){if("undefined"!=typeof b.getElementsByClassName&&p)return b.getElementsByClassName(a)},r=[],q=[],(c.qsa=Y.test(n.querySelectorAll))&&(ja(function(a){o.appendChild(a).innerHTML="<a id='"+u+"'></a><select id='"+u+"-\r\\' msallowcapture=''><option selected=''></option></select>",a.querySelectorAll("[msallowcapture^='']").length&&q.push("[*^$]="+K+"*(?:''|\"\")"),a.querySelectorAll("[selected]").length||q.push("\\["+K+"*(?:value|"+J+")"),a.querySelectorAll("[id~="+u+"-]").length||q.push("~="),a.querySelectorAll(":checked").length||q.push(":checked"),a.querySelectorAll("a#"+u+"+*").length||q.push(".#.+[+~]")}),ja(function(a){a.innerHTML="<a href='' disabled='disabled'></a><select disabled='disabled'><option/></select>";var b=n.createElement("input");b.setAttribute("type","hidden"),a.appendChild(b).setAttribute("name","D"),a.querySelectorAll("[name=d]").length&&q.push("name"+K+"*[*^$|!~]?="),2!==a.querySelectorAll(":enabled").length&&q.push(":enabled",":disabled"),o.appendChild(a).disabled=!0,2!==a.querySelectorAll(":disabled").length&&q.push(":enabled",":disabled"),a.querySelectorAll("*,:x"),q.push(",.*:")})),(c.matchesSelector=Y.test(s=o.matches||o.webkitMatchesSelector||o.mozMatchesSelector||o.oMatchesSelector||o.msMatchesSelector))&&ja(function(a){c.disconnectedMatch=s.call(a,"*"),s.call(a,"[s!='']:x"),r.push("!=",N)}),q=q.length&&new RegExp(q.join("|")),r=r.length&&new RegExp(r.join("|")),b=Y.test(o.compareDocumentPosition),t=b||Y.test(o.contains)?function(a,b){var c=9===a.nodeType?a.documentElement:a,d=b&&b.parentNode;return a===d||!(!d||1!==d.nodeType||!(c.contains?c.contains(d):a.compareDocumentPosition&&16&a.compareDocumentPosition(d)))}:function(a,b){if(b)while(b=b.parentNode)if(b===a)return!0;return!1},B=b?function(a,b){if(a===b)return l=!0,0;var d=!a.compareDocumentPosition-!b.compareDocumentPosition;return d?d:(d=(a.ownerDocument||a)===(b.ownerDocument||b)?a.compareDocumentPosition(b):1,1&d||!c.sortDetached&&b.compareDocumentPosition(a)===d?a===n||a.ownerDocument===v&&t(v,a)?-1:b===n||b.ownerDocument===v&&t(v,b)?1:k?I(k,a)-I(k,b):0:4&d?-1:1)}:function(a,b){if(a===b)return l=!0,0;var c,d=0,e=a.parentNode,f=b.parentNode,g=[a],h=[b];if(!e||!f)return a===n?-1:b===n?1:e?-1:f?1:k?I(k,a)-I(k,b):0;if(e===f)return la(a,b);c=a;while(c=c.parentNode)g.unshift(c);c=b;while(c=c.parentNode)h.unshift(c);while(g[d]===h[d])d++;return d?la(g[d],h[d]):g[d]===v?-1:h[d]===v?1:0},n):n},ga.matches=function(a,b){return ga(a,null,null,b)},ga.matchesSelector=function(a,b){if((a.ownerDocument||a)!==n&&m(a),b=b.replace(S,"='$1']"),c.matchesSelector&&p&&!A[b+" "]&&(!r||!r.test(b))&&(!q||!q.test(b)))try{var d=s.call(a,b);if(d||c.disconnectedMatch||a.document&&11!==a.document.nodeType)return d}catch(e){}return ga(b,n,null,[a]).length>0},ga.contains=function(a,b){return(a.ownerDocument||a)!==n&&m(a),t(a,b)},ga.attr=function(a,b){(a.ownerDocument||a)!==n&&m(a);var e=d.attrHandle[b.toLowerCase()],f=e&&C.call(d.attrHandle,b.toLowerCase())?e(a,b,!p):void 0;return void 0!==f?f:c.attributes||!p?a.getAttribute(b):(f=a.getAttributeNode(b))&&f.specified?f.value:null},ga.escape=function(a){return(a+"").replace(ba,ca)},ga.error=function(a){throw new Error("Syntax error, unrecognized expression: "+a)},ga.uniqueSort=function(a){var b,d=[],e=0,f=0;if(l=!c.detectDuplicates,k=!c.sortStable&&a.slice(0),a.sort(B),l){while(b=a[f++])b===a[f]&&(e=d.push(f));while(e--)a.splice(d[e],1)}return k=null,a},e=ga.getText=function(a){var b,c="",d=0,f=a.nodeType;if(f){if(1===f||9===f||11===f){if("string"==typeof a.textContent)return a.textContent;for(a=a.firstChild;a;a=a.nextSibling)c+=e(a)}else if(3===f||4===f)return a.nodeValue}else while(b=a[d++])c+=e(b);return c},d=ga.selectors={cacheLength:50,createPseudo:ia,match:V,attrHandle:{},find:{},relative:{">":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(a){return a[1]=a[1].replace(_,aa),a[3]=(a[3]||a[4]||a[5]||"").replace(_,aa),"~="===a[2]&&(a[3]=" "+a[3]+" "),a.slice(0,4)},CHILD:function(a){return a[1]=a[1].toLowerCase(),"nth"===a[1].slice(0,3)?(a[3]||ga.error(a[0]),a[4]=+(a[4]?a[5]+(a[6]||1):2*("even"===a[3]||"odd"===a[3])),a[5]=+(a[7]+a[8]||"odd"===a[3])):a[3]&&ga.error(a[0]),a},PSEUDO:function(a){var b,c=!a[6]&&a[2];return V.CHILD.test(a[0])?null:(a[3]?a[2]=a[4]||a[5]||"":c&&T.test(c)&&(b=g(c,!0))&&(b=c.indexOf(")",c.length-b)-c.length)&&(a[0]=a[0].slice(0,b),a[2]=c.slice(0,b)),a.slice(0,3))}},filter:{TAG:function(a){var b=a.replace(_,aa).toLowerCase();return"*"===a?function(){return!0}:function(a){return a.nodeName&&a.nodeName.toLowerCase()===b}},CLASS:function(a){var b=y[a+" "];return b||(b=new RegExp("(^|"+K+")"+a+"("+K+"|$)"))&&y(a,function(a){return b.test("string"==typeof a.className&&a.className||"undefined"!=typeof a.getAttribute&&a.getAttribute("class")||"")})},ATTR:function(a,b,c){return function(d){var e=ga.attr(d,a);return null==e?"!="===b:!b||(e+="","="===b?e===c:"!="===b?e!==c:"^="===b?c&&0===e.indexOf(c):"*="===b?c&&e.indexOf(c)>-1:"$="===b?c&&e.slice(-c.length)===c:"~="===b?(" "+e.replace(O," ")+" ").indexOf(c)>-1:"|="===b&&(e===c||e.slice(0,c.length+1)===c+"-"))}},CHILD:function(a,b,c,d,e){var f="nth"!==a.slice(0,3),g="last"!==a.slice(-4),h="of-type"===b;return 1===d&&0===e?function(a){return!!a.parentNode}:function(b,c,i){var j,k,l,m,n,o,p=f!==g?"nextSibling":"previousSibling",q=b.parentNode,r=h&&b.nodeName.toLowerCase(),s=!i&&!h,t=!1;if(q){if(f){while(p){m=b;while(m=m[p])if(h?m.nodeName.toLowerCase()===r:1===m.nodeType)return!1;o=p="only"===a&&!o&&"nextSibling"}return!0}if(o=[g?q.firstChild:q.lastChild],g&&s){m=q,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n&&j[2],m=n&&q.childNodes[n];while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if(1===m.nodeType&&++t&&m===b){k[a]=[w,n,t];break}}else if(s&&(m=b,l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),j=k[a]||[],n=j[0]===w&&j[1],t=n),t===!1)while(m=++n&&m&&m[p]||(t=n=0)||o.pop())if((h?m.nodeName.toLowerCase()===r:1===m.nodeType)&&++t&&(s&&(l=m[u]||(m[u]={}),k=l[m.uniqueID]||(l[m.uniqueID]={}),k[a]=[w,t]),m===b))break;return t-=e,t===d||t%d===0&&t/d>=0}}},PSEUDO:function(a,b){var c,e=d.pseudos[a]||d.setFilters[a.toLowerCase()]||ga.error("unsupported pseudo: "+a);return e[u]?e(b):e.length>1?(c=[a,a,"",b],d.setFilters.hasOwnProperty(a.toLowerCase())?ia(function(a,c){var d,f=e(a,b),g=f.length;while(g--)d=I(a,f[g]),a[d]=!(c[d]=f[g])}):function(a){return e(a,0,c)}):e}},pseudos:{not:ia(function(a){var b=[],c=[],d=h(a.replace(P,"$1"));return d[u]?ia(function(a,b,c,e){var f,g=d(a,null,e,[]),h=a.length;while(h--)(f=g[h])&&(a[h]=!(b[h]=f))}):function(a,e,f){return b[0]=a,d(b,null,f,c),b[0]=null,!c.pop()}}),has:ia(function(a){return function(b){return ga(a,b).length>0}}),contains:ia(function(a){return a=a.replace(_,aa),function(b){return(b.textContent||b.innerText||e(b)).indexOf(a)>-1}}),lang:ia(function(a){return U.test(a||"")||ga.error("unsupported lang: "+a),a=a.replace(_,aa).toLowerCase(),function(b){var c;do if(c=p?b.lang:b.getAttribute("xml:lang")||b.getAttribute("lang"))return c=c.toLowerCase(),c===a||0===c.indexOf(a+"-");while((b=b.parentNode)&&1===b.nodeType);return!1}}),target:function(b){var c=a.location&&a.location.hash;return c&&c.slice(1)===b.id},root:function(a){return a===o},focus:function(a){return a===n.activeElement&&(!n.hasFocus||n.hasFocus())&&!!(a.type||a.href||~a.tabIndex)},enabled:oa(!1),disabled:oa(!0),checked:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&!!a.checked||"option"===b&&!!a.selected},selected:function(a){return a.parentNode&&a.parentNode.selectedIndex,a.selected===!0},empty:function(a){for(a=a.firstChild;a;a=a.nextSibling)if(a.nodeType<6)return!1;return!0},parent:function(a){return!d.pseudos.empty(a)},header:function(a){return X.test(a.nodeName)},input:function(a){return W.test(a.nodeName)},button:function(a){var b=a.nodeName.toLowerCase();return"input"===b&&"button"===a.type||"button"===b},text:function(a){var b;return"input"===a.nodeName.toLowerCase()&&"text"===a.type&&(null==(b=a.getAttribute("type"))||"text"===b.toLowerCase())},first:pa(function(){return[0]}),last:pa(function(a,b){return[b-1]}),eq:pa(function(a,b,c){return[c<0?c+b:c]}),even:pa(function(a,b){for(var c=0;c<b;c+=2)a.push(c);return a}),odd:pa(function(a,b){for(var c=1;c<b;c+=2)a.push(c);return a}),lt:pa(function(a,b,c){for(var d=c<0?c+b:c;--d>=0;)a.push(d);return a}),gt:pa(function(a,b,c){for(var d=c<0?c+b:c;++d<b;)a.push(d);return a})}},d.pseudos.nth=d.pseudos.eq;for(b in{radio:!0,checkbox:!0,file:!0,password:!0,image:!0})d.pseudos[b]=ma(b);for(b in{submit:!0,reset:!0})d.pseudos[b]=na(b);function ra(){}ra.prototype=d.filters=d.pseudos,d.setFilters=new ra,g=ga.tokenize=function(a,b){var c,e,f,g,h,i,j,k=z[a+" "];if(k)return b?0:k.slice(0);h=a,i=[],j=d.preFilter;while(h){c&&!(e=Q.exec(h))||(e&&(h=h.slice(e[0].length)||h),i.push(f=[])),c=!1,(e=R.exec(h))&&(c=e.shift(),f.push({value:c,type:e[0].replace(P," ")}),h=h.slice(c.length));for(g in d.filter)!(e=V[g].exec(h))||j[g]&&!(e=j[g](e))||(c=e.shift(),f.push({value:c,type:g,matches:e}),h=h.slice(c.length));if(!c)break}return b?h.length:h?ga.error(a):z(a,i).slice(0)};function sa(a){for(var b=0,c=a.length,d="";b<c;b++)d+=a[b].value;return d}function ta(a,b,c){var d=b.dir,e=b.next,f=e||d,g=c&&"parentNode"===f,h=x++;return b.first?function(b,c,e){while(b=b[d])if(1===b.nodeType||g)return a(b,c,e);return!1}:function(b,c,i){var j,k,l,m=[w,h];if(i){while(b=b[d])if((1===b.nodeType||g)&&a(b,c,i))return!0}else while(b=b[d])if(1===b.nodeType||g)if(l=b[u]||(b[u]={}),k=l[b.uniqueID]||(l[b.uniqueID]={}),e&&e===b.nodeName.toLowerCase())b=b[d]||b;else{if((j=k[f])&&j[0]===w&&j[1]===h)return m[2]=j[2];if(k[f]=m,m[2]=a(b,c,i))return!0}return!1}}function ua(a){return a.length>1?function(b,c,d){var e=a.length;while(e--)if(!a[e](b,c,d))return!1;return!0}:a[0]}function va(a,b,c){for(var d=0,e=b.length;d<e;d++)ga(a,b[d],c);return c}function wa(a,b,c,d,e){for(var f,g=[],h=0,i=a.length,j=null!=b;h<i;h++)(f=a[h])&&(c&&!c(f,d,e)||(g.push(f),j&&b.push(h)));return g}function xa(a,b,c,d,e,f){return d&&!d[u]&&(d=xa(d)),e&&!e[u]&&(e=xa(e,f)),ia(function(f,g,h,i){var j,k,l,m=[],n=[],o=g.length,p=f||va(b||"*",h.nodeType?[h]:h,[]),q=!a||!f&&b?p:wa(p,m,a,h,i),r=c?e||(f?a:o||d)?[]:g:q;if(c&&c(q,r,h,i),d){j=wa(r,n),d(j,[],h,i),k=j.length;while(k--)(l=j[k])&&(r[n[k]]=!(q[n[k]]=l))}if(f){if(e||a){if(e){j=[],k=r.length;while(k--)(l=r[k])&&j.push(q[k]=l);e(null,r=[],j,i)}k=r.length;while(k--)(l=r[k])&&(j=e?I(f,l):m[k])>-1&&(f[j]=!(g[j]=l))}}else r=wa(r===g?r.splice(o,r.length):r),e?e(null,g,r,i):G.apply(g,r)})}function ya(a){for(var b,c,e,f=a.length,g=d.relative[a[0].type],h=g||d.relative[" "],i=g?1:0,k=ta(function(a){return a===b},h,!0),l=ta(function(a){return I(b,a)>-1},h,!0),m=[function(a,c,d){var e=!g&&(d||c!==j)||((b=c).nodeType?k(a,c,d):l(a,c,d));return b=null,e}];i<f;i++)if(c=d.relative[a[i].type])m=[ta(ua(m),c)];else{if(c=d.filter[a[i].type].apply(null,a[i].matches),c[u]){for(e=++i;e<f;e++)if(d.relative[a[e].type])break;return xa(i>1&&ua(m),i>1&&sa(a.slice(0,i-1).concat({value:" "===a[i-2].type?"*":""})).replace(P,"$1"),c,i<e&&ya(a.slice(i,e)),e<f&&ya(a=a.slice(e)),e<f&&sa(a))}m.push(c)}return ua(m)}function za(a,b){var c=b.length>0,e=a.length>0,f=function(f,g,h,i,k){var l,o,q,r=0,s="0",t=f&&[],u=[],v=j,x=f||e&&d.find.TAG("*",k),y=w+=null==v?1:Math.random()||.1,z=x.length;for(k&&(j=g===n||g||k);s!==z&&null!=(l=x[s]);s++){if(e&&l){o=0,g||l.ownerDocument===n||(m(l),h=!p);while(q=a[o++])if(q(l,g||n,h)){i.push(l);break}k&&(w=y)}c&&((l=!q&&l)&&r--,f&&t.push(l))}if(r+=s,c&&s!==r){o=0;while(q=b[o++])q(t,u,g,h);if(f){if(r>0)while(s--)t[s]||u[s]||(u[s]=E.call(i));u=wa(u)}G.apply(i,u),k&&!f&&u.length>0&&r+b.length>1&&ga.uniqueSort(i)}return k&&(w=y,j=v),t};return c?ia(f):f}return h=ga.compile=function(a,b){var c,d=[],e=[],f=A[a+" "];if(!f){b||(b=g(a)),c=b.length;while(c--)f=ya(b[c]),f[u]?d.push(f):e.push(f);f=A(a,za(e,d)),f.selector=a}return f},i=ga.select=function(a,b,c,e){var f,i,j,k,l,m="function"==typeof a&&a,n=!e&&g(a=m.selector||a);if(c=c||[],1===n.length){if(i=n[0]=n[0].slice(0),i.length>2&&"ID"===(j=i[0]).type&&9===b.nodeType&&p&&d.relative[i[1].type]){if(b=(d.find.ID(j.matches[0].replace(_,aa),b)||[])[0],!b)return c;m&&(b=b.parentNode),a=a.slice(i.shift().value.length)}f=V.needsContext.test(a)?0:i.length;while(f--){if(j=i[f],d.relative[k=j.type])break;if((l=d.find[k])&&(e=l(j.matches[0].replace(_,aa),$.test(i[0].type)&&qa(b.parentNode)||b))){if(i.splice(f,1),a=e.length&&sa(i),!a)return G.apply(c,e),c;break}}}return(m||h(a,n))(e,b,!p,c,!b||$.test(a)&&qa(b.parentNode)||b),c},c.sortStable=u.split("").sort(B).join("")===u,c.detectDuplicates=!!l,m(),c.sortDetached=ja(function(a){return 1&a.compareDocumentPosition(n.createElement("fieldset"))}),ja(function(a){return a.innerHTML="<a href='#'></a>","#"===a.firstChild.getAttribute("href")})||ka("type|href|height|width",function(a,b,c){if(!c)return a.getAttribute(b,"type"===b.toLowerCase()?1:2)}),c.attributes&&ja(function(a){return a.innerHTML="<input/>",a.firstChild.setAttribute("value",""),""===a.firstChild.getAttribute("value")})||ka("value",function(a,b,c){if(!c&&"input"===a.nodeName.toLowerCase())return a.defaultValue}),ja(function(a){return null==a.getAttribute("disabled")})||ka(J,function(a,b,c){var d;if(!c)return a[b]===!0?b.toLowerCase():(d=a.getAttributeNode(b))&&d.specified?d.value:null}),ga}(a);r.find=x,r.expr=x.selectors,r.expr[":"]=r.expr.pseudos,r.uniqueSort=r.unique=x.uniqueSort,r.text=x.getText,r.isXMLDoc=x.isXML,r.contains=x.contains,r.escapeSelector=x.escape;var y=function(a,b,c){var d=[],e=void 0!==c;while((a=a[b])&&9!==a.nodeType)if(1===a.nodeType){if(e&&r(a).is(c))break;d.push(a)}return d},z=function(a,b){for(var c=[];a;a=a.nextSibling)1===a.nodeType&&a!==b&&c.push(a);return c},A=r.expr.match.needsContext;function B(a,b){return a.nodeName&&a.nodeName.toLowerCase()===b.toLowerCase()}var C=/^<([a-z][^\/\0>:\x20\t\r\n\f]*)[\x20\t\r\n\f]*\/?>(?:<\/\1>|)$/i,D=/^.[^:#\[\.,]*$/;function E(a,b,c){return r.isFunction(b)?r.grep(a,function(a,d){return!!b.call(a,d,a)!==c}):b.nodeType?r.grep(a,function(a){return a===b!==c}):"string"!=typeof b?r.grep(a,function(a){return i.call(b,a)>-1!==c}):D.test(b)?r.filter(b,a,c):(b=r.filter(b,a),r.grep(a,function(a){return i.call(b,a)>-1!==c&&1===a.nodeType}))}r.filter=function(a,b,c){var d=b[0];return c&&(a=":not("+a+")"),1===b.length&&1===d.nodeType?r.find.matchesSelector(d,a)?[d]:[]:r.find.matches(a,r.grep(b,function(a){return 1===a.nodeType}))},r.fn.extend({find:function(a){var b,c,d=this.length,e=this;if("string"!=typeof a)return this.pushStack(r(a).filter(function(){for(b=0;b<d;b++)if(r.contains(e[b],this))return!0}));for(c=this.pushStack([]),b=0;b<d;b++)r.find(a,e[b],c);return d>1?r.uniqueSort(c):c},filter:function(a){return this.pushStack(E(this,a||[],!1))},not:function(a){return this.pushStack(E(this,a||[],!0))},is:function(a){return!!E(this,"string"==typeof a&&A.test(a)?r(a):a||[],!1).length}});var F,G=/^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]+))$/,H=r.fn.init=function(a,b,c){var e,f;if(!a)return this;if(c=c||F,"string"==typeof a){if(e="<"===a[0]&&">"===a[a.length-1]&&a.length>=3?[null,a,null]:G.exec(a),!e||!e[1]&&b)return!b||b.jquery?(b||c).find(a):this.constructor(b).find(a);if(e[1]){if(b=b instanceof r?b[0]:b,r.merge(this,r.parseHTML(e[1],b&&b.nodeType?b.ownerDocument||b:d,!0)),C.test(e[1])&&r.isPlainObject(b))for(e in b)r.isFunction(this[e])?this[e](b[e]):this.attr(e,b[e]);return this}return f=d.getElementById(e[2]),f&&(this[0]=f,this.length=1),this}return a.nodeType?(this[0]=a,this.length=1,this):r.isFunction(a)?void 0!==c.ready?c.ready(a):a(r):r.makeArray(a,this)};H.prototype=r.fn,F=r(d);var I=/^(?:parents|prev(?:Until|All))/,J={children:!0,contents:!0,next:!0,prev:!0};r.fn.extend({has:function(a){var b=r(a,this),c=b.length;return this.filter(function(){for(var a=0;a<c;a++)if(r.contains(this,b[a]))return!0})},closest:function(a,b){var c,d=0,e=this.length,f=[],g="string"!=typeof a&&r(a);if(!A.test(a))for(;d<e;d++)for(c=this[d];c&&c!==b;c=c.parentNode)if(c.nodeType<11&&(g?g.index(c)>-1:1===c.nodeType&&r.find.matchesSelector(c,a))){f.push(c);break}return this.pushStack(f.length>1?r.uniqueSort(f):f)},index:function(a){return a?"string"==typeof a?i.call(r(a),this[0]):i.call(this,a.jquery?a[0]:a):this[0]&&this[0].parentNode?this.first().prevAll().length:-1},add:function(a,b){return this.pushStack(r.uniqueSort(r.merge(this.get(),r(a,b))))},addBack:function(a){return this.add(null==a?this.prevObject:this.prevObject.filter(a))}});function K(a,b){while((a=a[b])&&1!==a.nodeType);return a}r.each({parent:function(a){var b=a.parentNode;return b&&11!==b.nodeType?b:null},parents:function(a){return y(a,"parentNode")},parentsUntil:function(a,b,c){return y(a,"parentNode",c)},next:function(a){return K(a,"nextSibling")},prev:function(a){return K(a,"previousSibling")},nextAll:function(a){return y(a,"nextSibling")},prevAll:function(a){return y(a,"previousSibling")},nextUntil:function(a,b,c){return y(a,"nextSibling",c)},prevUntil:function(a,b,c){return y(a,"previousSibling",c)},siblings:function(a){return z((a.parentNode||{}).firstChild,a)},children:function(a){return z(a.firstChild)},contents:function(a){return B(a,"iframe")?a.contentDocument:(B(a,"template")&&(a=a.content||a),r.merge([],a.childNodes))}},function(a,b){r.fn[a]=function(c,d){var e=r.map(this,b,c);return"Until"!==a.slice(-5)&&(d=c),d&&"string"==typeof d&&(e=r.filter(d,e)),this.length>1&&(J[a]||r.uniqueSort(e),I.test(a)&&e.reverse()),this.pushStack(e)}});var L=/[^\x20\t\r\n\f]+/g;function M(a){var b={};return r.each(a.match(L)||[],function(a,c){b[c]=!0}),b}r.Callbacks=function(a){a="string"==typeof a?M(a):r.extend({},a);var b,c,d,e,f=[],g=[],h=-1,i=function(){for(e=e||a.once,d=b=!0;g.length;h=-1){c=g.shift();while(++h<f.length)f[h].apply(c[0],c[1])===!1&&a.stopOnFalse&&(h=f.length,c=!1)}a.memory||(c=!1),b=!1,e&&(f=c?[]:"")},j={add:function(){return f&&(c&&!b&&(h=f.length-1,g.push(c)),function d(b){r.each(b,function(b,c){r.isFunction(c)?a.unique&&j.has(c)||f.push(c):c&&c.length&&"string"!==r.type(c)&&d(c)})}(arguments),c&&!b&&i()),this},remove:function(){return r.each(arguments,function(a,b){var c;while((c=r.inArray(b,f,c))>-1)f.splice(c,1),c<=h&&h--}),this},has:function(a){return a?r.inArray(a,f)>-1:f.length>0},empty:function(){return f&&(f=[]),this},disable:function(){return e=g=[],f=c="",this},disabled:function(){return!f},lock:function(){return e=g=[],c||b||(f=c=""),this},locked:function(){return!!e},fireWith:function(a,c){return e||(c=c||[],c=[a,c.slice?c.slice():c],g.push(c),b||i()),this},fire:function(){return j.fireWith(this,arguments),this},fired:function(){return!!d}};return j};function N(a){return a}function O(a){throw a}function P(a,b,c,d){var e;try{a&&r.isFunction(e=a.promise)?e.call(a).done(b).fail(c):a&&r.isFunction(e=a.then)?e.call(a,b,c):b.apply(void 0,[a].slice(d))}catch(a){c.apply(void 0,[a])}}r.extend({Deferred:function(b){var c=[["notify","progress",r.Callbacks("memory"),r.Callbacks("memory"),2],["resolve","done",r.Callbacks("once memory"),r.Callbacks("once memory"),0,"resolved"],["reject","fail",r.Callbacks("once memory"),r.Callbacks("once memory"),1,"rejected"]],d="pending",e={state:function(){return d},always:function(){return f.done(arguments).fail(arguments),this},"catch":function(a){return e.then(null,a)},pipe:function(){var a=arguments;return r.Deferred(function(b){r.each(c,function(c,d){var e=r.isFunction(a[d[4]])&&a[d[4]];f[d[1]](function(){var a=e&&e.apply(this,arguments);a&&r.isFunction(a.promise)?a.promise().progress(b.notify).done(b.resolve).fail(b.reject):b[d[0]+"With"](this,e?[a]:arguments)})}),a=null}).promise()},then:function(b,d,e){var f=0;function g(b,c,d,e){return function(){var h=this,i=arguments,j=function(){var a,j;if(!(b<f)){if(a=d.apply(h,i),a===c.promise())throw new TypeError("Thenable self-resolution");j=a&&("object"==typeof a||"function"==typeof a)&&a.then,r.isFunction(j)?e?j.call(a,g(f,c,N,e),g(f,c,O,e)):(f++,j.call(a,g(f,c,N,e),g(f,c,O,e),g(f,c,N,c.notifyWith))):(d!==N&&(h=void 0,i=[a]),(e||c.resolveWith)(h,i))}},k=e?j:function(){try{j()}catch(a){r.Deferred.exceptionHook&&r.Deferred.exceptionHook(a,k.stackTrace),b+1>=f&&(d!==O&&(h=void 0,i=[a]),c.rejectWith(h,i))}};b?k():(r.Deferred.getStackHook&&(k.stackTrace=r.Deferred.getStackHook()),a.setTimeout(k))}}return r.Deferred(function(a){c[0][3].add(g(0,a,r.isFunction(e)?e:N,a.notifyWith)),c[1][3].add(g(0,a,r.isFunction(b)?b:N)),c[2][3].add(g(0,a,r.isFunction(d)?d:O))}).promise()},promise:function(a){return null!=a?r.extend(a,e):e}},f={};return r.each(c,function(a,b){var g=b[2],h=b[5];e[b[1]]=g.add,h&&g.add(function(){d=h},c[3-a][2].disable,c[0][2].lock),g.add(b[3].fire),f[b[0]]=function(){return f[b[0]+"With"](this===f?void 0:this,arguments),this},f[b[0]+"With"]=g.fireWith}),e.promise(f),b&&b.call(f,f),f},when:function(a){var b=arguments.length,c=b,d=Array(c),e=f.call(arguments),g=r.Deferred(),h=function(a){return function(c){d[a]=this,e[a]=arguments.length>1?f.call(arguments):c,--b||g.resolveWith(d,e)}};if(b<=1&&(P(a,g.done(h(c)).resolve,g.reject,!b),"pending"===g.state()||r.isFunction(e[c]&&e[c].then)))return g.then();while(c--)P(e[c],h(c),g.reject);return g.promise()}});var Q=/^(Eval|Internal|Range|Reference|Syntax|Type|URI)Error$/;r.Deferred.exceptionHook=function(b,c){a.console&&a.console.warn&&b&&Q.test(b.name)&&a.console.warn("jQuery.Deferred exception: "+b.message,b.stack,c)},r.readyException=function(b){a.setTimeout(function(){throw b})};var R=r.Deferred();r.fn.ready=function(a){return R.then(a)["catch"](function(a){r.readyException(a)}),this},r.extend({isReady:!1,readyWait:1,ready:function(a){(a===!0?--r.readyWait:r.isReady)||(r.isReady=!0,a!==!0&&--r.readyWait>0||R.resolveWith(d,[r]))}}),r.ready.then=R.then;function S(){d.removeEventListener("DOMContentLoaded",S),

9+a.removeEventListener("load",S),r.ready()}"complete"===d.readyState||"loading"!==d.readyState&&!d.documentElement.doScroll?a.setTimeout(r.ready):(d.addEventListener("DOMContentLoaded",S),a.addEventListener("load",S));var T=function(a,b,c,d,e,f,g){var h=0,i=a.length,j=null==c;if("object"===r.type(c)){e=!0;for(h in c)T(a,b,h,c[h],!0,f,g)}else if(void 0!==d&&(e=!0,r.isFunction(d)||(g=!0),j&&(g?(b.call(a,d),b=null):(j=b,b=function(a,b,c){return j.call(r(a),c)})),b))for(;h<i;h++)b(a[h],c,g?d:d.call(a[h],h,b(a[h],c)));return e?a:j?b.call(a):i?b(a[0],c):f},U=function(a){return 1===a.nodeType||9===a.nodeType||!+a.nodeType};function V(){this.expando=r.expando+V.uid++}V.uid=1,V.prototype={cache:function(a){var b=a[this.expando];return b||(b={},U(a)&&(a.nodeType?a[this.expando]=b:Object.defineProperty(a,this.expando,{value:b,configurable:!0}))),b},set:function(a,b,c){var d,e=this.cache(a);if("string"==typeof b)e[r.camelCase(b)]=c;else for(d in b)e[r.camelCase(d)]=b[d];return e},get:function(a,b){return void 0===b?this.cache(a):a[this.expando]&&a[this.expando][r.camelCase(b)]},access:function(a,b,c){return void 0===b||b&&"string"==typeof b&&void 0===c?this.get(a,b):(this.set(a,b,c),void 0!==c?c:b)},remove:function(a,b){var c,d=a[this.expando];if(void 0!==d){if(void 0!==b){Array.isArray(b)?b=b.map(r.camelCase):(b=r.camelCase(b),b=b in d?[b]:b.match(L)||[]),c=b.length;while(c--)delete d[b[c]]}(void 0===b||r.isEmptyObject(d))&&(a.nodeType?a[this.expando]=void 0:delete a[this.expando])}},hasData:function(a){var b=a[this.expando];return void 0!==b&&!r.isEmptyObject(b)}};var W=new V,X=new V,Y=/^(?:\{[\w\W]*\}|\[[\w\W]*\])$/,Z=/[A-Z]/g;function $(a){return"true"===a||"false"!==a&&("null"===a?null:a===+a+""?+a:Y.test(a)?JSON.parse(a):a)}function _(a,b,c){var d;if(void 0===c&&1===a.nodeType)if(d="data-"+b.replace(Z,"-$&").toLowerCase(),c=a.getAttribute(d),"string"==typeof c){try{c=$(c)}catch(e){}X.set(a,b,c)}else c=void 0;return c}r.extend({hasData:function(a){return X.hasData(a)||W.hasData(a)},data:function(a,b,c){return X.access(a,b,c)},removeData:function(a,b){X.remove(a,b)},_data:function(a,b,c){return W.access(a,b,c)},_removeData:function(a,b){W.remove(a,b)}}),r.fn.extend({data:function(a,b){var c,d,e,f=this[0],g=f&&f.attributes;if(void 0===a){if(this.length&&(e=X.get(f),1===f.nodeType&&!W.get(f,"hasDataAttrs"))){c=g.length;while(c--)g[c]&&(d=g[c].name,0===d.indexOf("data-")&&(d=r.camelCase(d.slice(5)),_(f,d,e[d])));W.set(f,"hasDataAttrs",!0)}return e}return"object"==typeof a?this.each(function(){X.set(this,a)}):T(this,function(b){var c;if(f&&void 0===b){if(c=X.get(f,a),void 0!==c)return c;if(c=_(f,a),void 0!==c)return c}else this.each(function(){X.set(this,a,b)})},null,b,arguments.length>1,null,!0)},removeData:function(a){return this.each(function(){X.remove(this,a)})}}),r.extend({queue:function(a,b,c){var d;if(a)return b=(b||"fx")+"queue",d=W.get(a,b),c&&(!d||Array.isArray(c)?d=W.access(a,b,r.makeArray(c)):d.push(c)),d||[]},dequeue:function(a,b){b=b||"fx";var c=r.queue(a,b),d=c.length,e=c.shift(),f=r._queueHooks(a,b),g=function(){r.dequeue(a,b)};"inprogress"===e&&(e=c.shift(),d--),e&&("fx"===b&&c.unshift("inprogress"),delete f.stop,e.call(a,g,f)),!d&&f&&f.empty.fire()},_queueHooks:function(a,b){var c=b+"queueHooks";return W.get(a,c)||W.access(a,c,{empty:r.Callbacks("once memory").add(function(){W.remove(a,[b+"queue",c])})})}}),r.fn.extend({queue:function(a,b){var c=2;return"string"!=typeof a&&(b=a,a="fx",c--),arguments.length<c?r.queue(this[0],a):void 0===b?this:this.each(function(){var c=r.queue(this,a,b);r._queueHooks(this,a),"fx"===a&&"inprogress"!==c[0]&&r.dequeue(this,a)})},dequeue:function(a){return this.each(function(){r.dequeue(this,a)})},clearQueue:function(a){return this.queue(a||"fx",[])},promise:function(a,b){var c,d=1,e=r.Deferred(),f=this,g=this.length,h=function(){--d||e.resolveWith(f,[f])};"string"!=typeof a&&(b=a,a=void 0),a=a||"fx";while(g--)c=W.get(f[g],a+"queueHooks"),c&&c.empty&&(d++,c.empty.add(h));return h(),e.promise(b)}});var aa=/[+-]?(?:\d*\.|)\d+(?:[eE][+-]?\d+|)/.source,ba=new RegExp("^(?:([+-])=|)("+aa+")([a-z%]*)$","i"),ca=["Top","Right","Bottom","Left"],da=function(a,b){return a=b||a,"none"===a.style.display||""===a.style.display&&r.contains(a.ownerDocument,a)&&"none"===r.css(a,"display")},ea=function(a,b,c,d){var e,f,g={};for(f in b)g[f]=a.style[f],a.style[f]=b[f];e=c.apply(a,d||[]);for(f in b)a.style[f]=g[f];return e};function fa(a,b,c,d){var e,f=1,g=20,h=d?function(){return d.cur()}:function(){return r.css(a,b,"")},i=h(),j=c&&c[3]||(r.cssNumber[b]?"":"px"),k=(r.cssNumber[b]||"px"!==j&&+i)&&ba.exec(r.css(a,b));if(k&&k[3]!==j){j=j||k[3],c=c||[],k=+i||1;do f=f||".5",k/=f,r.style(a,b,k+j);while(f!==(f=h()/i)&&1!==f&&--g)}return c&&(k=+k||+i||0,e=c[1]?k+(c[1]+1)*c[2]:+c[2],d&&(d.unit=j,d.start=k,d.end=e)),e}var ga={};function ha(a){var b,c=a.ownerDocument,d=a.nodeName,e=ga[d];return e?e:(b=c.body.appendChild(c.createElement(d)),e=r.css(b,"display"),b.parentNode.removeChild(b),"none"===e&&(e="block"),ga[d]=e,e)}function ia(a,b){for(var c,d,e=[],f=0,g=a.length;f<g;f++)d=a[f],d.style&&(c=d.style.display,b?("none"===c&&(e[f]=W.get(d,"display")||null,e[f]||(d.style.display="")),""===d.style.display&&da(d)&&(e[f]=ha(d))):"none"!==c&&(e[f]="none",W.set(d,"display",c)));for(f=0;f<g;f++)null!=e[f]&&(a[f].style.display=e[f]);return a}r.fn.extend({show:function(){return ia(this,!0)},hide:function(){return ia(this)},toggle:function(a){return"boolean"==typeof a?a?this.show():this.hide():this.each(function(){da(this)?r(this).show():r(this).hide()})}});var ja=/^(?:checkbox|radio)$/i,ka=/<([a-z][^\/\0>\x20\t\r\n\f]+)/i,la=/^$|\/(?:java|ecma)script/i,ma={option:[1,"<select multiple='multiple'>","</select>"],thead:[1,"<table>","</table>"],col:[2,"<table><colgroup>","</colgroup></table>"],tr:[2,"<table><tbody>","</tbody></table>"],td:[3,"<table><tbody><tr>","</tr></tbody></table>"],_default:[0,"",""]};ma.optgroup=ma.option,ma.tbody=ma.tfoot=ma.colgroup=ma.caption=ma.thead,ma.th=ma.td;function na(a,b){var c;return c="undefined"!=typeof a.getElementsByTagName?a.getElementsByTagName(b||"*"):"undefined"!=typeof a.querySelectorAll?a.querySelectorAll(b||"*"):[],void 0===b||b&&B(a,b)?r.merge([a],c):c}function oa(a,b){for(var c=0,d=a.length;c<d;c++)W.set(a[c],"globalEval",!b||W.get(b[c],"globalEval"))}var pa=/<|&#?\w+;/;function qa(a,b,c,d,e){for(var f,g,h,i,j,k,l=b.createDocumentFragment(),m=[],n=0,o=a.length;n<o;n++)if(f=a[n],f||0===f)if("object"===r.type(f))r.merge(m,f.nodeType?[f]:f);else if(pa.test(f)){g=g||l.appendChild(b.createElement("div")),h=(ka.exec(f)||["",""])[1].toLowerCase(),i=ma[h]||ma._default,g.innerHTML=i[1]+r.htmlPrefilter(f)+i[2],k=i[0];while(k--)g=g.lastChild;r.merge(m,g.childNodes),g=l.firstChild,g.textContent=""}else m.push(b.createTextNode(f));l.textContent="",n=0;while(f=m[n++])if(d&&r.inArray(f,d)>-1)e&&e.push(f);else if(j=r.contains(f.ownerDocument,f),g=na(l.appendChild(f),"script"),j&&oa(g),c){k=0;while(f=g[k++])la.test(f.type||"")&&c.push(f)}return l}!function(){var a=d.createDocumentFragment(),b=a.appendChild(d.createElement("div")),c=d.createElement("input");c.setAttribute("type","radio"),c.setAttribute("checked","checked"),c.setAttribute("name","t"),b.appendChild(c),o.checkClone=b.cloneNode(!0).cloneNode(!0).lastChild.checked,b.innerHTML="<textarea>x</textarea>",o.noCloneChecked=!!b.cloneNode(!0).lastChild.defaultValue}();var ra=d.documentElement,sa=/^key/,ta=/^(?:mouse|pointer|contextmenu|drag|drop)|click/,ua=/^([^.]*)(?:\.(.+)|)/;function va(){return!0}function wa(){return!1}function xa(){try{return d.activeElement}catch(a){}}function ya(a,b,c,d,e,f){var g,h;if("object"==typeof b){"string"!=typeof c&&(d=d||c,c=void 0);for(h in b)ya(a,h,c,d,b[h],f);return a}if(null==d&&null==e?(e=c,d=c=void 0):null==e&&("string"==typeof c?(e=d,d=void 0):(e=d,d=c,c=void 0)),e===!1)e=wa;else if(!e)return a;return 1===f&&(g=e,e=function(a){return r().off(a),g.apply(this,arguments)},e.guid=g.guid||(g.guid=r.guid++)),a.each(function(){r.event.add(this,b,e,d,c)})}r.event={global:{},add:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,n,o,p,q=W.get(a);if(q){c.handler&&(f=c,c=f.handler,e=f.selector),e&&r.find.matchesSelector(ra,e),c.guid||(c.guid=r.guid++),(i=q.events)||(i=q.events={}),(g=q.handle)||(g=q.handle=function(b){return"undefined"!=typeof r&&r.event.triggered!==b.type?r.event.dispatch.apply(a,arguments):void 0}),b=(b||"").match(L)||[""],j=b.length;while(j--)h=ua.exec(b[j])||[],n=p=h[1],o=(h[2]||"").split(".").sort(),n&&(l=r.event.special[n]||{},n=(e?l.delegateType:l.bindType)||n,l=r.event.special[n]||{},k=r.extend({type:n,origType:p,data:d,handler:c,guid:c.guid,selector:e,needsContext:e&&r.expr.match.needsContext.test(e),namespace:o.join(".")},f),(m=i[n])||(m=i[n]=[],m.delegateCount=0,l.setup&&l.setup.call(a,d,o,g)!==!1||a.addEventListener&&a.addEventListener(n,g)),l.add&&(l.add.call(a,k),k.handler.guid||(k.handler.guid=c.guid)),e?m.splice(m.delegateCount++,0,k):m.push(k),r.event.global[n]=!0)}},remove:function(a,b,c,d,e){var f,g,h,i,j,k,l,m,n,o,p,q=W.hasData(a)&&W.get(a);if(q&&(i=q.events)){b=(b||"").match(L)||[""],j=b.length;while(j--)if(h=ua.exec(b[j])||[],n=p=h[1],o=(h[2]||"").split(".").sort(),n){l=r.event.special[n]||{},n=(d?l.delegateType:l.bindType)||n,m=i[n]||[],h=h[2]&&new RegExp("(^|\\.)"+o.join("\\.(?:.*\\.|)")+"(\\.|$)"),g=f=m.length;while(f--)k=m[f],!e&&p!==k.origType||c&&c.guid!==k.guid||h&&!h.test(k.namespace)||d&&d!==k.selector&&("**"!==d||!k.selector)||(m.splice(f,1),k.selector&&m.delegateCount--,l.remove&&l.remove.call(a,k));g&&!m.length&&(l.teardown&&l.teardown.call(a,o,q.handle)!==!1||r.removeEvent(a,n,q.handle),delete i[n])}else for(n in i)r.event.remove(a,n+b[j],c,d,!0);r.isEmptyObject(i)&&W.remove(a,"handle events")}},dispatch:function(a){var b=r.event.fix(a),c,d,e,f,g,h,i=new Array(arguments.length),j=(W.get(this,"events")||{})[b.type]||[],k=r.event.special[b.type]||{};for(i[0]=b,c=1;c<arguments.length;c++)i[c]=arguments[c];if(b.delegateTarget=this,!k.preDispatch||k.preDispatch.call(this,b)!==!1){h=r.event.handlers.call(this,b,j),c=0;while((f=h[c++])&&!b.isPropagationStopped()){b.currentTarget=f.elem,d=0;while((g=f.handlers[d++])&&!b.isImmediatePropagationStopped())b.rnamespace&&!b.rnamespace.test(g.namespace)||(b.handleObj=g,b.data=g.data,e=((r.event.special[g.origType]||{}).handle||g.handler).apply(f.elem,i),void 0!==e&&(b.result=e)===!1&&(b.preventDefault(),b.stopPropagation()))}return k.postDispatch&&k.postDispatch.call(this,b),b.result}},handlers:function(a,b){var c,d,e,f,g,h=[],i=b.delegateCount,j=a.target;if(i&&j.nodeType&&!("click"===a.type&&a.button>=1))for(;j!==this;j=j.parentNode||this)if(1===j.nodeType&&("click"!==a.type||j.disabled!==!0)){for(f=[],g={},c=0;c<i;c++)d=b[c],e=d.selector+" ",void 0===g[e]&&(g[e]=d.needsContext?r(e,this).index(j)>-1:r.find(e,this,null,[j]).length),g[e]&&f.push(d);f.length&&h.push({elem:j,handlers:f})}return j=this,i<b.length&&h.push({elem:j,handlers:b.slice(i)}),h},addProp:function(a,b){Object.defineProperty(r.Event.prototype,a,{enumerable:!0,configurable:!0,get:r.isFunction(b)?function(){if(this.originalEvent)return b(this.originalEvent)}:function(){if(this.originalEvent)return this.originalEvent[a]},set:function(b){Object.defineProperty(this,a,{enumerable:!0,configurable:!0,writable:!0,value:b})}})},fix:function(a){return a[r.expando]?a:new r.Event(a)},special:{load:{noBubble:!0},focus:{trigger:function(){if(this!==xa()&&this.focus)return this.focus(),!1},delegateType:"focusin"},blur:{trigger:function(){if(this===xa()&&this.blur)return this.blur(),!1},delegateType:"focusout"},click:{trigger:function(){if("checkbox"===this.type&&this.click&&B(this,"input"))return this.click(),!1},_default:function(a){return B(a.target,"a")}},beforeunload:{postDispatch:function(a){void 0!==a.result&&a.originalEvent&&(a.originalEvent.returnValue=a.result)}}}},r.removeEvent=function(a,b,c){a.removeEventListener&&a.removeEventListener(b,c)},r.Event=function(a,b){return this instanceof r.Event?(a&&a.type?(this.originalEvent=a,this.type=a.type,this.isDefaultPrevented=a.defaultPrevented||void 0===a.defaultPrevented&&a.returnValue===!1?va:wa,this.target=a.target&&3===a.target.nodeType?a.target.parentNode:a.target,this.currentTarget=a.currentTarget,this.relatedTarget=a.relatedTarget):this.type=a,b&&r.extend(this,b),this.timeStamp=a&&a.timeStamp||r.now(),void(this[r.expando]=!0)):new r.Event(a,b)},r.Event.prototype={constructor:r.Event,isDefaultPrevented:wa,isPropagationStopped:wa,isImmediatePropagationStopped:wa,isSimulated:!1,preventDefault:function(){var a=this.originalEvent;this.isDefaultPrevented=va,a&&!this.isSimulated&&a.preventDefault()},stopPropagation:function(){var a=this.originalEvent;this.isPropagationStopped=va,a&&!this.isSimulated&&a.stopPropagation()},stopImmediatePropagation:function(){var a=this.originalEvent;this.isImmediatePropagationStopped=va,a&&!this.isSimulated&&a.stopImmediatePropagation(),this.stopPropagation()}},r.each({altKey:!0,bubbles:!0,cancelable:!0,changedTouches:!0,ctrlKey:!0,detail:!0,eventPhase:!0,metaKey:!0,pageX:!0,pageY:!0,shiftKey:!0,view:!0,"char":!0,charCode:!0,key:!0,keyCode:!0,button:!0,buttons:!0,clientX:!0,clientY:!0,offsetX:!0,offsetY:!0,pointerId:!0,pointerType:!0,screenX:!0,screenY:!0,targetTouches:!0,toElement:!0,touches:!0,which:function(a){var b=a.button;return null==a.which&&sa.test(a.type)?null!=a.charCode?a.charCode:a.keyCode:!a.which&&void 0!==b&&ta.test(a.type)?1&b?1:2&b?3:4&b?2:0:a.which}},r.event.addProp),r.each({mouseenter:"mouseover",mouseleave:"mouseout",pointerenter:"pointerover",pointerleave:"pointerout"},function(a,b){r.event.special[a]={delegateType:b,bindType:b,handle:function(a){var c,d=this,e=a.relatedTarget,f=a.handleObj;return e&&(e===d||r.contains(d,e))||(a.type=f.origType,c=f.handler.apply(this,arguments),a.type=b),c}}}),r.fn.extend({on:function(a,b,c,d){return ya(this,a,b,c,d)},one:function(a,b,c,d){return ya(this,a,b,c,d,1)},off:function(a,b,c){var d,e;if(a&&a.preventDefault&&a.handleObj)return d=a.handleObj,r(a.delegateTarget).off(d.namespace?d.origType+"."+d.namespace:d.origType,d.selector,d.handler),this;if("object"==typeof a){for(e in a)this.off(e,b,a[e]);return this}return b!==!1&&"function"!=typeof b||(c=b,b=void 0),c===!1&&(c=wa),this.each(function(){r.event.remove(this,a,c,b)})}});var za=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([a-z][^\/\0>\x20\t\r\n\f]*)[^>]*)\/>/gi,Aa=/<script|<style|<link/i,Ba=/checked\s*(?:[^=]|=\s*.checked.)/i,Ca=/^true\/(.*)/,Da=/^\s*<!(?:\[CDATA\[|--)|(?:\]\]|--)>\s*$/g;function Ea(a,b){return B(a,"table")&&B(11!==b.nodeType?b:b.firstChild,"tr")?r(">tbody",a)[0]||a:a}function Fa(a){return a.type=(null!==a.getAttribute("type"))+"/"+a.type,a}function Ga(a){var b=Ca.exec(a.type);return b?a.type=b[1]:a.removeAttribute("type"),a}function Ha(a,b){var c,d,e,f,g,h,i,j;if(1===b.nodeType){if(W.hasData(a)&&(f=W.access(a),g=W.set(b,f),j=f.events)){delete g.handle,g.events={};for(e in j)for(c=0,d=j[e].length;c<d;c++)r.event.add(b,e,j[e][c])}X.hasData(a)&&(h=X.access(a),i=r.extend({},h),X.set(b,i))}}function Ia(a,b){var c=b.nodeName.toLowerCase();"input"===c&&ja.test(a.type)?b.checked=a.checked:"input"!==c&&"textarea"!==c||(b.defaultValue=a.defaultValue)}function Ja(a,b,c,d){b=g.apply([],b);var e,f,h,i,j,k,l=0,m=a.length,n=m-1,q=b[0],s=r.isFunction(q);if(s||m>1&&"string"==typeof q&&!o.checkClone&&Ba.test(q))return a.each(function(e){var f=a.eq(e);s&&(b[0]=q.call(this,e,f.html())),Ja(f,b,c,d)});if(m&&(e=qa(b,a[0].ownerDocument,!1,a,d),f=e.firstChild,1===e.childNodes.length&&(e=f),f||d)){for(h=r.map(na(e,"script"),Fa),i=h.length;l<m;l++)j=e,l!==n&&(j=r.clone(j,!0,!0),i&&r.merge(h,na(j,"script"))),c.call(a[l],j,l);if(i)for(k=h[h.length-1].ownerDocument,r.map(h,Ga),l=0;l<i;l++)j=h[l],la.test(j.type||"")&&!W.access(j,"globalEval")&&r.contains(k,j)&&(j.src?r._evalUrl&&r._evalUrl(j.src):p(j.textContent.replace(Da,""),k))}return a}function Ka(a,b,c){for(var d,e=b?r.filter(b,a):a,f=0;null!=(d=e[f]);f++)c||1!==d.nodeType||r.cleanData(na(d)),d.parentNode&&(c&&r.contains(d.ownerDocument,d)&&oa(na(d,"script")),d.parentNode.removeChild(d));return a}r.extend({htmlPrefilter:function(a){return a.replace(za,"<$1></$2>")},clone:function(a,b,c){var d,e,f,g,h=a.cloneNode(!0),i=r.contains(a.ownerDocument,a);if(!(o.noCloneChecked||1!==a.nodeType&&11!==a.nodeType||r.isXMLDoc(a)))for(g=na(h),f=na(a),d=0,e=f.length;d<e;d++)Ia(f[d],g[d]);if(b)if(c)for(f=f||na(a),g=g||na(h),d=0,e=f.length;d<e;d++)Ha(f[d],g[d]);else Ha(a,h);return g=na(h,"script"),g.length>0&&oa(g,!i&&na(a,"script")),h},cleanData:function(a){for(var b,c,d,e=r.event.special,f=0;void 0!==(c=a[f]);f++)if(U(c)){if(b=c[W.expando]){if(b.events)for(d in b.events)e[d]?r.event.remove(c,d):r.removeEvent(c,d,b.handle);c[W.expando]=void 0}c[X.expando]&&(c[X.expando]=void 0)}}}),r.fn.extend({detach:function(a){return Ka(this,a,!0)},remove:function(a){return Ka(this,a)},text:function(a){return T(this,function(a){return void 0===a?r.text(this):this.empty().each(function(){1!==this.nodeType&&11!==this.nodeType&&9!==this.nodeType||(this.textContent=a)})},null,a,arguments.length)},append:function(){return Ja(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ea(this,a);b.appendChild(a)}})},prepend:function(){return Ja(this,arguments,function(a){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var b=Ea(this,a);b.insertBefore(a,b.firstChild)}})},before:function(){return Ja(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this)})},after:function(){return Ja(this,arguments,function(a){this.parentNode&&this.parentNode.insertBefore(a,this.nextSibling)})},empty:function(){for(var a,b=0;null!=(a=this[b]);b++)1===a.nodeType&&(r.cleanData(na(a,!1)),a.textContent="");return this},clone:function(a,b){return a=null!=a&&a,b=null==b?a:b,this.map(function(){return r.clone(this,a,b)})},html:function(a){return T(this,function(a){var b=this[0]||{},c=0,d=this.length;if(void 0===a&&1===b.nodeType)return b.innerHTML;if("string"==typeof a&&!Aa.test(a)&&!ma[(ka.exec(a)||["",""])[1].toLowerCase()]){a=r.htmlPrefilter(a);try{for(;c<d;c++)b=this[c]||{},1===b.nodeType&&(r.cleanData(na(b,!1)),b.innerHTML=a);b=0}catch(e){}}b&&this.empty().append(a)},null,a,arguments.length)},replaceWith:function(){var a=[];return Ja(this,arguments,function(b){var c=this.parentNode;r.inArray(this,a)<0&&(r.cleanData(na(this)),c&&c.replaceChild(b,this))},a)}}),r.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){r.fn[a]=function(a){for(var c,d=[],e=r(a),f=e.length-1,g=0;g<=f;g++)c=g===f?this:this.clone(!0),r(e[g])[b](c),h.apply(d,c.get());return this.pushStack(d)}});var La=/^margin/,Ma=new RegExp("^("+aa+")(?!px)[a-z%]+$","i"),Na=function(b){var c=b.ownerDocument.defaultView;return c&&c.opener||(c=a),c.getComputedStyle(b)};!function(){function b(){if(i){i.style.cssText="box-sizing:border-box;position:relative;display:block;margin:auto;border:1px;padding:1px;top:1%;width:50%",i.innerHTML="",ra.appendChild(h);var b=a.getComputedStyle(i);c="1%"!==b.top,g="2px"===b.marginLeft,e="4px"===b.width,i.style.marginRight="50%",f="4px"===b.marginRight,ra.removeChild(h),i=null}}var c,e,f,g,h=d.createElement("div"),i=d.createElement("div");i.style&&(i.style.backgroundClip="content-box",i.cloneNode(!0).style.backgroundClip="",o.clearCloneStyle="content-box"===i.style.backgroundClip,h.style.cssText="border:0;width:8px;height:0;top:0;left:-9999px;padding:0;margin-top:1px;position:absolute",h.appendChild(i),r.extend(o,{pixelPosition:function(){return b(),c},boxSizingReliable:function(){return b(),e},pixelMarginRight:function(){return b(),f},reliableMarginLeft:function(){return b(),g}}))}();function Oa(a,b,c){var d,e,f,g,h=a.style;return c=c||Na(a),c&&(g=c.getPropertyValue(b)||c[b],""!==g||r.contains(a.ownerDocument,a)||(g=r.style(a,b)),!o.pixelMarginRight()&&Ma.test(g)&&La.test(b)&&(d=h.width,e=h.minWidth,f=h.maxWidth,h.minWidth=h.maxWidth=h.width=g,g=c.width,h.width=d,h.minWidth=e,h.maxWidth=f)),void 0!==g?g+"":g}function Pa(a,b){return{get:function(){return a()?void delete this.get:(this.get=b).apply(this,arguments)}}}var Qa=/^(none|table(?!-c[ea]).+)/,Ra=/^--/,Sa={position:"absolute",visibility:"hidden",display:"block"},Ta={letterSpacing:"0",fontWeight:"400"},Ua=["Webkit","Moz","ms"],Va=d.createElement("div").style;function Wa(a){if(a in Va)return a;var b=a[0].toUpperCase()+a.slice(1),c=Ua.length;while(c--)if(a=Ua[c]+b,a in Va)return a}function Xa(a){var b=r.cssProps[a];return b||(b=r.cssProps[a]=Wa(a)||a),b}function Ya(a,b,c){var d=ba.exec(b);return d?Math.max(0,d[2]-(c||0))+(d[3]||"px"):b}function Za(a,b,c,d,e){var f,g=0;for(f=c===(d?"border":"content")?4:"width"===b?1:0;f<4;f+=2)"margin"===c&&(g+=r.css(a,c+ca[f],!0,e)),d?("content"===c&&(g-=r.css(a,"padding"+ca[f],!0,e)),"margin"!==c&&(g-=r.css(a,"border"+ca[f]+"Width",!0,e))):(g+=r.css(a,"padding"+ca[f],!0,e),"padding"!==c&&(g+=r.css(a,"border"+ca[f]+"Width",!0,e)));return g}function $a(a,b,c){var d,e=Na(a),f=Oa(a,b,e),g="border-box"===r.css(a,"boxSizing",!1,e);return Ma.test(f)?f:(d=g&&(o.boxSizingReliable()||f===a.style[b]),"auto"===f&&(f=a["offset"+b[0].toUpperCase()+b.slice(1)]),f=parseFloat(f)||0,f+Za(a,b,c||(g?"border":"content"),d,e)+"px")}r.extend({cssHooks:{opacity:{get:function(a,b){if(b){var c=Oa(a,"opacity");return""===c?"1":c}}}},cssNumber:{animationIterationCount:!0,columnCount:!0,fillOpacity:!0,flexGrow:!0,flexShrink:!0,fontWeight:!0,lineHeight:!0,opacity:!0,order:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{"float":"cssFloat"},style:function(a,b,c,d){if(a&&3!==a.nodeType&&8!==a.nodeType&&a.style){var e,f,g,h=r.camelCase(b),i=Ra.test(b),j=a.style;return i||(b=Xa(h)),g=r.cssHooks[b]||r.cssHooks[h],void 0===c?g&&"get"in g&&void 0!==(e=g.get(a,!1,d))?e:j[b]:(f=typeof c,"string"===f&&(e=ba.exec(c))&&e[1]&&(c=fa(a,b,e),f="number"),null!=c&&c===c&&("number"===f&&(c+=e&&e[3]||(r.cssNumber[h]?"":"px")),o.clearCloneStyle||""!==c||0!==b.indexOf("background")||(j[b]="inherit"),g&&"set"in g&&void 0===(c=g.set(a,c,d))||(i?j.setProperty(b,c):j[b]=c)),void 0)}},css:function(a,b,c,d){var e,f,g,h=r.camelCase(b),i=Ra.test(b);return i||(b=Xa(h)),g=r.cssHooks[b]||r.cssHooks[h],g&&"get"in g&&(e=g.get(a,!0,c)),void 0===e&&(e=Oa(a,b,d)),"normal"===e&&b in Ta&&(e=Ta[b]),""===c||c?(f=parseFloat(e),c===!0||isFinite(f)?f||0:e):e}}),r.each(["height","width"],function(a,b){r.cssHooks[b]={get:function(a,c,d){if(c)return!Qa.test(r.css(a,"display"))||a.getClientRects().length&&a.getBoundingClientRect().width?$a(a,b,d):ea(a,Sa,function(){return $a(a,b,d)})},set:function(a,c,d){var e,f=d&&Na(a),g=d&&Za(a,b,d,"border-box"===r.css(a,"boxSizing",!1,f),f);return g&&(e=ba.exec(c))&&"px"!==(e[3]||"px")&&(a.style[b]=c,c=r.css(a,b)),Ya(a,c,g)}}}),r.cssHooks.marginLeft=Pa(o.reliableMarginLeft,function(a,b){if(b)return(parseFloat(Oa(a,"marginLeft"))||a.getBoundingClientRect().left-ea(a,{marginLeft:0},function(){return a.getBoundingClientRect().left}))+"px"}),r.each({margin:"",padding:"",border:"Width"},function(a,b){r.cssHooks[a+b]={expand:function(c){for(var d=0,e={},f="string"==typeof c?c.split(" "):[c];d<4;d++)e[a+ca[d]+b]=f[d]||f[d-2]||f[0];return e}},La.test(a)||(r.cssHooks[a+b].set=Ya)}),r.fn.extend({css:function(a,b){return T(this,function(a,b,c){var d,e,f={},g=0;if(Array.isArray(b)){for(d=Na(a),e=b.length;g<e;g++)f[b[g]]=r.css(a,b[g],!1,d);return f}return void 0!==c?r.style(a,b,c):r.css(a,b)},a,b,arguments.length>1)}});function _a(a,b,c,d,e){return new _a.prototype.init(a,b,c,d,e)}r.Tween=_a,_a.prototype={constructor:_a,init:function(a,b,c,d,e,f){this.elem=a,this.prop=c,this.easing=e||r.easing._default,this.options=b,this.start=this.now=this.cur(),this.end=d,this.unit=f||(r.cssNumber[c]?"":"px")},cur:function(){var a=_a.propHooks[this.prop];return a&&a.get?a.get(this):_a.propHooks._default.get(this)},run:function(a){var b,c=_a.propHooks[this.prop];return this.options.duration?this.pos=b=r.easing[this.easing](a,this.options.duration*a,0,1,this.options.duration):this.pos=b=a,this.now=(this.end-this.start)*b+this.start,this.options.step&&this.options.step.call(this.elem,this.now,this),c&&c.set?c.set(this):_a.propHooks._default.set(this),this}},_a.prototype.init.prototype=_a.prototype,_a.propHooks={_default:{get:function(a){var b;return 1!==a.elem.nodeType||null!=a.elem[a.prop]&&null==a.elem.style[a.prop]?a.elem[a.prop]:(b=r.css(a.elem,a.prop,""),b&&"auto"!==b?b:0)},set:function(a){r.fx.step[a.prop]?r.fx.step[a.prop](a):1!==a.elem.nodeType||null==a.elem.style[r.cssProps[a.prop]]&&!r.cssHooks[a.prop]?a.elem[a.prop]=a.now:r.style(a.elem,a.prop,a.now+a.unit)}}},_a.propHooks.scrollTop=_a.propHooks.scrollLeft={set:function(a){a.elem.nodeType&&a.elem.parentNode&&(a.elem[a.prop]=a.now)}},r.easing={linear:function(a){return a},swing:function(a){return.5-Math.cos(a*Math.PI)/2},_default:"swing"},r.fx=_a.prototype.init,r.fx.step={};var ab,bb,cb=/^(?:toggle|show|hide)$/,db=/queueHooks$/;function eb(){bb&&(d.hidden===!1&&a.requestAnimationFrame?a.requestAnimationFrame(eb):a.setTimeout(eb,r.fx.interval),r.fx.tick())}function fb(){return a.setTimeout(function(){ab=void 0}),ab=r.now()}function gb(a,b){var c,d=0,e={height:a};for(b=b?1:0;d<4;d+=2-b)c=ca[d],e["margin"+c]=e["padding"+c]=a;return b&&(e.opacity=e.width=a),e}function hb(a,b,c){for(var d,e=(kb.tweeners[b]||[]).concat(kb.tweeners["*"]),f=0,g=e.length;f<g;f++)if(d=e[f].call(c,b,a))return d}function ib(a,b,c){var d,e,f,g,h,i,j,k,l="width"in b||"height"in b,m=this,n={},o=a.style,p=a.nodeType&&da(a),q=W.get(a,"fxshow");c.queue||(g=r._queueHooks(a,"fx"),null==g.unqueued&&(g.unqueued=0,h=g.empty.fire,g.empty.fire=function(){g.unqueued||h()}),g.unqueued++,m.always(function(){m.always(function(){g.unqueued--,r.queue(a,"fx").length||g.empty.fire()})}));for(d in b)if(e=b[d],cb.test(e)){if(delete b[d],f=f||"toggle"===e,e===(p?"hide":"show")){if("show"!==e||!q||void 0===q[d])continue;p=!0}n[d]=q&&q[d]||r.style(a,d)}if(i=!r.isEmptyObject(b),i||!r.isEmptyObject(n)){l&&1===a.nodeType&&(c.overflow=[o.overflow,o.overflowX,o.overflowY],j=q&&q.display,null==j&&(j=W.get(a,"display")),k=r.css(a,"display"),"none"===k&&(j?k=j:(ia([a],!0),j=a.style.display||j,k=r.css(a,"display"),ia([a]))),("inline"===k||"inline-block"===k&&null!=j)&&"none"===r.css(a,"float")&&(i||(m.done(function(){o.display=j}),null==j&&(k=o.display,j="none"===k?"":k)),o.display="inline-block")),c.overflow&&(o.overflow="hidden",m.always(function(){o.overflow=c.overflow[0],o.overflowX=c.overflow[1],o.overflowY=c.overflow[2]})),i=!1;for(d in n)i||(q?"hidden"in q&&(p=q.hidden):q=W.access(a,"fxshow",{display:j}),f&&(q.hidden=!p),p&&ia([a],!0),m.done(function(){p||ia([a]),W.remove(a,"fxshow");for(d in n)r.style(a,d,n[d])})),i=hb(p?q[d]:0,d,m),d in q||(q[d]=i.start,p&&(i.end=i.start,i.start=0))}}function jb(a,b){var c,d,e,f,g;for(c in a)if(d=r.camelCase(c),e=b[d],f=a[c],Array.isArray(f)&&(e=f[1],f=a[c]=f[0]),c!==d&&(a[d]=f,delete a[c]),g=r.cssHooks[d],g&&"expand"in g){f=g.expand(f),delete a[d];for(c in f)c in a||(a[c]=f[c],b[c]=e)}else b[d]=e}function kb(a,b,c){var d,e,f=0,g=kb.prefilters.length,h=r.Deferred().always(function(){delete i.elem}),i=function(){if(e)return!1;for(var b=ab||fb(),c=Math.max(0,j.startTime+j.duration-b),d=c/j.duration||0,f=1-d,g=0,i=j.tweens.length;g<i;g++)j.tweens[g].run(f);return h.notifyWith(a,[j,f,c]),f<1&&i?c:(i||h.notifyWith(a,[j,1,0]),h.resolveWith(a,[j]),!1)},j=h.promise({elem:a,props:r.extend({},b),opts:r.extend(!0,{specialEasing:{},easing:r.easing._default},c),originalProperties:b,originalOptions:c,startTime:ab||fb(),duration:c.duration,tweens:[],createTween:function(b,c){var d=r.Tween(a,j.opts,b,c,j.opts.specialEasing[b]||j.opts.easing);return j.tweens.push(d),d},stop:function(b){var c=0,d=b?j.tweens.length:0;if(e)return this;for(e=!0;c<d;c++)j.tweens[c].run(1);return b?(h.notifyWith(a,[j,1,0]),h.resolveWith(a,[j,b])):h.rejectWith(a,[j,b]),this}}),k=j.props;for(jb(k,j.opts.specialEasing);f<g;f++)if(d=kb.prefilters[f].call(j,a,k,j.opts))return r.isFunction(d.stop)&&(r._queueHooks(j.elem,j.opts.queue).stop=r.proxy(d.stop,d)),d;return r.map(k,hb,j),r.isFunction(j.opts.start)&&j.opts.start.call(a,j),j.progress(j.opts.progress).done(j.opts.done,j.opts.complete).fail(j.opts.fail).always(j.opts.always),r.fx.timer(r.extend(i,{elem:a,anim:j,queue:j.opts.queue})),j}r.Animation=r.extend(kb,{tweeners:{"*":[function(a,b){var c=this.createTween(a,b);return fa(c.elem,a,ba.exec(b),c),c}]},tweener:function(a,b){r.isFunction(a)?(b=a,a=["*"]):a=a.match(L);for(var c,d=0,e=a.length;d<e;d++)c=a[d],kb.tweeners[c]=kb.tweeners[c]||[],kb.tweeners[c].unshift(b)},prefilters:[ib],prefilter:function(a,b){b?kb.prefilters.unshift(a):kb.prefilters.push(a)}}),r.speed=function(a,b,c){var d=a&&"object"==typeof a?r.extend({},a):{complete:c||!c&&b||r.isFunction(a)&&a,duration:a,easing:c&&b||b&&!r.isFunction(b)&&b};return r.fx.off?d.duration=0:"number"!=typeof d.duration&&(d.duration in r.fx.speeds?d.duration=r.fx.speeds[d.duration]:d.duration=r.fx.speeds._default),null!=d.queue&&d.queue!==!0||(d.queue="fx"),d.old=d.complete,d.complete=function(){r.isFunction(d.old)&&d.old.call(this),d.queue&&r.dequeue(this,d.queue)},d},r.fn.extend({fadeTo:function(a,b,c,d){return this.filter(da).css("opacity",0).show().end().animate({opacity:b},a,c,d)},animate:function(a,b,c,d){var e=r.isEmptyObject(a),f=r.speed(b,c,d),g=function(){var b=kb(this,r.extend({},a),f);(e||W.get(this,"finish"))&&b.stop(!0)};return g.finish=g,e||f.queue===!1?this.each(g):this.queue(f.queue,g)},stop:function(a,b,c){var d=function(a){var b=a.stop;delete a.stop,b(c)};return"string"!=typeof a&&(c=b,b=a,a=void 0),b&&a!==!1&&this.queue(a||"fx",[]),this.each(function(){var b=!0,e=null!=a&&a+"queueHooks",f=r.timers,g=W.get(this);if(e)g[e]&&g[e].stop&&d(g[e]);else for(e in g)g[e]&&g[e].stop&&db.test(e)&&d(g[e]);for(e=f.length;e--;)f[e].elem!==this||null!=a&&f[e].queue!==a||(f[e].anim.stop(c),b=!1,f.splice(e,1));!b&&c||r.dequeue(this,a)})},finish:function(a){return a!==!1&&(a=a||"fx"),this.each(function(){var b,c=W.get(this),d=c[a+"queue"],e=c[a+"queueHooks"],f=r.timers,g=d?d.length:0;for(c.finish=!0,r.queue(this,a,[]),e&&e.stop&&e.stop.call(this,!0),b=f.length;b--;)f[b].elem===this&&f[b].queue===a&&(f[b].anim.stop(!0),f.splice(b,1));for(b=0;b<g;b++)d[b]&&d[b].finish&&d[b].finish.call(this);delete c.finish})}}),r.each(["toggle","show","hide"],function(a,b){var c=r.fn[b];r.fn[b]=function(a,d,e){return null==a||"boolean"==typeof a?c.apply(this,arguments):this.animate(gb(b,!0),a,d,e)}}),r.each({slideDown:gb("show"),slideUp:gb("hide"),slideToggle:gb("toggle"),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"},fadeToggle:{opacity:"toggle"}},function(a,b){r.fn[a]=function(a,c,d){return this.animate(b,a,c,d)}}),r.timers=[],r.fx.tick=function(){var a,b=0,c=r.timers;for(ab=r.now();b<c.length;b++)a=c[b],a()||c[b]!==a||c.splice(b--,1);c.length||r.fx.stop(),ab=void 0},r.fx.timer=function(a){r.timers.push(a),r.fx.start()},r.fx.interval=13,r.fx.start=function(){bb||(bb=!0,eb())},r.fx.stop=function(){bb=null},r.fx.speeds={slow:600,fast:200,_default:400},r.fn.delay=function(b,c){return b=r.fx?r.fx.speeds[b]||b:b,c=c||"fx",this.queue(c,function(c,d){var e=a.setTimeout(c,b);d.stop=function(){a.clearTimeout(e)}})},function(){var a=d.createElement("input"),b=d.createElement("select"),c=b.appendChild(d.createElement("option"));a.type="checkbox",o.checkOn=""!==a.value,o.optSelected=c.selected,a=d.createElement("input"),a.value="t",a.type="radio",o.radioValue="t"===a.value}();var lb,mb=r.expr.attrHandle;r.fn.extend({attr:function(a,b){return T(this,r.attr,a,b,arguments.length>1)},removeAttr:function(a){return this.each(function(){r.removeAttr(this,a)})}}),r.extend({attr:function(a,b,c){var d,e,f=a.nodeType;if(3!==f&&8!==f&&2!==f)return"undefined"==typeof a.getAttribute?r.prop(a,b,c):(1===f&&r.isXMLDoc(a)||(e=r.attrHooks[b.toLowerCase()]||(r.expr.match.bool.test(b)?lb:void 0)),void 0!==c?null===c?void r.removeAttr(a,b):e&&"set"in e&&void 0!==(d=e.set(a,c,b))?d:(a.setAttribute(b,c+""),c):e&&"get"in e&&null!==(d=e.get(a,b))?d:(d=r.find.attr(a,b),

10+null==d?void 0:d))},attrHooks:{type:{set:function(a,b){if(!o.radioValue&&"radio"===b&&B(a,"input")){var c=a.value;return a.setAttribute("type",b),c&&(a.value=c),b}}}},removeAttr:function(a,b){var c,d=0,e=b&&b.match(L);if(e&&1===a.nodeType)while(c=e[d++])a.removeAttribute(c)}}),lb={set:function(a,b,c){return b===!1?r.removeAttr(a,c):a.setAttribute(c,c),c}},r.each(r.expr.match.bool.source.match(/\w+/g),function(a,b){var c=mb[b]||r.find.attr;mb[b]=function(a,b,d){var e,f,g=b.toLowerCase();return d||(f=mb[g],mb[g]=e,e=null!=c(a,b,d)?g:null,mb[g]=f),e}});var nb=/^(?:input|select|textarea|button)$/i,ob=/^(?:a|area)$/i;r.fn.extend({prop:function(a,b){return T(this,r.prop,a,b,arguments.length>1)},removeProp:function(a){return this.each(function(){delete this[r.propFix[a]||a]})}}),r.extend({prop:function(a,b,c){var d,e,f=a.nodeType;if(3!==f&&8!==f&&2!==f)return 1===f&&r.isXMLDoc(a)||(b=r.propFix[b]||b,e=r.propHooks[b]),void 0!==c?e&&"set"in e&&void 0!==(d=e.set(a,c,b))?d:a[b]=c:e&&"get"in e&&null!==(d=e.get(a,b))?d:a[b]},propHooks:{tabIndex:{get:function(a){var b=r.find.attr(a,"tabindex");return b?parseInt(b,10):nb.test(a.nodeName)||ob.test(a.nodeName)&&a.href?0:-1}}},propFix:{"for":"htmlFor","class":"className"}}),o.optSelected||(r.propHooks.selected={get:function(a){var b=a.parentNode;return b&&b.parentNode&&b.parentNode.selectedIndex,null},set:function(a){var b=a.parentNode;b&&(b.selectedIndex,b.parentNode&&b.parentNode.selectedIndex)}}),r.each(["tabIndex","readOnly","maxLength","cellSpacing","cellPadding","rowSpan","colSpan","useMap","frameBorder","contentEditable"],function(){r.propFix[this.toLowerCase()]=this});function pb(a){var b=a.match(L)||[];return b.join(" ")}function qb(a){return a.getAttribute&&a.getAttribute("class")||""}r.fn.extend({addClass:function(a){var b,c,d,e,f,g,h,i=0;if(r.isFunction(a))return this.each(function(b){r(this).addClass(a.call(this,b,qb(this)))});if("string"==typeof a&&a){b=a.match(L)||[];while(c=this[i++])if(e=qb(c),d=1===c.nodeType&&" "+pb(e)+" "){g=0;while(f=b[g++])d.indexOf(" "+f+" ")<0&&(d+=f+" ");h=pb(d),e!==h&&c.setAttribute("class",h)}}return this},removeClass:function(a){var b,c,d,e,f,g,h,i=0;if(r.isFunction(a))return this.each(function(b){r(this).removeClass(a.call(this,b,qb(this)))});if(!arguments.length)return this.attr("class","");if("string"==typeof a&&a){b=a.match(L)||[];while(c=this[i++])if(e=qb(c),d=1===c.nodeType&&" "+pb(e)+" "){g=0;while(f=b[g++])while(d.indexOf(" "+f+" ")>-1)d=d.replace(" "+f+" "," ");h=pb(d),e!==h&&c.setAttribute("class",h)}}return this},toggleClass:function(a,b){var c=typeof a;return"boolean"==typeof b&&"string"===c?b?this.addClass(a):this.removeClass(a):r.isFunction(a)?this.each(function(c){r(this).toggleClass(a.call(this,c,qb(this),b),b)}):this.each(function(){var b,d,e,f;if("string"===c){d=0,e=r(this),f=a.match(L)||[];while(b=f[d++])e.hasClass(b)?e.removeClass(b):e.addClass(b)}else void 0!==a&&"boolean"!==c||(b=qb(this),b&&W.set(this,"__className__",b),this.setAttribute&&this.setAttribute("class",b||a===!1?"":W.get(this,"__className__")||""))})},hasClass:function(a){var b,c,d=0;b=" "+a+" ";while(c=this[d++])if(1===c.nodeType&&(" "+pb(qb(c))+" ").indexOf(b)>-1)return!0;return!1}});var rb=/\r/g;r.fn.extend({val:function(a){var b,c,d,e=this[0];{if(arguments.length)return d=r.isFunction(a),this.each(function(c){var e;1===this.nodeType&&(e=d?a.call(this,c,r(this).val()):a,null==e?e="":"number"==typeof e?e+="":Array.isArray(e)&&(e=r.map(e,function(a){return null==a?"":a+""})),b=r.valHooks[this.type]||r.valHooks[this.nodeName.toLowerCase()],b&&"set"in b&&void 0!==b.set(this,e,"value")||(this.value=e))});if(e)return b=r.valHooks[e.type]||r.valHooks[e.nodeName.toLowerCase()],b&&"get"in b&&void 0!==(c=b.get(e,"value"))?c:(c=e.value,"string"==typeof c?c.replace(rb,""):null==c?"":c)}}}),r.extend({valHooks:{option:{get:function(a){var b=r.find.attr(a,"value");return null!=b?b:pb(r.text(a))}},select:{get:function(a){var b,c,d,e=a.options,f=a.selectedIndex,g="select-one"===a.type,h=g?null:[],i=g?f+1:e.length;for(d=f<0?i:g?f:0;d<i;d++)if(c=e[d],(c.selected||d===f)&&!c.disabled&&(!c.parentNode.disabled||!B(c.parentNode,"optgroup"))){if(b=r(c).val(),g)return b;h.push(b)}return h},set:function(a,b){var c,d,e=a.options,f=r.makeArray(b),g=e.length;while(g--)d=e[g],(d.selected=r.inArray(r.valHooks.option.get(d),f)>-1)&&(c=!0);return c||(a.selectedIndex=-1),f}}}}),r.each(["radio","checkbox"],function(){r.valHooks[this]={set:function(a,b){if(Array.isArray(b))return a.checked=r.inArray(r(a).val(),b)>-1}},o.checkOn||(r.valHooks[this].get=function(a){return null===a.getAttribute("value")?"on":a.value})});var sb=/^(?:focusinfocus|focusoutblur)$/;r.extend(r.event,{trigger:function(b,c,e,f){var g,h,i,j,k,m,n,o=[e||d],p=l.call(b,"type")?b.type:b,q=l.call(b,"namespace")?b.namespace.split("."):[];if(h=i=e=e||d,3!==e.nodeType&&8!==e.nodeType&&!sb.test(p+r.event.triggered)&&(p.indexOf(".")>-1&&(q=p.split("."),p=q.shift(),q.sort()),k=p.indexOf(":")<0&&"on"+p,b=b[r.expando]?b:new r.Event(p,"object"==typeof b&&b),b.isTrigger=f?2:3,b.namespace=q.join("."),b.rnamespace=b.namespace?new RegExp("(^|\\.)"+q.join("\\.(?:.*\\.|)")+"(\\.|$)"):null,b.result=void 0,b.target||(b.target=e),c=null==c?[b]:r.makeArray(c,[b]),n=r.event.special[p]||{},f||!n.trigger||n.trigger.apply(e,c)!==!1)){if(!f&&!n.noBubble&&!r.isWindow(e)){for(j=n.delegateType||p,sb.test(j+p)||(h=h.parentNode);h;h=h.parentNode)o.push(h),i=h;i===(e.ownerDocument||d)&&o.push(i.defaultView||i.parentWindow||a)}g=0;while((h=o[g++])&&!b.isPropagationStopped())b.type=g>1?j:n.bindType||p,m=(W.get(h,"events")||{})[b.type]&&W.get(h,"handle"),m&&m.apply(h,c),m=k&&h[k],m&&m.apply&&U(h)&&(b.result=m.apply(h,c),b.result===!1&&b.preventDefault());return b.type=p,f||b.isDefaultPrevented()||n._default&&n._default.apply(o.pop(),c)!==!1||!U(e)||k&&r.isFunction(e[p])&&!r.isWindow(e)&&(i=e[k],i&&(e[k]=null),r.event.triggered=p,e[p](),r.event.triggered=void 0,i&&(e[k]=i)),b.result}},simulate:function(a,b,c){var d=r.extend(new r.Event,c,{type:a,isSimulated:!0});r.event.trigger(d,null,b)}}),r.fn.extend({trigger:function(a,b){return this.each(function(){r.event.trigger(a,b,this)})},triggerHandler:function(a,b){var c=this[0];if(c)return r.event.trigger(a,b,c,!0)}}),r.each("blur focus focusin focusout resize scroll click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup contextmenu".split(" "),function(a,b){r.fn[b]=function(a,c){return arguments.length>0?this.on(b,null,a,c):this.trigger(b)}}),r.fn.extend({hover:function(a,b){return this.mouseenter(a).mouseleave(b||a)}}),o.focusin="onfocusin"in a,o.focusin||r.each({focus:"focusin",blur:"focusout"},function(a,b){var c=function(a){r.event.simulate(b,a.target,r.event.fix(a))};r.event.special[b]={setup:function(){var d=this.ownerDocument||this,e=W.access(d,b);e||d.addEventListener(a,c,!0),W.access(d,b,(e||0)+1)},teardown:function(){var d=this.ownerDocument||this,e=W.access(d,b)-1;e?W.access(d,b,e):(d.removeEventListener(a,c,!0),W.remove(d,b))}}});var tb=a.location,ub=r.now(),vb=/\?/;r.parseXML=function(b){var c;if(!b||"string"!=typeof b)return null;try{c=(new a.DOMParser).parseFromString(b,"text/xml")}catch(d){c=void 0}return c&&!c.getElementsByTagName("parsererror").length||r.error("Invalid XML: "+b),c};var wb=/\[\]$/,xb=/\r?\n/g,yb=/^(?:submit|button|image|reset|file)$/i,zb=/^(?:input|select|textarea|keygen)/i;function Ab(a,b,c,d){var e;if(Array.isArray(b))r.each(b,function(b,e){c||wb.test(a)?d(a,e):Ab(a+"["+("object"==typeof e&&null!=e?b:"")+"]",e,c,d)});else if(c||"object"!==r.type(b))d(a,b);else for(e in b)Ab(a+"["+e+"]",b[e],c,d)}r.param=function(a,b){var c,d=[],e=function(a,b){var c=r.isFunction(b)?b():b;d[d.length]=encodeURIComponent(a)+"="+encodeURIComponent(null==c?"":c)};if(Array.isArray(a)||a.jquery&&!r.isPlainObject(a))r.each(a,function(){e(this.name,this.value)});else for(c in a)Ab(c,a[c],b,e);return d.join("&")},r.fn.extend({serialize:function(){return r.param(this.serializeArray())},serializeArray:function(){return this.map(function(){var a=r.prop(this,"elements");return a?r.makeArray(a):this}).filter(function(){var a=this.type;return this.name&&!r(this).is(":disabled")&&zb.test(this.nodeName)&&!yb.test(a)&&(this.checked||!ja.test(a))}).map(function(a,b){var c=r(this).val();return null==c?null:Array.isArray(c)?r.map(c,function(a){return{name:b.name,value:a.replace(xb,"\r\n")}}):{name:b.name,value:c.replace(xb,"\r\n")}}).get()}});var Bb=/%20/g,Cb=/#.*$/,Db=/([?&])_=[^&]*/,Eb=/^(.*?):[ \t]*([^\r\n]*)$/gm,Fb=/^(?:about|app|app-storage|.+-extension|file|res|widget):$/,Gb=/^(?:GET|HEAD)$/,Hb=/^\/\//,Ib={},Jb={},Kb="*/".concat("*"),Lb=d.createElement("a");Lb.href=tb.href;function Mb(a){return function(b,c){"string"!=typeof b&&(c=b,b="*");var d,e=0,f=b.toLowerCase().match(L)||[];if(r.isFunction(c))while(d=f[e++])"+"===d[0]?(d=d.slice(1)||"*",(a[d]=a[d]||[]).unshift(c)):(a[d]=a[d]||[]).push(c)}}function Nb(a,b,c,d){var e={},f=a===Jb;function g(h){var i;return e[h]=!0,r.each(a[h]||[],function(a,h){var j=h(b,c,d);return"string"!=typeof j||f||e[j]?f?!(i=j):void 0:(b.dataTypes.unshift(j),g(j),!1)}),i}return g(b.dataTypes[0])||!e["*"]&&g("*")}function Ob(a,b){var c,d,e=r.ajaxSettings.flatOptions||{};for(c in b)void 0!==b[c]&&((e[c]?a:d||(d={}))[c]=b[c]);return d&&r.extend(!0,a,d),a}function Pb(a,b,c){var d,e,f,g,h=a.contents,i=a.dataTypes;while("*"===i[0])i.shift(),void 0===d&&(d=a.mimeType||b.getResponseHeader("Content-Type"));if(d)for(e in h)if(h[e]&&h[e].test(d)){i.unshift(e);break}if(i[0]in c)f=i[0];else{for(e in c){if(!i[0]||a.converters[e+" "+i[0]]){f=e;break}g||(g=e)}f=f||g}if(f)return f!==i[0]&&i.unshift(f),c[f]}function Qb(a,b,c,d){var e,f,g,h,i,j={},k=a.dataTypes.slice();if(k[1])for(g in a.converters)j[g.toLowerCase()]=a.converters[g];f=k.shift();while(f)if(a.responseFields[f]&&(c[a.responseFields[f]]=b),!i&&d&&a.dataFilter&&(b=a.dataFilter(b,a.dataType)),i=f,f=k.shift())if("*"===f)f=i;else if("*"!==i&&i!==f){if(g=j[i+" "+f]||j["* "+f],!g)for(e in j)if(h=e.split(" "),h[1]===f&&(g=j[i+" "+h[0]]||j["* "+h[0]])){g===!0?g=j[e]:j[e]!==!0&&(f=h[0],k.unshift(h[1]));break}if(g!==!0)if(g&&a["throws"])b=g(b);else try{b=g(b)}catch(l){return{state:"parsererror",error:g?l:"No conversion from "+i+" to "+f}}}return{state:"success",data:b}}r.extend({active:0,lastModified:{},etag:{},ajaxSettings:{url:tb.href,type:"GET",isLocal:Fb.test(tb.protocol),global:!0,processData:!0,async:!0,contentType:"application/x-www-form-urlencoded; charset=UTF-8",accepts:{"*":Kb,text:"text/plain",html:"text/html",xml:"application/xml, text/xml",json:"application/json, text/javascript"},contents:{xml:/\bxml\b/,html:/\bhtml/,json:/\bjson\b/},responseFields:{xml:"responseXML",text:"responseText",json:"responseJSON"},converters:{"* text":String,"text html":!0,"text json":JSON.parse,"text xml":r.parseXML},flatOptions:{url:!0,context:!0}},ajaxSetup:function(a,b){return b?Ob(Ob(a,r.ajaxSettings),b):Ob(r.ajaxSettings,a)},ajaxPrefilter:Mb(Ib),ajaxTransport:Mb(Jb),ajax:function(b,c){"object"==typeof b&&(c=b,b=void 0),c=c||{};var e,f,g,h,i,j,k,l,m,n,o=r.ajaxSetup({},c),p=o.context||o,q=o.context&&(p.nodeType||p.jquery)?r(p):r.event,s=r.Deferred(),t=r.Callbacks("once memory"),u=o.statusCode||{},v={},w={},x="canceled",y={readyState:0,getResponseHeader:function(a){var b;if(k){if(!h){h={};while(b=Eb.exec(g))h[b[1].toLowerCase()]=b[2]}b=h[a.toLowerCase()]}return null==b?null:b},getAllResponseHeaders:function(){return k?g:null},setRequestHeader:function(a,b){return null==k&&(a=w[a.toLowerCase()]=w[a.toLowerCase()]||a,v[a]=b),this},overrideMimeType:function(a){return null==k&&(o.mimeType=a),this},statusCode:function(a){var b;if(a)if(k)y.always(a[y.status]);else for(b in a)u[b]=[u[b],a[b]];return this},abort:function(a){var b=a||x;return e&&e.abort(b),A(0,b),this}};if(s.promise(y),o.url=((b||o.url||tb.href)+"").replace(Hb,tb.protocol+"//"),o.type=c.method||c.type||o.method||o.type,o.dataTypes=(o.dataType||"*").toLowerCase().match(L)||[""],null==o.crossDomain){j=d.createElement("a");try{j.href=o.url,j.href=j.href,o.crossDomain=Lb.protocol+"//"+Lb.host!=j.protocol+"//"+j.host}catch(z){o.crossDomain=!0}}if(o.data&&o.processData&&"string"!=typeof o.data&&(o.data=r.param(o.data,o.traditional)),Nb(Ib,o,c,y),k)return y;l=r.event&&o.global,l&&0===r.active++&&r.event.trigger("ajaxStart"),o.type=o.type.toUpperCase(),o.hasContent=!Gb.test(o.type),f=o.url.replace(Cb,""),o.hasContent?o.data&&o.processData&&0===(o.contentType||"").indexOf("application/x-www-form-urlencoded")&&(o.data=o.data.replace(Bb,"+")):(n=o.url.slice(f.length),o.data&&(f+=(vb.test(f)?"&":"?")+o.data,delete o.data),o.cache===!1&&(f=f.replace(Db,"$1"),n=(vb.test(f)?"&":"?")+"_="+ub++ +n),o.url=f+n),o.ifModified&&(r.lastModified[f]&&y.setRequestHeader("If-Modified-Since",r.lastModified[f]),r.etag[f]&&y.setRequestHeader("If-None-Match",r.etag[f])),(o.data&&o.hasContent&&o.contentType!==!1||c.contentType)&&y.setRequestHeader("Content-Type",o.contentType),y.setRequestHeader("Accept",o.dataTypes[0]&&o.accepts[o.dataTypes[0]]?o.accepts[o.dataTypes[0]]+("*"!==o.dataTypes[0]?", "+Kb+"; q=0.01":""):o.accepts["*"]);for(m in o.headers)y.setRequestHeader(m,o.headers[m]);if(o.beforeSend&&(o.beforeSend.call(p,y,o)===!1||k))return y.abort();if(x="abort",t.add(o.complete),y.done(o.success),y.fail(o.error),e=Nb(Jb,o,c,y)){if(y.readyState=1,l&&q.trigger("ajaxSend",[y,o]),k)return y;o.async&&o.timeout>0&&(i=a.setTimeout(function(){y.abort("timeout")},o.timeout));try{k=!1,e.send(v,A)}catch(z){if(k)throw z;A(-1,z)}}else A(-1,"No Transport");function A(b,c,d,h){var j,m,n,v,w,x=c;k||(k=!0,i&&a.clearTimeout(i),e=void 0,g=h||"",y.readyState=b>0?4:0,j=b>=200&&b<300||304===b,d&&(v=Pb(o,y,d)),v=Qb(o,v,y,j),j?(o.ifModified&&(w=y.getResponseHeader("Last-Modified"),w&&(r.lastModified[f]=w),w=y.getResponseHeader("etag"),w&&(r.etag[f]=w)),204===b||"HEAD"===o.type?x="nocontent":304===b?x="notmodified":(x=v.state,m=v.data,n=v.error,j=!n)):(n=x,!b&&x||(x="error",b<0&&(b=0))),y.status=b,y.statusText=(c||x)+"",j?s.resolveWith(p,[m,x,y]):s.rejectWith(p,[y,x,n]),y.statusCode(u),u=void 0,l&&q.trigger(j?"ajaxSuccess":"ajaxError",[y,o,j?m:n]),t.fireWith(p,[y,x]),l&&(q.trigger("ajaxComplete",[y,o]),--r.active||r.event.trigger("ajaxStop")))}return y},getJSON:function(a,b,c){return r.get(a,b,c,"json")},getScript:function(a,b){return r.get(a,void 0,b,"script")}}),r.each(["get","post"],function(a,b){r[b]=function(a,c,d,e){return r.isFunction(c)&&(e=e||d,d=c,c=void 0),r.ajax(r.extend({url:a,type:b,dataType:e,data:c,success:d},r.isPlainObject(a)&&a))}}),r._evalUrl=function(a){return r.ajax({url:a,type:"GET",dataType:"script",cache:!0,async:!1,global:!1,"throws":!0})},r.fn.extend({wrapAll:function(a){var b;return this[0]&&(r.isFunction(a)&&(a=a.call(this[0])),b=r(a,this[0].ownerDocument).eq(0).clone(!0),this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstElementChild)a=a.firstElementChild;return a}).append(this)),this},wrapInner:function(a){return r.isFunction(a)?this.each(function(b){r(this).wrapInner(a.call(this,b))}):this.each(function(){var b=r(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){var b=r.isFunction(a);return this.each(function(c){r(this).wrapAll(b?a.call(this,c):a)})},unwrap:function(a){return this.parent(a).not("body").each(function(){r(this).replaceWith(this.childNodes)}),this}}),r.expr.pseudos.hidden=function(a){return!r.expr.pseudos.visible(a)},r.expr.pseudos.visible=function(a){return!!(a.offsetWidth||a.offsetHeight||a.getClientRects().length)},r.ajaxSettings.xhr=function(){try{return new a.XMLHttpRequest}catch(b){}};var Rb={0:200,1223:204},Sb=r.ajaxSettings.xhr();o.cors=!!Sb&&"withCredentials"in Sb,o.ajax=Sb=!!Sb,r.ajaxTransport(function(b){var c,d;if(o.cors||Sb&&!b.crossDomain)return{send:function(e,f){var g,h=b.xhr();if(h.open(b.type,b.url,b.async,b.username,b.password),b.xhrFields)for(g in b.xhrFields)h[g]=b.xhrFields[g];b.mimeType&&h.overrideMimeType&&h.overrideMimeType(b.mimeType),b.crossDomain||e["X-Requested-With"]||(e["X-Requested-With"]="XMLHttpRequest");for(g in e)h.setRequestHeader(g,e[g]);c=function(a){return function(){c&&(c=d=h.onload=h.onerror=h.onabort=h.onreadystatechange=null,"abort"===a?h.abort():"error"===a?"number"!=typeof h.status?f(0,"error"):f(h.status,h.statusText):f(Rb[h.status]||h.status,h.statusText,"text"!==(h.responseType||"text")||"string"!=typeof h.responseText?{binary:h.response}:{text:h.responseText},h.getAllResponseHeaders()))}},h.onload=c(),d=h.onerror=c("error"),void 0!==h.onabort?h.onabort=d:h.onreadystatechange=function(){4===h.readyState&&a.setTimeout(function(){c&&d()})},c=c("abort");try{h.send(b.hasContent&&b.data||null)}catch(i){if(c)throw i}},abort:function(){c&&c()}}}),r.ajaxPrefilter(function(a){a.crossDomain&&(a.contents.script=!1)}),r.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/\b(?:java|ecma)script\b/},converters:{"text script":function(a){return r.globalEval(a),a}}}),r.ajaxPrefilter("script",function(a){void 0===a.cache&&(a.cache=!1),a.crossDomain&&(a.type="GET")}),r.ajaxTransport("script",function(a){if(a.crossDomain){var b,c;return{send:function(e,f){b=r("<script>").prop({charset:a.scriptCharset,src:a.url}).on("load error",c=function(a){b.remove(),c=null,a&&f("error"===a.type?404:200,a.type)}),d.head.appendChild(b[0])},abort:function(){c&&c()}}}});var Tb=[],Ub=/(=)\?(?=&|$)|\?\?/;r.ajaxSetup({jsonp:"callback",jsonpCallback:function(){var a=Tb.pop()||r.expando+"_"+ub++;return this[a]=!0,a}}),r.ajaxPrefilter("json jsonp",function(b,c,d){var e,f,g,h=b.jsonp!==!1&&(Ub.test(b.url)?"url":"string"==typeof b.data&&0===(b.contentType||"").indexOf("application/x-www-form-urlencoded")&&Ub.test(b.data)&&"data");if(h||"jsonp"===b.dataTypes[0])return e=b.jsonpCallback=r.isFunction(b.jsonpCallback)?b.jsonpCallback():b.jsonpCallback,h?b[h]=b[h].replace(Ub,"$1"+e):b.jsonp!==!1&&(b.url+=(vb.test(b.url)?"&":"?")+b.jsonp+"="+e),b.converters["script json"]=function(){return g||r.error(e+" was not called"),g[0]},b.dataTypes[0]="json",f=a[e],a[e]=function(){g=arguments},d.always(function(){void 0===f?r(a).removeProp(e):a[e]=f,b[e]&&(b.jsonpCallback=c.jsonpCallback,Tb.push(e)),g&&r.isFunction(f)&&f(g[0]),g=f=void 0}),"script"}),o.createHTMLDocument=function(){var a=d.implementation.createHTMLDocument("").body;return a.innerHTML="<form></form><form></form>",2===a.childNodes.length}(),r.parseHTML=function(a,b,c){if("string"!=typeof a)return[];"boolean"==typeof b&&(c=b,b=!1);var e,f,g;return b||(o.createHTMLDocument?(b=d.implementation.createHTMLDocument(""),e=b.createElement("base"),e.href=d.location.href,b.head.appendChild(e)):b=d),f=C.exec(a),g=!c&&[],f?[b.createElement(f[1])]:(f=qa([a],b,g),g&&g.length&&r(g).remove(),r.merge([],f.childNodes))},r.fn.load=function(a,b,c){var d,e,f,g=this,h=a.indexOf(" ");return h>-1&&(d=pb(a.slice(h)),a=a.slice(0,h)),r.isFunction(b)?(c=b,b=void 0):b&&"object"==typeof b&&(e="POST"),g.length>0&&r.ajax({url:a,type:e||"GET",dataType:"html",data:b}).done(function(a){f=arguments,g.html(d?r("<div>").append(r.parseHTML(a)).find(d):a)}).always(c&&function(a,b){g.each(function(){c.apply(this,f||[a.responseText,b,a])})}),this},r.each(["ajaxStart","ajaxStop","ajaxComplete","ajaxError","ajaxSuccess","ajaxSend"],function(a,b){r.fn[b]=function(a){return this.on(b,a)}}),r.expr.pseudos.animated=function(a){return r.grep(r.timers,function(b){return a===b.elem}).length},r.offset={setOffset:function(a,b,c){var d,e,f,g,h,i,j,k=r.css(a,"position"),l=r(a),m={};"static"===k&&(a.style.position="relative"),h=l.offset(),f=r.css(a,"top"),i=r.css(a,"left"),j=("absolute"===k||"fixed"===k)&&(f+i).indexOf("auto")>-1,j?(d=l.position(),g=d.top,e=d.left):(g=parseFloat(f)||0,e=parseFloat(i)||0),r.isFunction(b)&&(b=b.call(a,c,r.extend({},h))),null!=b.top&&(m.top=b.top-h.top+g),null!=b.left&&(m.left=b.left-h.left+e),"using"in b?b.using.call(a,m):l.css(m)}},r.fn.extend({offset:function(a){if(arguments.length)return void 0===a?this:this.each(function(b){r.offset.setOffset(this,a,b)});var b,c,d,e,f=this[0];if(f)return f.getClientRects().length?(d=f.getBoundingClientRect(),b=f.ownerDocument,c=b.documentElement,e=b.defaultView,{top:d.top+e.pageYOffset-c.clientTop,left:d.left+e.pageXOffset-c.clientLeft}):{top:0,left:0}},position:function(){if(this[0]){var a,b,c=this[0],d={top:0,left:0};return"fixed"===r.css(c,"position")?b=c.getBoundingClientRect():(a=this.offsetParent(),b=this.offset(),B(a[0],"html")||(d=a.offset()),d={top:d.top+r.css(a[0],"borderTopWidth",!0),left:d.left+r.css(a[0],"borderLeftWidth",!0)}),{top:b.top-d.top-r.css(c,"marginTop",!0),left:b.left-d.left-r.css(c,"marginLeft",!0)}}},offsetParent:function(){return this.map(function(){var a=this.offsetParent;while(a&&"static"===r.css(a,"position"))a=a.offsetParent;return a||ra})}}),r.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(a,b){var c="pageYOffset"===b;r.fn[a]=function(d){return T(this,function(a,d,e){var f;return r.isWindow(a)?f=a:9===a.nodeType&&(f=a.defaultView),void 0===e?f?f[b]:a[d]:void(f?f.scrollTo(c?f.pageXOffset:e,c?e:f.pageYOffset):a[d]=e)},a,d,arguments.length)}}),r.each(["top","left"],function(a,b){r.cssHooks[b]=Pa(o.pixelPosition,function(a,c){if(c)return c=Oa(a,b),Ma.test(c)?r(a).position()[b]+"px":c})}),r.each({Height:"height",Width:"width"},function(a,b){r.each({padding:"inner"+a,content:b,"":"outer"+a},function(c,d){r.fn[d]=function(e,f){var g=arguments.length&&(c||"boolean"!=typeof e),h=c||(e===!0||f===!0?"margin":"border");return T(this,function(b,c,e){var f;return r.isWindow(b)?0===d.indexOf("outer")?b["inner"+a]:b.document.documentElement["client"+a]:9===b.nodeType?(f=b.documentElement,Math.max(b.body["scroll"+a],f["scroll"+a],b.body["offset"+a],f["offset"+a],f["client"+a])):void 0===e?r.css(b,c,h):r.style(b,c,e,h)},b,g?e:void 0,g)}})}),r.fn.extend({bind:function(a,b,c){return this.on(a,null,b,c)},unbind:function(a,b){return this.off(a,null,b)},delegate:function(a,b,c,d){return this.on(b,a,c,d)},undelegate:function(a,b,c){return 1===arguments.length?this.off(a,"**"):this.off(b,a||"**",c)}}),r.holdReady=function(a){a?r.readyWait++:r.ready(!0)},r.isArray=Array.isArray,r.parseJSON=JSON.parse,r.nodeName=B,"function"==typeof define&&define.amd&&define("jquery",[],function(){return r});var Vb=a.jQuery,Wb=a.$;return r.noConflict=function(b){return a.$===r&&(a.$=Wb),b&&a.jQuery===r&&(a.jQuery=Vb),r},b||(a.jQuery=a.$=r),r});

11+

12+ </script>

13+ <script language="javascript" type="text/javascript">

14+ /* Javascript plotting library for jQuery, version 0.8.3.

15+

17+Licensed under the MIT license.

18+

19+*/

20+(function($){$.color={};$.color.make=function(r,g,b,a){var o={};o.r=r||0;o.g=g||0;o.b=b||0;o.a=a!=null?a:1;o.add=function(c,d){for(var i=0;i<c.length;++i)o[c.charAt(i)]+=d;return o.normalize()};o.scale=function(c,f){for(var i=0;i<c.length;++i)o[c.charAt(i)]*=f;return o.normalize()};o.toString=function(){if(o.a>=1){return"rgb("+[o.r,o.g,o.b].join(",")+")"}else{return"rgba("+[o.r,o.g,o.b,o.a].join(",")+")"}};o.normalize=function(){function clamp(min,value,max){return value<min?min:value>max?max:value}o.r=clamp(0,parseInt(o.r),255);o.g=clamp(0,parseInt(o.g),255);o.b=clamp(0,parseInt(o.b),255);o.a=clamp(0,o.a,1);return o};o.clone=function(){return $.color.make(o.r,o.b,o.g,o.a)};return o.normalize()};$.color.extract=function(elem,css){var c;do{c=elem.css(css).toLowerCase();if(c!=""&&c!="transparent")break;elem=elem.parent()}while(elem.length&&!$.nodeName(elem.get(0),"body"));if(c=="rgba(0, 0, 0, 0)")c="transparent";return $.color.parse(c)};$.color.parse=function(str){var res,m=$.color.make;if(res=/rgb$\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*$/.exec(str))return m(parseInt(res[1],10),parseInt(res[2],10),parseInt(res[3],10));if(res=/rgba$\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*,\s*([0-9]+(?:\.[0-9]+)?)\s*$/.exec(str))return m(parseInt(res[1],10),parseInt(res[2],10),parseInt(res[3],10),parseFloat(res[4]));if(res=/rgb$\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*$/.exec(str))return m(parseFloat(res[1])*2.55,parseFloat(res[2])*2.55,parseFloat(res[3])*2.55);if(res=/rgba$\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\s*$/.exec(str))return m(parseFloat(res[1])*2.55,parseFloat(res[2])*2.55,parseFloat(res[3])*2.55,parseFloat(res[4]));if(res=/#([a-fA-F0-9]{2})([a-fA-F0-9]{2})([a-fA-F0-9]{2})/.exec(str))return m(parseInt(res[1],16),parseInt(res[2],16),parseInt(res[3],16));if(res=/#([a-fA-F0-9])([a-fA-F0-9])([a-fA-F0-9])/.exec(str))return m(parseInt(res[1]+res[1],16),parseInt(res[2]+res[2],16),parseInt(res[3]+res[3],16));var name=$.trim(str).toLowerCase();if(name=="transparent")return m(255,255,255,0);else{res=lookupColors[name]||[0,0,0];return m(res[0],res[1],res[2])}};var lookupColors={aqua:[0,255,255],azure:[240,255,255],beige:[245,245,220],black:[0,0,0],blue:[0,0,255],brown:[165,42,42],cyan:[0,255,255],darkblue:[0,0,139],darkcyan:[0,139,139],darkgrey:[169,169,169],darkgreen:[0,100,0],darkkhaki:[189,183,107],darkmagenta:[139,0,139],darkolivegreen:[85,107,47],darkorange:[255,140,0],darkorchid:[153,50,204],darkred:[139,0,0],darksalmon:[233,150,122],darkviolet:[148,0,211],fuchsia:[255,0,255],gold:[255,215,0],green:[0,128,0],indigo:[75,0,130],khaki:[240,230,140],lightblue:[173,216,230],lightcyan:[224,255,255],lightgreen:[144,238,144],lightgrey:[211,211,211],lightpink:[255,182,193],lightyellow:[255,255,224],lime:[0,255,0],magenta:[255,0,255],maroon:[128,0,0],navy:[0,0,128],olive:[128,128,0],orange:[255,165,0],pink:[255,192,203],purple:[128,0,128],violet:[128,0,128],red:[255,0,0],silver:[192,192,192],white:[255,255,255],yellow:[255,255,0]}})(jQuery);(function($){var hasOwnProperty=Object.prototype.hasOwnProperty;if(!$.fn.detach){$.fn.detach=function(){return this.each(function(){if(this.parentNode){this.parentNode.removeChild(this)}})}}function Canvas(cls,container){var element=container.children("."+cls)[0];if(element==null){element=document.createElement("canvas");element.className=cls;$(element).css({direction:"ltr",position:"absolute",left:0,top:0}).appendTo(container);if(!element.getContext){if(window.G_vmlCanvasManager){element=window.G_vmlCanvasManager.initElement(element)}else{throw new Error("Canvas is not available. If you're using IE with a fall-back such as Excanvas, then there's either a mistake in your conditional include, or the page has no DOCTYPE and is rendering in Quirks Mode.")}}}this.element=element;var context=this.context=element.getContext("2d");var devicePixelRatio=window.devicePixelRatio||1,backingStoreRatio=context.webkitBackingStorePixelRatio||context.mozBackingStorePixelRatio||context.msBackingStorePixelRatio||context.oBackingStorePixelRatio||context.backingStorePixelRatio||1;this.pixelRatio=devicePixelRatio/backingStoreRatio;this.resize(container.width(),container.height());this.textContainer=null;this.text={};this._textCache={}}Canvas.prototype.resize=function(width,height){if(width<=0||height<=0){throw new Error("Invalid dimensions for plot, width = "+width+", height = "+height)}var element=this.element,context=this.context,pixelRatio=this.pixelRatio;if(this.width!=width){element.width=width*pixelRatio;element.style.width=width+"px";this.width=width}if(this.height!=height){element.height=height*pixelRatio;element.style.height=height+"px";this.height=height}context.restore();context.save();context.scale(pixelRatio,pixelRatio)};Canvas.prototype.clear=function(){this.context.clearRect(0,0,this.width,this.height)};Canvas.prototype.render=function(){var cache=this._textCache;for(var layerKey in cache){if(hasOwnProperty.call(cache,layerKey)){var layer=this.getTextLayer(layerKey),layerCache=cache[layerKey];layer.hide();for(var styleKey in layerCache){if(hasOwnProperty.call(layerCache,styleKey)){var styleCache=layerCache[styleKey];for(var key in styleCache){if(hasOwnProperty.call(styleCache,key)){var positions=styleCache[key].positions;for(var i=0,position;position=positions[i];i++){if(position.active){if(!position.rendered){layer.append(position.element);position.rendered=true}}else{positions.splice(i--,1);if(position.rendered){position.element.detach()}}}if(positions.length==0){delete styleCache[key]}}}}}layer.show()}}};Canvas.prototype.getTextLayer=function(classes){var layer=this.text[classes];if(layer==null){if(this.textContainer==null){this.textContainer=$("<div class='flot-text'></div>").css({position:"absolute",top:0,left:0,bottom:0,right:0,"font-size":"smaller",color:"#545454"}).insertAfter(this.element)}layer=this.text[classes]=$("<div></div>").addClass(classes).css({position:"absolute",top:0,left:0,bottom:0,right:0}).appendTo(this.textContainer)}return layer};Canvas.prototype.getTextInfo=function(layer,text,font,angle,width){var textStyle,layerCache,styleCache,info;text=""+text;if(typeof font==="object"){textStyle=font.style+" "+font.variant+" "+font.weight+" "+font.size+"px/"+font.lineHeight+"px "+font.family}else{textStyle=font}layerCache=this._textCache[layer];if(layerCache==null){layerCache=this._textCache[layer]={}}styleCache=layerCache[textStyle];if(styleCache==null){styleCache=layerCache[textStyle]={}}info=styleCache[text];if(info==null){var element=$("<div></div>").html(text).css({position:"absolute","max-width":width,top:-9999}).appendTo(this.getTextLayer(layer));if(typeof font==="object"){element.css({font:textStyle,color:font.color})}else if(typeof font==="string"){element.addClass(font)}info=styleCache[text]={width:element.outerWidth(true),height:element.outerHeight(true),element:element,positions:[]};element.detach()}return info};Canvas.prototype.addText=function(layer,x,y,text,font,angle,width,halign,valign){var info=this.getTextInfo(layer,text,font,angle,width),positions=info.positions;if(halign=="center"){x-=info.width/2}else if(halign=="right"){x-=info.width}if(valign=="middle"){y-=info.height/2}else if(valign=="bottom"){y-=info.height}for(var i=0,position;position=positions[i];i++){if(position.x==x&&position.y==y){position.active=true;return}}position={active:true,rendered:false,element:positions.length?info.element.clone():info.element,x:x,y:y};positions.push(position);position.element.css({top:Math.round(y),left:Math.round(x),"text-align":halign})};Canvas.prototype.removeText=function(layer,x,y,text,font,angle){if(text==null){var layerCache=this._textCache[layer];if(layerCache!=null){for(var styleKey in layerCache){if(hasOwnProperty.call(layerCache,styleKey)){var styleCache=layerCache[styleKey];for(var key in styleCache){if(hasOwnProperty.call(styleCache,key)){var positions=styleCache[key].positions;for(var i=0,position;position=positions[i];i++){position.active=false}}}}}}}else{var positions=this.getTextInfo(layer,text,font,angle).positions;for(var i=0,position;position=positions[i];i++){if(position.x==x&&position.y==y){position.active=false}}}};function Plot(placeholder,data_,options_,plugins){var series=[],options={colors:["#edc240","#afd8f8","#cb4b4b","#4da74d","#9440ed"],legend:{show:true,noColumns:1,labelFormatter:null,labelBoxBorderColor:"#ccc",container:null,position:"ne",margin:5,backgroundColor:null,backgroundOpacity:.85,sorted:null},xaxis:{show:null,position:"bottom",mode:null,font:null,color:null,tickColor:null,transform:null,inverseTransform:null,min:null,max:null,autoscaleMargin:null,ticks:null,tickFormatter:null,labelWidth:null,labelHeight:null,reserveSpace:null,tickLength:null,alignTicksWithAxis:null,tickDecimals:null,tickSize:null,minTickSize:null},yaxis:{autoscaleMargin:.02,position:"left"},xaxes:[],yaxes:[],series:{points:{show:false,radius:3,lineWidth:2,fill:true,fillColor:"#ffffff",symbol:"circle"},lines:{lineWidth:2,fill:false,fillColor:null,steps:false},bars:{show:false,lineWidth:2,barWidth:1,fill:true,fillColor:null,align:"left",horizontal:false,zero:true},shadowSize:3,highlightColor:null},grid:{show:true,aboveData:false,color:"#545454",backgroundColor:null,borderColor:null,tickColor:null,margin:0,labelMargin:5,axisMargin:8,borderWidth:2,minBorderMargin:null,markings:null,markingsColor:"#f4f4f4",markingsLineWidth:2,clickable:false,hoverable:false,autoHighlight:true,mouseActiveRadius:10},interaction:{redrawOverlayInterval:1e3/60},hooks:{}},surface=null,overlay=null,eventHolder=null,ctx=null,octx=null,xaxes=[],yaxes=[],plotOffset={left:0,right:0,top:0,bottom:0},plotWidth=0,plotHeight=0,hooks={processOptions:[],processRawData:[],processDatapoints:[],processOffset:[],drawBackground:[],drawSeries:[],draw:[],bindEvents:[],drawOverlay:[],shutdown:[]},plot=this;plot.setData=setData;plot.setupGrid=setupGrid;plot.draw=draw;plot.getPlaceholder=function(){return placeholder};plot.getCanvas=function(){return surface.element};plot.getPlotOffset=function(){return plotOffset};plot.width=function(){return plotWidth};plot.height=function(){return plotHeight};plot.offset=function(){var o=eventHolder.offset();o.left+=plotOffset.left;o.top+=plotOffset.top;return o};plot.getData=function(){return series};plot.getAxes=function(){var res={},i;$.each(xaxes.concat(yaxes),function(_,axis){if(axis)res[axis.direction+(axis.n!=1?axis.n:"")+"axis"]=axis});return res};plot.getXAxes=function(){return xaxes};plot.getYAxes=function(){return yaxes};plot.c2p=canvasToAxisCoords;plot.p2c=axisToCanvasCoords;plot.getOptions=function(){return options};plot.highlight=highlight;plot.unhighlight=unhighlight;plot.triggerRedrawOverlay=triggerRedrawOverlay;plot.pointOffset=function(point){return{left:parseInt(xaxes[axisNumber(point,"x")-1].p2c(+point.x)+plotOffset.left,10),top:parseInt(yaxes[axisNumber(point,"y")-1].p2c(+point.y)+plotOffset.top,10)}};plot.shutdown=shutdown;plot.destroy=function(){shutdown();placeholder.removeData("plot").empty();series=[];options=null;surface=null;overlay=null;eventHolder=null;ctx=null;octx=null;xaxes=[];yaxes=[];hooks=null;highlights=[];plot=null};plot.resize=function(){var width=placeholder.width(),height=placeholder.height();surface.resize(width,height);overlay.resize(width,height)};plot.hooks=hooks;initPlugins(plot);parseOptions(options_);setupCanvases();setData(data_);setupGrid();draw();bindEvents();function executeHooks(hook,args){args=[plot].concat(args);for(var i=0;i<hook.length;++i)hook[i].apply(this,args)}function initPlugins(){var classes={Canvas:Canvas};for(var i=0;i<plugins.length;++i){var p=plugins[i];p.init(plot,classes);if(p.options)$.extend(true,options,p.options)}}function parseOptions(opts){$.extend(true,options,opts);if(opts&&opts.colors){options.colors=opts.colors}if(options.xaxis.color==null)options.xaxis.color=$.color.parse(options.grid.color).scale("a",.22).toString();if(options.yaxis.color==null)options.yaxis.color=$.color.parse(options.grid.color).scale("a",.22).toString();if(options.xaxis.tickColor==null)options.xaxis.tickColor=options.grid.tickColor||options.xaxis.color;if(options.yaxis.tickColor==null)options.yaxis.tickColor=options.grid.tickColor||options.yaxis.color;if(options.grid.borderColor==null)options.grid.borderColor=options.grid.color;if(options.grid.tickColor==null)options.grid.tickColor=$.color.parse(options.grid.color).scale("a",.22).toString();var i,axisOptions,axisCount,fontSize=placeholder.css("font-size"),fontSizeDefault=fontSize?+fontSize.replace("px",""):13,fontDefaults={style:placeholder.css("font-style"),size:Math.round(.8*fontSizeDefault),variant:placeholder.css("font-variant"),weight:placeholder.css("font-weight"),family:placeholder.css("font-family")};axisCount=options.xaxes.length||1;for(i=0;i<axisCount;++i){axisOptions=options.xaxes[i];if(axisOptions&&!axisOptions.tickColor){axisOptions.tickColor=axisOptions.color}axisOptions=$.extend(true,{},options.xaxis,axisOptions);options.xaxes[i]=axisOptions;if(axisOptions.font){axisOptions.font=$.extend({},fontDefaults,axisOptions.font);if(!axisOptions.font.color){axisOptions.font.color=axisOptions.color}if(!axisOptions.font.lineHeight){axisOptions.font.lineHeight=Math.round(axisOptions.font.size*1.15)}}}axisCount=options.yaxes.length||1;for(i=0;i<axisCount;++i){axisOptions=options.yaxes[i];if(axisOptions&&!axisOptions.tickColor){axisOptions.tickColor=axisOptions.color}axisOptions=$.extend(true,{},options.yaxis,axisOptions);options.yaxes[i]=axisOptions;if(axisOptions.font){axisOptions.font=$.extend({},fontDefaults,axisOptions.font);if(!axisOptions.font.color){axisOptions.font.color=axisOptions.color}if(!axisOptions.font.lineHeight){axisOptions.font.lineHeight=Math.round(axisOptions.font.size*1.15)}}}if(options.xaxis.noTicks&&options.xaxis.ticks==null)options.xaxis.ticks=options.xaxis.noTicks;if(options.yaxis.noTicks&&options.yaxis.ticks==null)options.yaxis.ticks=options.yaxis.noTicks;if(options.x2axis){options.xaxes[1]=$.extend(true,{},options.xaxis,options.x2axis);options.xaxes[1].position="top";if(options.x2axis.min==null){options.xaxes[1].min=null}if(options.x2axis.max==null){options.xaxes[1].max=null}}if(options.y2axis){options.yaxes[1]=$.extend(true,{},options.yaxis,options.y2axis);options.yaxes[1].position="right";if(options.y2axis.min==null){options.yaxes[1].min=null}if(options.y2axis.max==null){options.yaxes[1].max=null}}if(options.grid.coloredAreas)options.grid.markings=options.grid.coloredAreas;if(options.grid.coloredAreasColor)options.grid.markingsColor=options.grid.coloredAreasColor;if(options.lines)$.extend(true,options.series.lines,options.lines);if(options.points)$.extend(true,options.series.points,options.points);if(options.bars)$.extend(true,options.series.bars,options.bars);if(options.shadowSize!=null)options.series.shadowSize=options.shadowSize;if(options.highlightColor!=null)options.series.highlightColor=options.highlightColor;for(i=0;i<options.xaxes.length;++i)getOrCreateAxis(xaxes,i+1).options=options.xaxes[i];for(i=0;i<options.yaxes.length;++i)getOrCreateAxis(yaxes,i+1).options=options.yaxes[i];for(var n in hooks)if(options.hooks[n]&&options.hooks[n].length)hooks[n]=hooks[n].concat(options.hooks[n]);executeHooks(hooks.processOptions,[options])}function setData(d){series=parseData(d);fillInSeriesOptions();processData()}function parseData(d){var res=[];for(var i=0;i<d.length;++i){var s=$.extend(true,{},options.series);if(d[i].data!=null){s.data=d[i].data;delete d[i].data;$.extend(true,s,d[i]);d[i].data=s.data}else s.data=d[i];res.push(s)}return res}function axisNumber(obj,coord){var a=obj[coord+"axis"];if(typeof a=="object")a=a.n;if(typeof a!="number")a=1;return a}function allAxes(){return $.grep(xaxes.concat(yaxes),function(a){return a})}function canvasToAxisCoords(pos){var res={},i,axis;for(i=0;i<xaxes.length;++i){axis=xaxes[i];if(axis&&axis.used)res["x"+axis.n]=axis.c2p(pos.left)}for(i=0;i<yaxes.length;++i){axis=yaxes[i];if(axis&&axis.used)res["y"+axis.n]=axis.c2p(pos.top)}if(res.x1!==undefined)res.x=res.x1;if(res.y1!==undefined)res.y=res.y1;return res}function axisToCanvasCoords(pos){var res={},i,axis,key;for(i=0;i<xaxes.length;++i){axis=xaxes[i];if(axis&&axis.used){key="x"+axis.n;if(pos[key]==null&&axis.n==1)key="x";if(pos[key]!=null){res.left=axis.p2c(pos[key]);break}}}for(i=0;i<yaxes.length;++i){axis=yaxes[i];if(axis&&axis.used){key="y"+axis.n;if(pos[key]==null&&axis.n==1)key="y";if(pos[key]!=null){res.top=axis.p2c(pos[key]);break}}}return res}function getOrCreateAxis(axes,number){if(!axes[number-1])axes[number-1]={n:number,direction:axes==xaxes?"x":"y",options:$.extend(true,{},axes==xaxes?options.xaxis:options.yaxis)};return axes[number-1]}function fillInSeriesOptions(){var neededColors=series.length,maxIndex=-1,i;for(i=0;i<series.length;++i){var sc=series[i].color;if(sc!=null){neededColors--;if(typeof sc=="number"&&sc>maxIndex){maxIndex=sc}}}if(neededColors<=maxIndex){neededColors=maxIndex+1}var c,colors=[],colorPool=options.colors,colorPoolSize=colorPool.length,variation=0;for(i=0;i<neededColors;i++){c=$.color.parse(colorPool[i%colorPoolSize]||"#666");if(i%colorPoolSize==0&&i){if(variation>=0){if(variation<.5){variation=-variation-.2}else variation=0}else variation=-variation}colors[i]=c.scale("rgb",1+variation)}var colori=0,s;for(i=0;i<series.length;++i){s=series[i];if(s.color==null){s.color=colors[colori].toString();++colori}else if(typeof s.color=="number")s.color=colors[s.color].toString();if(s.lines.show==null){var v,show=true;for(v in s)if(s[v]&&s[v].show){show=false;break}if(show)s.lines.show=true}if(s.lines.zero==null){s.lines.zero=!!s.lines.fill}s.xaxis=getOrCreateAxis(xaxes,axisNumber(s,"x"));s.yaxis=getOrCreateAxis(yaxes,axisNumber(s,"y"))}}function processData(){var topSentry=Number.POSITIVE_INFINITY,bottomSentry=Number.NEGATIVE_INFINITY,fakeInfinity=Number.MAX_VALUE,i,j,k,m,length,s,points,ps,x,y,axis,val,f,p,data,format;function updateAxis(axis,min,max){if(min<axis.datamin&&min!=-fakeInfinity)axis.datamin=min;if(max>axis.datamax&&max!=fakeInfinity)axis.datamax=max}$.each(allAxes(),function(_,axis){axis.datamin=topSentry;axis.datamax=bottomSentry;axis.used=false});for(i=0;i<series.length;++i){s=series[i];s.datapoints={points:[]};executeHooks(hooks.processRawData,[s,s.data,s.datapoints])}for(i=0;i<series.length;++i){s=series[i];data=s.data;format=s.datapoints.format;if(!format){format=[];format.push({x:true,number:true,required:true});format.push({y:true,number:true,required:true});if(s.bars.show||s.lines.show&&s.lines.fill){var autoscale=!!(s.bars.show&&s.bars.zero||s.lines.show&&s.lines.zero);format.push({y:true,number:true,required:false,defaultValue:0,autoscale:autoscale});if(s.bars.horizontal){delete format[format.length-1].y;format[format.length-1].x=true}}s.datapoints.format=format}if(s.datapoints.pointsize!=null)continue;s.datapoints.pointsize=format.length;ps=s.datapoints.pointsize;points=s.datapoints.points;var insertSteps=s.lines.show&&s.lines.steps;s.xaxis.used=s.yaxis.used=true;for(j=k=0;j<data.length;++j,k+=ps){p=data[j];var nullify=p==null;if(!nullify){for(m=0;m<ps;++m){val=p[m];f=format[m];if(f){if(f.number&&val!=null){val=+val;if(isNaN(val))val=null;else if(val==Infinity)val=fakeInfinity;else if(val==-Infinity)val=-fakeInfinity}if(val==null){if(f.required)nullify=true;if(f.defaultValue!=null)val=f.defaultValue}}points[k+m]=val}}if(nullify){for(m=0;m<ps;++m){val=points[k+m];if(val!=null){f=format[m];if(f.autoscale!==false){if(f.x){updateAxis(s.xaxis,val,val)}if(f.y){updateAxis(s.yaxis,val,val)}}}points[k+m]=null}}else{if(insertSteps&&k>0&&points[k-ps]!=null&&points[k-ps]!=points[k]&&points[k-ps+1]!=points[k+1]){for(m=0;m<ps;++m)points[k+ps+m]=points[k+m];points[k+1]=points[k-ps+1];k+=ps}}}}for(i=0;i<series.length;++i){s=series[i];executeHooks(hooks.processDatapoints,[s,s.datapoints])}for(i=0;i<series.length;++i){s=series[i];points=s.datapoints.points;ps=s.datapoints.pointsize;format=s.datapoints.format;var xmin=topSentry,ymin=topSentry,xmax=bottomSentry,ymax=bottomSentry;for(j=0;j<points.length;j+=ps){if(points[j]==null)continue;for(m=0;m<ps;++m){val=points[j+m];f=format[m];if(!f||f.autoscale===false||val==fakeInfinity||val==-fakeInfinity)continue;if(f.x){if(val<xmin)xmin=val;if(val>xmax)xmax=val}if(f.y){if(val<ymin)ymin=val;if(val>ymax)ymax=val}}}if(s.bars.show){var delta;switch(s.bars.align){case"left":delta=0;break;case"right":delta=-s.bars.barWidth;break;default:delta=-s.bars.barWidth/2}if(s.bars.horizontal){ymin+=delta;ymax+=delta+s.bars.barWidth}else{xmin+=delta;xmax+=delta+s.bars.barWidth}}updateAxis(s.xaxis,xmin,xmax);updateAxis(s.yaxis,ymin,ymax)}$.each(allAxes(),function(_,axis){if(axis.datamin==topSentry)axis.datamin=null;if(axis.datamax==bottomSentry)axis.datamax=null})}function setupCanvases(){placeholder.css("padding",0).children().filter(function(){return!$(this).hasClass("flot-overlay")&&!$(this).hasClass("flot-base")}).remove();if(placeholder.css("position")=="static")placeholder.css("position","relative");surface=new Canvas("flot-base",placeholder);overlay=new Canvas("flot-overlay",placeholder);ctx=surface.context;octx=overlay.context;eventHolder=$(overlay.element).unbind();var existing=placeholder.data("plot");if(existing){existing.shutdown();overlay.clear()}placeholder.data("plot",plot)}function bindEvents(){if(options.grid.hoverable){eventHolder.mousemove(onMouseMove);eventHolder.bind("mouseleave",onMouseLeave)}if(options.grid.clickable)eventHolder.click(onClick);executeHooks(hooks.bindEvents,[eventHolder])}function shutdown(){if(redrawTimeout)clearTimeout(redrawTimeout);eventHolder.unbind("mousemove",onMouseMove);eventHolder.unbind("mouseleave",onMouseLeave);eventHolder.unbind("click",onClick);executeHooks(hooks.shutdown,[eventHolder])}function setTransformationHelpers(axis){function identity(x){return x}var s,m,t=axis.options.transform||identity,it=axis.options.inverseTransform;if(axis.direction=="x"){s=axis.scale=plotWidth/Math.abs(t(axis.max)-t(axis.min));m=Math.min(t(axis.max),t(axis.min))}else{s=axis.scale=plotHeight/Math.abs(t(axis.max)-t(axis.min));s=-s;m=Math.max(t(axis.max),t(axis.min))}if(t==identity)axis.p2c=function(p){return(p-m)*s};else axis.p2c=function(p){return(t(p)-m)*s};if(!it)axis.c2p=function(c){return m+c/s};else axis.c2p=function(c){return it(m+c/s)}}function measureTickLabels(axis){var opts=axis.options,ticks=axis.ticks||[],labelWidth=opts.labelWidth||0,labelHeight=opts.labelHeight||0,maxWidth=labelWidth||(axis.direction=="x"?Math.floor(surface.width/(ticks.length||1)):null),legacyStyles=axis.direction+"Axis "+axis.direction+axis.n+"Axis",layer="flot-"+axis.direction+"-axis flot-"+axis.direction+axis.n+"-axis "+legacyStyles,font=opts.font||"flot-tick-label tickLabel";for(var i=0;i<ticks.length;++i){var t=ticks[i];if(!t.label)continue;var info=surface.getTextInfo(layer,t.label,font,null,maxWidth);labelWidth=Math.max(labelWidth,info.width);labelHeight=Math.max(labelHeight,info.height)}axis.labelWidth=opts.labelWidth||labelWidth;axis.labelHeight=opts.labelHeight||labelHeight}function allocateAxisBoxFirstPhase(axis){var lw=axis.labelWidth,lh=axis.labelHeight,pos=axis.options.position,isXAxis=axis.direction==="x",tickLength=axis.options.tickLength,axisMargin=options.grid.axisMargin,padding=options.grid.labelMargin,innermost=true,outermost=true,first=true,found=false;$.each(isXAxis?xaxes:yaxes,function(i,a){if(a&&(a.show||a.reserveSpace)){if(a===axis){found=true}else if(a.options.position===pos){if(found){outermost=false}else{innermost=false}}if(!found){first=false}}});if(outermost){axisMargin=0}if(tickLength==null){tickLength=first?"full":5}if(!isNaN(+tickLength))padding+=+tickLength;if(isXAxis){lh+=padding;if(pos=="bottom"){plotOffset.bottom+=lh+axisMargin;axis.box={top:surface.height-plotOffset.bottom,height:lh}}else{axis.box={top:plotOffset.top+axisMargin,height:lh};plotOffset.top+=lh+axisMargin}}else{lw+=padding;if(pos=="left"){axis.box={left:plotOffset.left+axisMargin,width:lw};plotOffset.left+=lw+axisMargin}else{plotOffset.right+=lw+axisMargin;axis.box={left:surface.width-plotOffset.right,width:lw}}}axis.position=pos;axis.tickLength=tickLength;axis.box.padding=padding;axis.innermost=innermost}function allocateAxisBoxSecondPhase(axis){if(axis.direction=="x"){axis.box.left=plotOffset.left-axis.labelWidth/2;axis.box.width=surface.width-plotOffset.left-plotOffset.right+axis.labelWidth}else{axis.box.top=plotOffset.top-axis.labelHeight/2;axis.box.height=surface.height-plotOffset.bottom-plotOffset.top+axis.labelHeight}}function adjustLayoutForThingsStickingOut(){var minMargin=options.grid.minBorderMargin,axis,i;if(minMargin==null){minMargin=0;for(i=0;i<series.length;++i)minMargin=Math.max(minMargin,2*(series[i].points.radius+series[i].points.lineWidth/2))}var margins={left:minMargin,right:minMargin,top:minMargin,bottom:minMargin};$.each(allAxes(),function(_,axis){if(axis.reserveSpace&&axis.ticks&&axis.ticks.length){if(axis.direction==="x"){margins.left=Math.max(margins.left,axis.labelWidth/2);margins.right=Math.max(margins.right,axis.labelWidth/2)}else{margins.bottom=Math.max(margins.bottom,axis.labelHeight/2);margins.top=Math.max(margins.top,axis.labelHeight/2)}}});plotOffset.left=Math.ceil(Math.max(margins.left,plotOffset.left));plotOffset.right=Math.ceil(Math.max(margins.right,plotOffset.right));plotOffset.top=Math.ceil(Math.max(margins.top,plotOffset.top));plotOffset.bottom=Math.ceil(Math.max(margins.bottom,plotOffset.bottom))}function setupGrid(){var i,axes=allAxes(),showGrid=options.grid.show;for(var a in plotOffset){var margin=options.grid.margin||0;plotOffset[a]=typeof margin=="number"?margin:margin[a]||0}executeHooks(hooks.processOffset,[plotOffset]);for(var a in plotOffset){if(typeof options.grid.borderWidth=="object"){plotOffset[a]+=showGrid?options.grid.borderWidth[a]:0}else{plotOffset[a]+=showGrid?options.grid.borderWidth:0}}$.each(axes,function(_,axis){var axisOpts=axis.options;axis.show=axisOpts.show==null?axis.used:axisOpts.show;axis.reserveSpace=axisOpts.reserveSpace==null?axis.show:axisOpts.reserveSpace;setRange(axis)});if(showGrid){var allocatedAxes=$.grep(axes,function(axis){return axis.show||axis.reserveSpace});$.each(allocatedAxes,function(_,axis){setupTickGeneration(axis);setTicks(axis);snapRangeToTicks(axis,axis.ticks);measureTickLabels(axis)});for(i=allocatedAxes.length-1;i>=0;--i)allocateAxisBoxFirstPhase(allocatedAxes[i]);adjustLayoutForThingsStickingOut();$.each(allocatedAxes,function(_,axis){allocateAxisBoxSecondPhase(axis)})}plotWidth=surface.width-plotOffset.left-plotOffset.right;plotHeight=surface.height-plotOffset.bottom-plotOffset.top;$.each(axes,function(_,axis){setTransformationHelpers(axis)});if(showGrid){drawAxisLabels()}insertLegend()}function setRange(axis){var opts=axis.options,min=+(opts.min!=null?opts.min:axis.datamin),max=+(opts.max!=null?opts.max:axis.datamax),delta=max-min;if(delta==0){var widen=max==0?1:.01;if(opts.min==null)min-=widen;if(opts.max==null||opts.min!=null)max+=widen}else{var margin=opts.autoscaleMargin;if(margin!=null){if(opts.min==null){min-=delta*margin;if(min<0&&axis.datamin!=null&&axis.datamin>=0)min=0}if(opts.max==null){max+=delta*margin;if(max>0&&axis.datamax!=null&&axis.datamax<=0)max=0}}}axis.min=min;axis.max=max}function setupTickGeneration(axis){var opts=axis.options;var noTicks;if(typeof opts.ticks=="number"&&opts.ticks>0)noTicks=opts.ticks;else noTicks=.3*Math.sqrt(axis.direction=="x"?surface.width:surface.height);var delta=(axis.max-axis.min)/noTicks,dec=-Math.floor(Math.log(delta)/Math.LN10),maxDec=opts.tickDecimals;if(maxDec!=null&&dec>maxDec){dec=maxDec}var magn=Math.pow(10,-dec),norm=delta/magn,size;if(norm<1.5){size=1}else if(norm<3){size=2;if(norm>2.25&&(maxDec==null||dec+1<=maxDec)){size=2.5;++dec}}else if(norm<7.5){size=5}else{size=10}size*=magn;if(opts.minTickSize!=null&&size<opts.minTickSize){size=opts.minTickSize}axis.delta=delta;axis.tickDecimals=Math.max(0,maxDec!=null?maxDec:dec);axis.tickSize=opts.tickSize||size;if(opts.mode=="time"&&!axis.tickGenerator){throw new Error("Time mode requires the flot.time plugin.")}if(!axis.tickGenerator){axis.tickGenerator=function(axis){var ticks=[],start=floorInBase(axis.min,axis.tickSize),i=0,v=Number.NaN,prev;do{prev=v;v=start+i*axis.tickSize;ticks.push(v);++i}while(v<axis.max&&v!=prev);return ticks};axis.tickFormatter=function(value,axis){var factor=axis.tickDecimals?Math.pow(10,axis.tickDecimals):1;var formatted=""+Math.round(value*factor)/factor;if(axis.tickDecimals!=null){var decimal=formatted.indexOf(".");var precision=decimal==-1?0:formatted.length-decimal-1;if(precision<axis.tickDecimals){return(precision?formatted:formatted+".")+(""+factor).substr(1,axis.tickDecimals-precision)}}return formatted}}if($.isFunction(opts.tickFormatter))axis.tickFormatter=function(v,axis){return""+opts.tickFormatter(v,axis)};if(opts.alignTicksWithAxis!=null){var otherAxis=(axis.direction=="x"?xaxes:yaxes)[opts.alignTicksWithAxis-1];if(otherAxis&&otherAxis.used&&otherAxis!=axis){var niceTicks=axis.tickGenerator(axis);if(niceTicks.length>0){if(opts.min==null)axis.min=Math.min(axis.min,niceTicks[0]);if(opts.max==null&&niceTicks.length>1)axis.max=Math.max(axis.max,niceTicks[niceTicks.length-1])}axis.tickGenerator=function(axis){var ticks=[],v,i;for(i=0;i<otherAxis.ticks.length;++i){v=(otherAxis.ticks[i].v-otherAxis.min)/(otherAxis.max-otherAxis.min);v=axis.min+v*(axis.max-axis.min);ticks.push(v)}return ticks};if(!axis.mode&&opts.tickDecimals==null){var extraDec=Math.max(0,-Math.floor(Math.log(axis.delta)/Math.LN10)+1),ts=axis.tickGenerator(axis);if(!(ts.length>1&&/\..*0$/.test((ts[1]-ts[0]).toFixed(extraDec))))axis.tickDecimals=extraDec}}}}function setTicks(axis){var oticks=axis.options.ticks,ticks=[];if(oticks==null||typeof oticks=="number"&&oticks>0)ticks=axis.tickGenerator(axis);else if(oticks){if($.isFunction(oticks))ticks=oticks(axis);else ticks=oticks}var i,v;axis.ticks=[];for(i=0;i<ticks.length;++i){var label=null;var t=ticks[i];if(typeof t=="object"){v=+t[0];if(t.length>1)label=t[1]}else v=+t;if(label==null)label=axis.tickFormatter(v,axis);if(!isNaN(v))axis.ticks.push({v:v,label:label})}}function snapRangeToTicks(axis,ticks){if(axis.options.autoscaleMargin&&ticks.length>0){if(axis.options.min==null)axis.min=Math.min(axis.min,ticks[0].v);if(axis.options.max==null&&ticks.length>1)axis.max=Math.max(axis.max,ticks[ticks.length-1].v)}}function draw(){surface.clear();executeHooks(hooks.drawBackground,[ctx]);var grid=options.grid;if(grid.show&&grid.backgroundColor)drawBackground();if(grid.show&&!grid.aboveData){drawGrid()}for(var i=0;i<series.length;++i){executeHooks(hooks.drawSeries,[ctx,series[i]]);drawSeries(series[i])}executeHooks(hooks.draw,[ctx]);if(grid.show&&grid.aboveData){drawGrid()}surface.render();triggerRedrawOverlay()}function extractRange(ranges,coord){var axis,from,to,key,axes=allAxes();for(var i=0;i<axes.length;++i){axis=axes[i];if(axis.direction==coord){key=coord+axis.n+"axis";if(!ranges[key]&&axis.n==1)key=coord+"axis";if(ranges[key]){from=ranges[key].from;to=ranges[key].to;break}}}if(!ranges[key]){axis=coord=="x"?xaxes[0]:yaxes[0];from=ranges[coord+"1"];to=ranges[coord+"2"]}if(from!=null&&to!=null&&from>to){var tmp=from;from=to;to=tmp}return{from:from,to:to,axis:axis}}function drawBackground(){ctx.save();ctx.translate(plotOffset.left,plotOffset.top);ctx.fillStyle=getColorOrGradient(options.grid.backgroundColor,plotHeight,0,"rgba(255, 255, 255, 0)");ctx.fillRect(0,0,plotWidth,plotHeight);ctx.restore()}function drawGrid(){var i,axes,bw,bc;ctx.save();ctx.translate(plotOffset.left,plotOffset.top);var markings=options.grid.markings;if(markings){if($.isFunction(markings)){axes=plot.getAxes();axes.xmin=axes.xaxis.min;axes.xmax=axes.xaxis.max;axes.ymin=axes.yaxis.min;axes.ymax=axes.yaxis.max;markings=markings(axes)}for(i=0;i<markings.length;++i){var m=markings[i],xrange=extractRange(m,"x"),yrange=extractRange(m,"y");if(xrange.from==null)xrange.from=xrange.axis.min;if(xrange.to==null)xrange.to=xrange.axis.max;

21+if(yrange.from==null)yrange.from=yrange.axis.min;if(yrange.to==null)yrange.to=yrange.axis.max;if(xrange.to<xrange.axis.min||xrange.from>xrange.axis.max||yrange.to<yrange.axis.min||yrange.from>yrange.axis.max)continue;xrange.from=Math.max(xrange.from,xrange.axis.min);xrange.to=Math.min(xrange.to,xrange.axis.max);yrange.from=Math.max(yrange.from,yrange.axis.min);yrange.to=Math.min(yrange.to,yrange.axis.max);var xequal=xrange.from===xrange.to,yequal=yrange.from===yrange.to;if(xequal&&yequal){continue}xrange.from=Math.floor(xrange.axis.p2c(xrange.from));xrange.to=Math.floor(xrange.axis.p2c(xrange.to));yrange.from=Math.floor(yrange.axis.p2c(yrange.from));yrange.to=Math.floor(yrange.axis.p2c(yrange.to));if(xequal||yequal){var lineWidth=m.lineWidth||options.grid.markingsLineWidth,subPixel=lineWidth%2?.5:0;ctx.beginPath();ctx.strokeStyle=m.color||options.grid.markingsColor;ctx.lineWidth=lineWidth;if(xequal){ctx.moveTo(xrange.to+subPixel,yrange.from);ctx.lineTo(xrange.to+subPixel,yrange.to)}else{ctx.moveTo(xrange.from,yrange.to+subPixel);ctx.lineTo(xrange.to,yrange.to+subPixel)}ctx.stroke()}else{ctx.fillStyle=m.color||options.grid.markingsColor;ctx.fillRect(xrange.from,yrange.to,xrange.to-xrange.from,yrange.from-yrange.to)}}}axes=allAxes();bw=options.grid.borderWidth;for(var j=0;j<axes.length;++j){var axis=axes[j],box=axis.box,t=axis.tickLength,x,y,xoff,yoff;if(!axis.show||axis.ticks.length==0)continue;ctx.lineWidth=1;if(axis.direction=="x"){x=0;if(t=="full")y=axis.position=="top"?0:plotHeight;else y=box.top-plotOffset.top+(axis.position=="top"?box.height:0)}else{y=0;if(t=="full")x=axis.position=="left"?0:plotWidth;else x=box.left-plotOffset.left+(axis.position=="left"?box.width:0)}if(!axis.innermost){ctx.strokeStyle=axis.options.color;ctx.beginPath();xoff=yoff=0;if(axis.direction=="x")xoff=plotWidth+1;else yoff=plotHeight+1;if(ctx.lineWidth==1){if(axis.direction=="x"){y=Math.floor(y)+.5}else{x=Math.floor(x)+.5}}ctx.moveTo(x,y);ctx.lineTo(x+xoff,y+yoff);ctx.stroke()}ctx.strokeStyle=axis.options.tickColor;ctx.beginPath();for(i=0;i<axis.ticks.length;++i){var v=axis.ticks[i].v;xoff=yoff=0;if(isNaN(v)||v<axis.min||v>axis.max||t=="full"&&(typeof bw=="object"&&bw[axis.position]>0||bw>0)&&(v==axis.min||v==axis.max))continue;if(axis.direction=="x"){x=axis.p2c(v);yoff=t=="full"?-plotHeight:t;if(axis.position=="top")yoff=-yoff}else{y=axis.p2c(v);xoff=t=="full"?-plotWidth:t;if(axis.position=="left")xoff=-xoff}if(ctx.lineWidth==1){if(axis.direction=="x")x=Math.floor(x)+.5;else y=Math.floor(y)+.5}ctx.moveTo(x,y);ctx.lineTo(x+xoff,y+yoff)}ctx.stroke()}if(bw){bc=options.grid.borderColor;if(typeof bw=="object"||typeof bc=="object"){if(typeof bw!=="object"){bw={top:bw,right:bw,bottom:bw,left:bw}}if(typeof bc!=="object"){bc={top:bc,right:bc,bottom:bc,left:bc}}if(bw.top>0){ctx.strokeStyle=bc.top;ctx.lineWidth=bw.top;ctx.beginPath();ctx.moveTo(0-bw.left,0-bw.top/2);ctx.lineTo(plotWidth,0-bw.top/2);ctx.stroke()}if(bw.right>0){ctx.strokeStyle=bc.right;ctx.lineWidth=bw.right;ctx.beginPath();ctx.moveTo(plotWidth+bw.right/2,0-bw.top);ctx.lineTo(plotWidth+bw.right/2,plotHeight);ctx.stroke()}if(bw.bottom>0){ctx.strokeStyle=bc.bottom;ctx.lineWidth=bw.bottom;ctx.beginPath();ctx.moveTo(plotWidth+bw.right,plotHeight+bw.bottom/2);ctx.lineTo(0,plotHeight+bw.bottom/2);ctx.stroke()}if(bw.left>0){ctx.strokeStyle=bc.left;ctx.lineWidth=bw.left;ctx.beginPath();ctx.moveTo(0-bw.left/2,plotHeight+bw.bottom);ctx.lineTo(0-bw.left/2,0);ctx.stroke()}}else{ctx.lineWidth=bw;ctx.strokeStyle=options.grid.borderColor;ctx.strokeRect(-bw/2,-bw/2,plotWidth+bw,plotHeight+bw)}}ctx.restore()}function drawAxisLabels(){$.each(allAxes(),function(_,axis){var box=axis.box,legacyStyles=axis.direction+"Axis "+axis.direction+axis.n+"Axis",layer="flot-"+axis.direction+"-axis flot-"+axis.direction+axis.n+"-axis "+legacyStyles,font=axis.options.font||"flot-tick-label tickLabel",tick,x,y,halign,valign;surface.removeText(layer);if(!axis.show||axis.ticks.length==0)return;for(var i=0;i<axis.ticks.length;++i){tick=axis.ticks[i];if(!tick.label||tick.v<axis.min||tick.v>axis.max)continue;if(axis.direction=="x"){halign="center";x=plotOffset.left+axis.p2c(tick.v);if(axis.position=="bottom"){y=box.top+box.padding}else{y=box.top+box.height-box.padding;valign="bottom"}}else{valign="middle";y=plotOffset.top+axis.p2c(tick.v);if(axis.position=="left"){x=box.left+box.width-box.padding;halign="right"}else{x=box.left+box.padding}}surface.addText(layer,x,y,tick.label,font,null,null,halign,valign)}})}function drawSeries(series){if(series.lines.show)drawSeriesLines(series);if(series.bars.show)drawSeriesBars(series);if(series.points.show)drawSeriesPoints(series)}function drawSeriesLines(series){function plotLine(datapoints,xoffset,yoffset,axisx,axisy){var points=datapoints.points,ps=datapoints.pointsize,prevx=null,prevy=null;ctx.beginPath();for(var i=ps;i<points.length;i+=ps){var x1=points[i-ps],y1=points[i-ps+1],x2=points[i],y2=points[i+1];if(x1==null||x2==null)continue;if(y1<=y2&&y1<axisy.min){if(y2<axisy.min)continue;x1=(axisy.min-y1)/(y2-y1)*(x2-x1)+x1;y1=axisy.min}else if(y2<=y1&&y2<axisy.min){if(y1<axisy.min)continue;x2=(axisy.min-y1)/(y2-y1)*(x2-x1)+x1;y2=axisy.min}if(y1>=y2&&y1>axisy.max){if(y2>axisy.max)continue;x1=(axisy.max-y1)/(y2-y1)*(x2-x1)+x1;y1=axisy.max}else if(y2>=y1&&y2>axisy.max){if(y1>axisy.max)continue;x2=(axisy.max-y1)/(y2-y1)*(x2-x1)+x1;y2=axisy.max}if(x1<=x2&&x1<axisx.min){if(x2<axisx.min)continue;y1=(axisx.min-x1)/(x2-x1)*(y2-y1)+y1;x1=axisx.min}else if(x2<=x1&&x2<axisx.min){if(x1<axisx.min)continue;y2=(axisx.min-x1)/(x2-x1)*(y2-y1)+y1;x2=axisx.min}if(x1>=x2&&x1>axisx.max){if(x2>axisx.max)continue;y1=(axisx.max-x1)/(x2-x1)*(y2-y1)+y1;x1=axisx.max}else if(x2>=x1&&x2>axisx.max){if(x1>axisx.max)continue;y2=(axisx.max-x1)/(x2-x1)*(y2-y1)+y1;x2=axisx.max}if(x1!=prevx||y1!=prevy)ctx.moveTo(axisx.p2c(x1)+xoffset,axisy.p2c(y1)+yoffset);prevx=x2;prevy=y2;ctx.lineTo(axisx.p2c(x2)+xoffset,axisy.p2c(y2)+yoffset)}ctx.stroke()}function plotLineArea(datapoints,axisx,axisy){var points=datapoints.points,ps=datapoints.pointsize,bottom=Math.min(Math.max(0,axisy.min),axisy.max),i=0,top,areaOpen=false,ypos=1,segmentStart=0,segmentEnd=0;while(true){if(ps>0&&i>points.length+ps)break;i+=ps;var x1=points[i-ps],y1=points[i-ps+ypos],x2=points[i],y2=points[i+ypos];if(areaOpen){if(ps>0&&x1!=null&&x2==null){segmentEnd=i;ps=-ps;ypos=2;continue}if(ps<0&&i==segmentStart+ps){ctx.fill();areaOpen=false;ps=-ps;ypos=1;i=segmentStart=segmentEnd+ps;continue}}if(x1==null||x2==null)continue;if(x1<=x2&&x1<axisx.min){if(x2<axisx.min)continue;y1=(axisx.min-x1)/(x2-x1)*(y2-y1)+y1;x1=axisx.min}else if(x2<=x1&&x2<axisx.min){if(x1<axisx.min)continue;y2=(axisx.min-x1)/(x2-x1)*(y2-y1)+y1;x2=axisx.min}if(x1>=x2&&x1>axisx.max){if(x2>axisx.max)continue;y1=(axisx.max-x1)/(x2-x1)*(y2-y1)+y1;x1=axisx.max}else if(x2>=x1&&x2>axisx.max){if(x1>axisx.max)continue;y2=(axisx.max-x1)/(x2-x1)*(y2-y1)+y1;x2=axisx.max}if(!areaOpen){ctx.beginPath();ctx.moveTo(axisx.p2c(x1),axisy.p2c(bottom));areaOpen=true}if(y1>=axisy.max&&y2>=axisy.max){ctx.lineTo(axisx.p2c(x1),axisy.p2c(axisy.max));ctx.lineTo(axisx.p2c(x2),axisy.p2c(axisy.max));continue}else if(y1<=axisy.min&&y2<=axisy.min){ctx.lineTo(axisx.p2c(x1),axisy.p2c(axisy.min));ctx.lineTo(axisx.p2c(x2),axisy.p2c(axisy.min));continue}var x1old=x1,x2old=x2;if(y1<=y2&&y1<axisy.min&&y2>=axisy.min){x1=(axisy.min-y1)/(y2-y1)*(x2-x1)+x1;y1=axisy.min}else if(y2<=y1&&y2<axisy.min&&y1>=axisy.min){x2=(axisy.min-y1)/(y2-y1)*(x2-x1)+x1;y2=axisy.min}if(y1>=y2&&y1>axisy.max&&y2<=axisy.max){x1=(axisy.max-y1)/(y2-y1)*(x2-x1)+x1;y1=axisy.max}else if(y2>=y1&&y2>axisy.max&&y1<=axisy.max){x2=(axisy.max-y1)/(y2-y1)*(x2-x1)+x1;y2=axisy.max}if(x1!=x1old){ctx.lineTo(axisx.p2c(x1old),axisy.p2c(y1))}ctx.lineTo(axisx.p2c(x1),axisy.p2c(y1));ctx.lineTo(axisx.p2c(x2),axisy.p2c(y2));if(x2!=x2old){ctx.lineTo(axisx.p2c(x2),axisy.p2c(y2));ctx.lineTo(axisx.p2c(x2old),axisy.p2c(y2))}}}ctx.save();ctx.translate(plotOffset.left,plotOffset.top);ctx.lineJoin="round";var lw=series.lines.lineWidth,sw=series.shadowSize;if(lw>0&&sw>0){ctx.lineWidth=sw;ctx.strokeStyle="rgba(0,0,0,0.1)";var angle=Math.PI/18;plotLine(series.datapoints,Math.sin(angle)*(lw/2+sw/2),Math.cos(angle)*(lw/2+sw/2),series.xaxis,series.yaxis);ctx.lineWidth=sw/2;plotLine(series.datapoints,Math.sin(angle)*(lw/2+sw/4),Math.cos(angle)*(lw/2+sw/4),series.xaxis,series.yaxis)}ctx.lineWidth=lw;ctx.strokeStyle=series.color;var fillStyle=getFillStyle(series.lines,series.color,0,plotHeight);if(fillStyle){ctx.fillStyle=fillStyle;plotLineArea(series.datapoints,series.xaxis,series.yaxis)}if(lw>0)plotLine(series.datapoints,0,0,series.xaxis,series.yaxis);ctx.restore()}function drawSeriesPoints(series){function plotPoints(datapoints,radius,fillStyle,offset,shadow,axisx,axisy,symbol){var points=datapoints.points,ps=datapoints.pointsize;for(var i=0;i<points.length;i+=ps){var x=points[i],y=points[i+1];if(x==null||x<axisx.min||x>axisx.max||y<axisy.min||y>axisy.max)continue;ctx.beginPath();x=axisx.p2c(x);y=axisy.p2c(y)+offset;if(symbol=="circle")ctx.arc(x,y,radius,0,shadow?Math.PI:Math.PI*2,false);else symbol(ctx,x,y,radius,shadow);ctx.closePath();if(fillStyle){ctx.fillStyle=fillStyle;ctx.fill()}ctx.stroke()}}ctx.save();ctx.translate(plotOffset.left,plotOffset.top);var lw=series.points.lineWidth,sw=series.shadowSize,radius=series.points.radius,symbol=series.points.symbol;if(lw==0)lw=1e-4;if(lw>0&&sw>0){var w=sw/2;ctx.lineWidth=w;ctx.strokeStyle="rgba(0,0,0,0.1)";plotPoints(series.datapoints,radius,null,w+w/2,true,series.xaxis,series.yaxis,symbol);ctx.strokeStyle="rgba(0,0,0,0.2)";plotPoints(series.datapoints,radius,null,w/2,true,series.xaxis,series.yaxis,symbol)}ctx.lineWidth=lw;ctx.strokeStyle=series.color;plotPoints(series.datapoints,radius,getFillStyle(series.points,series.color),0,false,series.xaxis,series.yaxis,symbol);ctx.restore()}function drawBar(x,y,b,barLeft,barRight,fillStyleCallback,axisx,axisy,c,horizontal,lineWidth){var left,right,bottom,top,drawLeft,drawRight,drawTop,drawBottom,tmp;if(horizontal){drawBottom=drawRight=drawTop=true;drawLeft=false;left=b;right=x;top=y+barLeft;bottom=y+barRight;if(right<left){tmp=right;right=left;left=tmp;drawLeft=true;drawRight=false}}else{drawLeft=drawRight=drawTop=true;drawBottom=false;left=x+barLeft;right=x+barRight;bottom=b;top=y;if(top<bottom){tmp=top;top=bottom;bottom=tmp;drawBottom=true;drawTop=false}}if(right<axisx.min||left>axisx.max||top<axisy.min||bottom>axisy.max)return;if(left<axisx.min){left=axisx.min;drawLeft=false}if(right>axisx.max){right=axisx.max;drawRight=false}if(bottom<axisy.min){bottom=axisy.min;drawBottom=false}if(top>axisy.max){top=axisy.max;drawTop=false}left=axisx.p2c(left);bottom=axisy.p2c(bottom);right=axisx.p2c(right);top=axisy.p2c(top);if(fillStyleCallback){c.fillStyle=fillStyleCallback(bottom,top);c.fillRect(left,top,right-left,bottom-top)}if(lineWidth>0&&(drawLeft||drawRight||drawTop||drawBottom)){c.beginPath();c.moveTo(left,bottom);if(drawLeft)c.lineTo(left,top);else c.moveTo(left,top);if(drawTop)c.lineTo(right,top);else c.moveTo(right,top);if(drawRight)c.lineTo(right,bottom);else c.moveTo(right,bottom);if(drawBottom)c.lineTo(left,bottom);else c.moveTo(left,bottom);c.stroke()}}function drawSeriesBars(series){function plotBars(datapoints,barLeft,barRight,fillStyleCallback,axisx,axisy){var points=datapoints.points,ps=datapoints.pointsize;for(var i=0;i<points.length;i+=ps){if(points[i]==null)continue;drawBar(points[i],points[i+1],points[i+2],barLeft,barRight,fillStyleCallback,axisx,axisy,ctx,series.bars.horizontal,series.bars.lineWidth)}}ctx.save();ctx.translate(plotOffset.left,plotOffset.top);ctx.lineWidth=series.bars.lineWidth;ctx.strokeStyle=series.color;var barLeft;switch(series.bars.align){case"left":barLeft=0;break;case"right":barLeft=-series.bars.barWidth;break;default:barLeft=-series.bars.barWidth/2}var fillStyleCallback=series.bars.fill?function(bottom,top){return getFillStyle(series.bars,series.color,bottom,top)}:null;plotBars(series.datapoints,barLeft,barLeft+series.bars.barWidth,fillStyleCallback,series.xaxis,series.yaxis);ctx.restore()}function getFillStyle(filloptions,seriesColor,bottom,top){var fill=filloptions.fill;if(!fill)return null;if(filloptions.fillColor)return getColorOrGradient(filloptions.fillColor,bottom,top,seriesColor);var c=$.color.parse(seriesColor);c.a=typeof fill=="number"?fill:.4;c.normalize();return c.toString()}function insertLegend(){if(options.legend.container!=null){$(options.legend.container).html("")}else{placeholder.find(".legend").remove()}if(!options.legend.show){return}var fragments=[],entries=[],rowStarted=false,lf=options.legend.labelFormatter,s,label;for(var i=0;i<series.length;++i){s=series[i];if(s.label){label=lf?lf(s.label,s):s.label;if(label){entries.push({label:label,color:s.color})}}}if(options.legend.sorted){if($.isFunction(options.legend.sorted)){entries.sort(options.legend.sorted)}else if(options.legend.sorted=="reverse"){entries.reverse()}else{var ascending=options.legend.sorted!="descending";entries.sort(function(a,b){return a.label==b.label?0:a.label<b.label!=ascending?1:-1})}}for(var i=0;i<entries.length;++i){var entry=entries[i];if(i%options.legend.noColumns==0){if(rowStarted)fragments.push("</tr>");fragments.push("<tr>");rowStarted=true}fragments.push('<td class="legendColorBox"><div style="border:1px solid '+options.legend.labelBoxBorderColor+';padding:1px"><div style="width:4px;height:0;border:5px solid '+entry.color+';overflow:hidden"></div></div></td>'+'<td class="legendLabel">'+entry.label+"</td>")}if(rowStarted)fragments.push("</tr>");if(fragments.length==0)return;var table='<table style="font-size:smaller;color:'+options.grid.color+'">'+fragments.join("")+"</table>";if(options.legend.container!=null)$(options.legend.container).html(table);else{var pos="",p=options.legend.position,m=options.legend.margin;if(m[0]==null)m=[m,m];if(p.charAt(0)=="n")pos+="top:"+(m[1]+plotOffset.top)+"px;";else if(p.charAt(0)=="s")pos+="bottom:"+(m[1]+plotOffset.bottom)+"px;";if(p.charAt(1)=="e")pos+="right:"+(m[0]+plotOffset.right)+"px;";else if(p.charAt(1)=="w")pos+="left:"+(m[0]+plotOffset.left)+"px;";var legend=$('<div class="legend">'+table.replace('style="','style="position:absolute;'+pos+";")+"</div>").appendTo(placeholder);if(options.legend.backgroundOpacity!=0){var c=options.legend.backgroundColor;if(c==null){c=options.grid.backgroundColor;if(c&&typeof c=="string")c=$.color.parse(c);else c=$.color.extract(legend,"background-color");c.a=1;c=c.toString()}var div=legend.children();$('<div style="position:absolute;width:'+div.width()+"px;height:"+div.height()+"px;"+pos+"background-color:"+c+';"> </div>').prependTo(legend).css("opacity",options.legend.backgroundOpacity)}}}var highlights=[],redrawTimeout=null;function findNearbyItem(mouseX,mouseY,seriesFilter){var maxDistance=options.grid.mouseActiveRadius,smallestDistance=maxDistance*maxDistance+1,item=null,foundPoint=false,i,j,ps;for(i=series.length-1;i>=0;--i){if(!seriesFilter(series[i]))continue;var s=series[i],axisx=s.xaxis,axisy=s.yaxis,points=s.datapoints.points,mx=axisx.c2p(mouseX),my=axisy.c2p(mouseY),maxx=maxDistance/axisx.scale,maxy=maxDistance/axisy.scale;ps=s.datapoints.pointsize;if(axisx.options.inverseTransform)maxx=Number.MAX_VALUE;if(axisy.options.inverseTransform)maxy=Number.MAX_VALUE;if(s.lines.show||s.points.show){for(j=0;j<points.length;j+=ps){var x=points[j],y=points[j+1];if(x==null)continue;if(x-mx>maxx||x-mx<-maxx||y-my>maxy||y-my<-maxy)continue;var dx=Math.abs(axisx.p2c(x)-mouseX),dy=Math.abs(axisy.p2c(y)-mouseY),dist=dx*dx+dy*dy;if(dist<smallestDistance){smallestDistance=dist;item=[i,j/ps]}}}if(s.bars.show&&!item){var barLeft,barRight;switch(s.bars.align){case"left":barLeft=0;break;case"right":barLeft=-s.bars.barWidth;break;default:barLeft=-s.bars.barWidth/2}barRight=barLeft+s.bars.barWidth;for(j=0;j<points.length;j+=ps){var x=points[j],y=points[j+1],b=points[j+2];if(x==null)continue;if(series[i].bars.horizontal?mx<=Math.max(b,x)&&mx>=Math.min(b,x)&&my>=y+barLeft&&my<=y+barRight:mx>=x+barLeft&&mx<=x+barRight&&my>=Math.min(b,y)&&my<=Math.max(b,y))item=[i,j/ps]}}}if(item){i=item[0];j=item[1];ps=series[i].datapoints.pointsize;return{datapoint:series[i].datapoints.points.slice(j*ps,(j+1)*ps),dataIndex:j,series:series[i],seriesIndex:i}}return null}function onMouseMove(e){if(options.grid.hoverable)triggerClickHoverEvent("plothover",e,function(s){return s["hoverable"]!=false})}function onMouseLeave(e){if(options.grid.hoverable)triggerClickHoverEvent("plothover",e,function(s){return false})}function onClick(e){triggerClickHoverEvent("plotclick",e,function(s){return s["clickable"]!=false})}function triggerClickHoverEvent(eventname,event,seriesFilter){var offset=eventHolder.offset(),canvasX=event.pageX-offset.left-plotOffset.left,canvasY=event.pageY-offset.top-plotOffset.top,pos=canvasToAxisCoords({left:canvasX,top:canvasY});pos.pageX=event.pageX;pos.pageY=event.pageY;var item=findNearbyItem(canvasX,canvasY,seriesFilter);if(item){item.pageX=parseInt(item.series.xaxis.p2c(item.datapoint[0])+offset.left+plotOffset.left,10);item.pageY=parseInt(item.series.yaxis.p2c(item.datapoint[1])+offset.top+plotOffset.top,10)}if(options.grid.autoHighlight){for(var i=0;i<highlights.length;++i){var h=highlights[i];if(h.auto==eventname&&!(item&&h.series==item.series&&h.point[0]==item.datapoint[0]&&h.point[1]==item.datapoint[1]))unhighlight(h.series,h.point)}if(item)highlight(item.series,item.datapoint,eventname)}placeholder.trigger(eventname,[pos,item])}function triggerRedrawOverlay(){var t=options.interaction.redrawOverlayInterval;if(t==-1){drawOverlay();return}if(!redrawTimeout)redrawTimeout=setTimeout(drawOverlay,t)}function drawOverlay(){redrawTimeout=null;octx.save();overlay.clear();octx.translate(plotOffset.left,plotOffset.top);var i,hi;for(i=0;i<highlights.length;++i){hi=highlights[i];if(hi.series.bars.show)drawBarHighlight(hi.series,hi.point);else drawPointHighlight(hi.series,hi.point)}octx.restore();executeHooks(hooks.drawOverlay,[octx])}function highlight(s,point,auto){if(typeof s=="number")s=series[s];if(typeof point=="number"){var ps=s.datapoints.pointsize;point=s.datapoints.points.slice(ps*point,ps*(point+1))}var i=indexOfHighlight(s,point);if(i==-1){highlights.push({series:s,point:point,auto:auto});triggerRedrawOverlay()}else if(!auto)highlights[i].auto=false}function unhighlight(s,point){if(s==null&&point==null){highlights=[];triggerRedrawOverlay();return}if(typeof s=="number")s=series[s];if(typeof point=="number"){var ps=s.datapoints.pointsize;point=s.datapoints.points.slice(ps*point,ps*(point+1))}var i=indexOfHighlight(s,point);if(i!=-1){highlights.splice(i,1);triggerRedrawOverlay()}}function indexOfHighlight(s,p){for(var i=0;i<highlights.length;++i){var h=highlights[i];if(h.series==s&&h.point[0]==p[0]&&h.point[1]==p[1])return i}return-1}function drawPointHighlight(series,point){var x=point[0],y=point[1],axisx=series.xaxis,axisy=series.yaxis,highlightColor=typeof series.highlightColor==="string"?series.highlightColor:$.color.parse(series.color).scale("a",.5).toString();if(x<axisx.min||x>axisx.max||y<axisy.min||y>axisy.max)return;var pointRadius=series.points.radius+series.points.lineWidth/2;octx.lineWidth=pointRadius;octx.strokeStyle=highlightColor;var radius=1.5*pointRadius;x=axisx.p2c(x);y=axisy.p2c(y);octx.beginPath();if(series.points.symbol=="circle")octx.arc(x,y,radius,0,2*Math.PI,false);else series.points.symbol(octx,x,y,radius,false);octx.closePath();octx.stroke()}function drawBarHighlight(series,point){var highlightColor=typeof series.highlightColor==="string"?series.highlightColor:$.color.parse(series.color).scale("a",.5).toString(),fillStyle=highlightColor,barLeft;switch(series.bars.align){case"left":barLeft=0;break;case"right":barLeft=-series.bars.barWidth;break;default:barLeft=-series.bars.barWidth/2}octx.lineWidth=series.bars.lineWidth;octx.strokeStyle=highlightColor;drawBar(point[0],point[1],point[2]||0,barLeft,barLeft+series.bars.barWidth,function(){return fillStyle},series.xaxis,series.yaxis,octx,series.bars.horizontal,series.bars.lineWidth)}function getColorOrGradient(spec,bottom,top,defaultColor){if(typeof spec=="string")return spec;else{var gradient=ctx.createLinearGradient(0,top,0,bottom);for(var i=0,l=spec.colors.length;i<l;++i){var c=spec.colors[i];if(typeof c!="string"){var co=$.color.parse(defaultColor);if(c.brightness!=null)co=co.scale("rgb",c.brightness);if(c.opacity!=null)co.a*=c.opacity;c=co.toString()}gradient.addColorStop(i/(l-1),c)}return gradient}}}$.plot=function(placeholder,data,options){var plot=new Plot($(placeholder),data,options,$.plot.plugins);return plot};$.plot.version="0.8.3";$.plot.plugins=[];$.fn.plot=function(data,options){return this.each(function(){$.plot(this,data,options)})};function floorInBase(n,base){return base*Math.floor(n/base)}})(jQuery);

22+ </script>

23+ <script language="javascript" type="text/javascript">

24+ /* Javascript plotting library for jQuery, version 0.8.3.

25+

27+Licensed under the MIT license.

28+

29+*/

30+(function($){var options={series:{points:{errorbars:null,xerr:{err:"x",show:null,asymmetric:null,upperCap:null,lowerCap:null,color:null,radius:null},yerr:{err:"y",show:null,asymmetric:null,upperCap:null,lowerCap:null,color:null,radius:null}}}};function processRawData(plot,series,data,datapoints){if(!series.points.errorbars)return;var format=[{x:true,number:true,required:true},{y:true,number:true,required:true}];var errors=series.points.errorbars;if(errors=="x"||errors=="xy"){if(series.points.xerr.asymmetric){format.push({x:true,number:true,required:true});format.push({x:true,number:true,required:true})}else format.push({x:true,number:true,required:true})}if(errors=="y"||errors=="xy"){if(series.points.yerr.asymmetric){format.push({y:true,number:true,required:true});format.push({y:true,number:true,required:true})}else format.push({y:true,number:true,required:true})}datapoints.format=format}function parseErrors(series,i){var points=series.datapoints.points;var exl=null,exu=null,eyl=null,eyu=null;var xerr=series.points.xerr,yerr=series.points.yerr;var eb=series.points.errorbars;if(eb=="x"||eb=="xy"){if(xerr.asymmetric){exl=points[i+2];exu=points[i+3];if(eb=="xy")if(yerr.asymmetric){eyl=points[i+4];eyu=points[i+5]}else eyl=points[i+4]}else{exl=points[i+2];if(eb=="xy")if(yerr.asymmetric){eyl=points[i+3];eyu=points[i+4]}else eyl=points[i+3]}}else if(eb=="y")if(yerr.asymmetric){eyl=points[i+2];eyu=points[i+3]}else eyl=points[i+2];if(exu==null)exu=exl;if(eyu==null)eyu=eyl;var errRanges=[exl,exu,eyl,eyu];if(!xerr.show){errRanges[0]=null;errRanges[1]=null}if(!yerr.show){errRanges[2]=null;errRanges[3]=null}return errRanges}function drawSeriesErrors(plot,ctx,s){var points=s.datapoints.points,ps=s.datapoints.pointsize,ax=[s.xaxis,s.yaxis],radius=s.points.radius,err=[s.points.xerr,s.points.yerr];var invertX=false;if(ax[0].p2c(ax[0].max)<ax[0].p2c(ax[0].min)){invertX=true;var tmp=err[0].lowerCap;err[0].lowerCap=err[0].upperCap;err[0].upperCap=tmp}var invertY=false;if(ax[1].p2c(ax[1].min)<ax[1].p2c(ax[1].max)){invertY=true;var tmp=err[1].lowerCap;err[1].lowerCap=err[1].upperCap;err[1].upperCap=tmp}for(var i=0;i<s.datapoints.points.length;i+=ps){var errRanges=parseErrors(s,i);for(var e=0;e<err.length;e++){var minmax=[ax[e].min,ax[e].max];if(errRanges[e*err.length]){var x=points[i],y=points[i+1];var upper=[x,y][e]+errRanges[e*err.length+1],lower=[x,y][e]-errRanges[e*err.length];if(err[e].err=="x")if(y>ax[1].max||y<ax[1].min||upper<ax[0].min||lower>ax[0].max)continue;if(err[e].err=="y")if(x>ax[0].max||x<ax[0].min||upper<ax[1].min||lower>ax[1].max)continue;var drawUpper=true,drawLower=true;if(upper>minmax[1]){drawUpper=false;upper=minmax[1]}if(lower<minmax[0]){drawLower=false;lower=minmax[0]}if(err[e].err=="x"&&invertX||err[e].err=="y"&&invertY){var tmp=lower;lower=upper;upper=tmp;tmp=drawLower;drawLower=drawUpper;drawUpper=tmp;tmp=minmax[0];minmax[0]=minmax[1];minmax[1]=tmp}x=ax[0].p2c(x),y=ax[1].p2c(y),upper=ax[e].p2c(upper);lower=ax[e].p2c(lower);minmax[0]=ax[e].p2c(minmax[0]);minmax[1]=ax[e].p2c(minmax[1]);var lw=err[e].lineWidth?err[e].lineWidth:s.points.lineWidth,sw=s.points.shadowSize!=null?s.points.shadowSize:s.shadowSize;if(lw>0&&sw>0){var w=sw/2;ctx.lineWidth=w;ctx.strokeStyle="rgba(0,0,0,0.1)";drawError(ctx,err[e],x,y,upper,lower,drawUpper,drawLower,radius,w+w/2,minmax);ctx.strokeStyle="rgba(0,0,0,0.2)";drawError(ctx,err[e],x,y,upper,lower,drawUpper,drawLower,radius,w/2,minmax)}ctx.strokeStyle=err[e].color?err[e].color:s.color;ctx.lineWidth=lw;drawError(ctx,err[e],x,y,upper,lower,drawUpper,drawLower,radius,0,minmax)}}}}function drawError(ctx,err,x,y,upper,lower,drawUpper,drawLower,radius,offset,minmax){y+=offset;upper+=offset;lower+=offset;if(err.err=="x"){if(upper>x+radius)drawPath(ctx,[[upper,y],[Math.max(x+radius,minmax[0]),y]]);else drawUpper=false;if(lower<x-radius)drawPath(ctx,[[Math.min(x-radius,minmax[1]),y],[lower,y]]);else drawLower=false}else{if(upper<y-radius)drawPath(ctx,[[x,upper],[x,Math.min(y-radius,minmax[0])]]);else drawUpper=false;if(lower>y+radius)drawPath(ctx,[[x,Math.max(y+radius,minmax[1])],[x,lower]]);else drawLower=false}radius=err.radius!=null?err.radius:radius;if(drawUpper){if(err.upperCap=="-"){if(err.err=="x")drawPath(ctx,[[upper,y-radius],[upper,y+radius]]);else drawPath(ctx,[[x-radius,upper],[x+radius,upper]])}else if($.isFunction(err.upperCap)){if(err.err=="x")err.upperCap(ctx,upper,y,radius);else err.upperCap(ctx,x,upper,radius)}}if(drawLower){if(err.lowerCap=="-"){if(err.err=="x")drawPath(ctx,[[lower,y-radius],[lower,y+radius]]);else drawPath(ctx,[[x-radius,lower],[x+radius,lower]])}else if($.isFunction(err.lowerCap)){if(err.err=="x")err.lowerCap(ctx,lower,y,radius);else err.lowerCap(ctx,x,lower,radius)}}}function drawPath(ctx,pts){ctx.beginPath();ctx.moveTo(pts[0][0],pts[0][1]);for(var p=1;p<pts.length;p++)ctx.lineTo(pts[p][0],pts[p][1]);ctx.stroke()}function draw(plot,ctx){var plotOffset=plot.getPlotOffset();ctx.save();ctx.translate(plotOffset.left,plotOffset.top);$.each(plot.getData(),function(i,s){if(s.points.errorbars&&(s.points.xerr.show||s.points.yerr.show))drawSeriesErrors(plot,ctx,s)});ctx.restore()}function init(plot){plot.hooks.processRawData.push(processRawData);plot.hooks.draw.push(draw)}$.plot.plugins.push({init:init,options:options,name:"errorbars",version:"1.0"})})(jQuery);

31+ </script>

32+ <script language="javascript" type="text/javascript">

33+ /* Javascript plotting library for jQuery, version 0.8.3.

34+

36+Licensed under the MIT license.

37+

38+*/

39+(function(a){function e(h){var k,j=this,l=h.data||{};if(l.elem)j=h.dragTarget=l.elem,h.dragProxy=d.proxy||j,h.cursorOffsetX=l.pageX-l.left,h.cursorOffsetY=l.pageY-l.top,h.offsetX=h.pageX-h.cursorOffsetX,h.offsetY=h.pageY-h.cursorOffsetY;else if(d.dragging||l.which>0&&h.which!=l.which||a(h.target).is(l.not))return;switch(h.type){case"mousedown":return a.extend(l,a(j).offset(),{elem:j,target:h.target,pageX:h.pageX,pageY:h.pageY}),b.add(document,"mousemove mouseup",e,l),i(j,!1),d.dragging=null,!1;case!d.dragging&&"mousemove":if(g(h.pageX-l.pageX)+g(h.pageY-l.pageY)<l.distance)break;h.target=l.target,k=f(h,"dragstart",j),k!==!1&&(d.dragging=j,d.proxy=h.dragProxy=a(k||j)[0]);case"mousemove":if(d.dragging){if(k=f(h,"drag",j),c.drop&&(c.drop.allowed=k!==!1,c.drop.handler(h)),k!==!1)break;h.type="mouseup"}case"mouseup":b.remove(document,"mousemove mouseup",e),d.dragging&&(c.drop&&c.drop.handler(h),f(h,"dragend",j)),i(j,!0),d.dragging=d.proxy=l.elem=!1}return!0}function f(b,c,d){b.type=c;var e=a.event.dispatch.call(d,b);return e===!1?!1:e||b.result}function g(a){return Math.pow(a,2)}function h(){return d.dragging===!1}function i(a,b){a&&(a.unselectable=b?"off":"on",a.onselectstart=function(){return b},a.style&&(a.style.MozUserSelect=b?"":"none"))}a.fn.drag=function(a,b,c){return b&&this.bind("dragstart",a),c&&this.bind("dragend",c),a?this.bind("drag",b?b:a):this.trigger("drag")};var b=a.event,c=b.special,d=c.drag={not:":input",distance:0,which:1,dragging:!1,setup:function(c){c=a.extend({distance:d.distance,which:d.which,not:d.not},c||{}),c.distance=g(c.distance),b.add(this,"mousedown",e,c),this.attachEvent&&this.attachEvent("ondragstart",h)},teardown:function(){b.remove(this,"mousedown",e),this===d.dragging&&(d.dragging=d.proxy=!1),i(this,!0),this.detachEvent&&this.detachEvent("ondragstart",h)}};c.dragstart=c.dragend={setup:function(){},teardown:function(){}}})(jQuery);(function(d){function e(a){var b=a||window.event,c=[].slice.call(arguments,1),f=0,e=0,g=0,a=d.event.fix(b);a.type="mousewheel";b.wheelDelta&&(f=b.wheelDelta/120);b.detail&&(f=-b.detail/3);g=f;void 0!==b.axis&&b.axis===b.HORIZONTAL_AXIS&&(g=0,e=-1*f);void 0!==b.wheelDeltaY&&(g=b.wheelDeltaY/120);void 0!==b.wheelDeltaX&&(e=-1*b.wheelDeltaX/120);c.unshift(a,f,e,g);return(d.event.dispatch||d.event.handle).apply(this,c)}var c=["DOMMouseScroll","mousewheel"];if(d.event.fixHooks)for(var h=c.length;h;)d.event.fixHooks[c[--h]]=d.event.mouseHooks;d.event.special.mousewheel={setup:function(){if(this.addEventListener)for(var a=c.length;a;)this.addEventListener(c[--a],e,!1);else this.onmousewheel=e},teardown:function(){if(this.removeEventListener)for(var a=c.length;a;)this.removeEventListener(c[--a],e,!1);else this.onmousewheel=null}};d.fn.extend({mousewheel:function(a){return a?this.bind("mousewheel",a):this.trigger("mousewheel")},unmousewheel:function(a){return this.unbind("mousewheel",a)}})})(jQuery);(function($){var options={xaxis:{zoomRange:null,panRange:null},zoom:{interactive:false,trigger:"dblclick",amount:1.5},pan:{interactive:false,cursor:"move",frameRate:20}};function init(plot){function onZoomClick(e,zoomOut){var c=plot.offset();c.left=e.pageX-c.left;c.top=e.pageY-c.top;if(zoomOut)plot.zoomOut({center:c});else plot.zoom({center:c})}function onMouseWheel(e,delta){e.preventDefault();onZoomClick(e,delta<0);return false}var prevCursor="default",prevPageX=0,prevPageY=0,panTimeout=null;function onDragStart(e){if(e.which!=1)return false;var c=plot.getPlaceholder().css("cursor");if(c)prevCursor=c;plot.getPlaceholder().css("cursor",plot.getOptions().pan.cursor);prevPageX=e.pageX;prevPageY=e.pageY}function onDrag(e){var frameRate=plot.getOptions().pan.frameRate;if(panTimeout||!frameRate)return;panTimeout=setTimeout(function(){plot.pan({left:prevPageX-e.pageX,top:prevPageY-e.pageY});prevPageX=e.pageX;prevPageY=e.pageY;panTimeout=null},1/frameRate*1e3)}function onDragEnd(e){if(panTimeout){clearTimeout(panTimeout);panTimeout=null}plot.getPlaceholder().css("cursor",prevCursor);plot.pan({left:prevPageX-e.pageX,top:prevPageY-e.pageY})}function bindEvents(plot,eventHolder){var o=plot.getOptions();if(o.zoom.interactive){eventHolder[o.zoom.trigger](onZoomClick);eventHolder.mousewheel(onMouseWheel)}if(o.pan.interactive){eventHolder.bind("dragstart",{distance:10},onDragStart);eventHolder.bind("drag",onDrag);eventHolder.bind("dragend",onDragEnd)}}plot.zoomOut=function(args){if(!args)args={};if(!args.amount)args.amount=plot.getOptions().zoom.amount;args.amount=1/args.amount;plot.zoom(args)};plot.zoom=function(args){if(!args)args={};var c=args.center,amount=args.amount||plot.getOptions().zoom.amount,w=plot.width(),h=plot.height();if(!c)c={left:w/2,top:h/2};var xf=c.left/w,yf=c.top/h,minmax={x:{min:c.left-xf*w/amount,max:c.left+(1-xf)*w/amount},y:{min:c.top-yf*h/amount,max:c.top+(1-yf)*h/amount}};$.each(plot.getAxes(),function(_,axis){var opts=axis.options,min=minmax[axis.direction].min,max=minmax[axis.direction].max,zr=opts.zoomRange,pr=opts.panRange;if(zr===false)return;min=axis.c2p(min);max=axis.c2p(max);if(min>max){var tmp=min;min=max;max=tmp}if(pr){if(pr[0]!=null&&min<pr[0]){min=pr[0]}if(pr[1]!=null&&max>pr[1]){max=pr[1]}}var range=max-min;if(zr&&(zr[0]!=null&&range<zr[0]&&amount>1||zr[1]!=null&&range>zr[1]&&amount<1))return;opts.min=min;opts.max=max});plot.setupGrid();plot.draw();if(!args.preventEvent)plot.getPlaceholder().trigger("plotzoom",[plot,args])};plot.pan=function(args){var delta={x:+args.left,y:+args.top};if(isNaN(delta.x))delta.x=0;if(isNaN(delta.y))delta.y=0;$.each(plot.getAxes(),function(_,axis){var opts=axis.options,min,max,d=delta[axis.direction];min=axis.c2p(axis.p2c(axis.min)+d),max=axis.c2p(axis.p2c(axis.max)+d);var pr=opts.panRange;if(pr===false)return;if(pr){if(pr[0]!=null&&pr[0]>min){d=pr[0]-min;min+=d;max+=d}if(pr[1]!=null&&pr[1]<max){d=pr[1]-max;min+=d;max+=d}}opts.min=min;opts.max=max});plot.setupGrid();plot.draw();if(!args.preventEvent)plot.getPlaceholder().trigger("plotpan",[plot,args])};function shutdown(plot,eventHolder){eventHolder.unbind(plot.getOptions().zoom.trigger,onZoomClick);eventHolder.unbind("mousewheel",onMouseWheel);eventHolder.unbind("dragstart",onDragStart);eventHolder.unbind("drag",onDrag);eventHolder.unbind("dragend",onDragEnd);if(panTimeout)clearTimeout(panTimeout)}plot.hooks.bindEvents.push(bindEvents);plot.hooks.shutdown.push(shutdown)}$.plot.plugins.push({init:init,options:options,name:"navigate",version:"1.3"})})(jQuery);

40+ </script>

41+ <script language="javascript" type="text/javascript">

42+ (function ($) {

43+ $.zip = function(a,b) {

44+ var x = Math.min(a.length,b.length);

45+ var c = new Array(x);

46+ for (var i = 0; i < x; i++)

47+ c[i] = [a[i],b[i]];

48+ return c;

49+ };

50+

51+ $.mean = function(ary) {

52+ var m = 0, i = 0;

53+

54+ while (i < ary.length) {

55+ var j = i++;

56+ m += (ary[j] - m) / i;

57+ }

58+

59+ return m;

60+ };

61+

62+ $.timeUnits = function(secs) {

63+ if (secs < 0) return $.timeUnits(-secs);

64+ else if (secs >= 1e9) return [1e-9, "Gs"];

65+ else if (secs >= 1e6) return [1e-6, "Ms"];

66+ else if (secs >= 1) return [1, "s"];

67+ else if (secs >= 1e-3) return [1e3, "ms"];

68+ else if (secs >= 1e-6) return [1e6, "\u03bcs"];

69+ else if (secs >= 1e-9) return [1e9, "ns"];

70+ else if (secs >= 1e-12) return [1e12, "ps"];

71+ return [1, "s"];

72+ };

73+

74+ $.scaleTimes = function(ary) {

75+ var s = $.timeUnits($.mean(ary));

76+ return [$.scaleBy(s[0], ary), s[0]];

77+ };

78+

79+ $.prepareTime = function(secs) {

80+ var units = $.timeUnits(secs);

81+ var scaled = secs * units[0];

82+ var s = scaled.toPrecision(3);

83+ var t = scaled.toString();

84+ return [t.length < s.length ? t : s, units[1]];

85+ };

86+

87+ $.scaleBy = function(x, ary) {

88+ var nary = new Array(ary.length);

89+ for (var i = 0; i < ary.length; i++)

90+ nary[i] = ary[i] * x;

91+ return nary;

92+ };

93+

94+ $.renderTime = function(secs) {

95+ var x = $.prepareTime(secs);

96+ return x[0] + ' ' + x[1];

97+ };

98+

99+ $.unitFormatter = function(scale) {

100+ var labelname;

101+ return function(secs,axis) {

102+ var x = $.prepareTime(secs / scale);

103+ if (labelname === x[1])

104+ return x[0];

105+ else {

106+ labelname = x[1];

107+ return x[0] + ' ' + x[1];

108+ }

109+ };

110+ };

111+

112+ $.addTooltip = function(name, renderText) {

113+ function showTooltip(x, y, contents) {

114+ $('<div id="tooltip">' + contents + '</div>').css( {

115+ position: 'absolute',

116+ display: 'none',

117+ top: y + 5,

118+ left: x + 5,

119+ border: '1px solid #fdd',

120+ padding: '2px',

121+ 'background-color': '#fee',

122+ opacity: 0.80

123+ }).appendTo("body").fadeIn(200);

124+ };

125+ var pp = null;

126+ $(name).bind("plothover", function (event, pos, item) {

127+ $("#x").text(pos.x.toFixed(2));

128+ $("#y").text(pos.y.toFixed(2));

129+

130+ if (item) {

131+ if (pp != item.dataIndex) {

132+ pp = item.dataIndex;

133+

134+ $("#tooltip").remove();

135+ var x = item.datapoint[0],

136+ y = item.datapoint[1];

137+

138+ showTooltip(item.pageX, item.pageY, renderText(x,y));

139+ }

140+ }

141+ else {

142+ $("#tooltip").remove();

143+ pp = null;

144+ }

145+ });

146+ };

147+})(jQuery);

148+

149+ </script>

150+ <style type="text/css">

151+ html, body {

152+ height: 100%;

153+ margin: 0;

154+}

155+

156+#wrap {

157+ min-height: 100%;

158+}

159+

160+#main {

161+ overflow: auto;

162+ padding-bottom: 180px; /* must be same height as the footer */

163+}

164+

165+#footer {

166+ position: relative;

167+ margin-top: -180px; /* negative value of footer height */

168+ height: 180px;

169+ clear: both;

170+ background: #888;

171+ margin: 40px 0 0;

172+ color: white;

173+ font-size: larger;

174+ font-weight: 300;

175+}

176+

177+body:before {

178+ /* Opera fix */

179+ content: "";

180+ height: 100%;

181+ float: left;

182+ width: 0;

183+ margin-top: -32767px;

184+}

185+

186+body {

187+ font: 14px Helvetica Neue;

188+ text-rendering: optimizeLegibility;

189+ margin-top: 1em;

190+}

191+

192+a:link {

193+ color: steelblue;

194+ text-decoration: none;

195+}

196+

197+a:visited {

198+ color: #4a743b;

199+ text-decoration: none;

200+}

201+

202+#footer a {

203+ color: white;

204+ text-decoration: underline;

205+}

206+

207+.hover {

208+ color: steelblue;

209+ text-decoration: none;

210+}

211+

212+.body {

213+ width: 960px;

214+ margin: auto;

215+}

216+

217+.footfirst {

218+ position: relative;

219+ top: 30px;

220+}

221+

222+th {

223+ font-weight: 500;

224+ opacity: 0.8;

225+}

226+

227+th.cibound {

228+ opacity: 0.4;

229+}

230+

231+.confinterval {

232+ opacity: 0.5;

233+}

234+

235+h1 {

236+ font-size: 36px;

237+ font-weight: 300;

238+ margin-bottom: .3em;

239+}

240+

241+h2 {

242+ font-size: 30px;

243+ font-weight: 300;

244+ margin-bottom: .3em;

245+}

246+

247+.meanlegend {

248+ color: #404040;

249+ background-color: #ffffff;

250+ opacity: 0.6;

251+ font-size: smaller;

252+}

253+

254+ </style>

255+ <!--[if !IE 7]>

256+ <style type="text/css">

257+ #wrap {display:table;height:100%}

258+ </style>

259+ <![endif]-->

260+ </head>

261+ <body>

262+ <div id="wrap">

263+ <div id="main" class="body">

264+ <h1>criterion performance measurements</h1>

265+

266+<h2>overview</h2>

267+

268+<p><a href="#grokularation">want to understand this report?</a></p>

269+

270+<p>Environment: AMD Opteron 6168 on Ubuntu 12.04 with GHC 8.0.2</p>

271+

272+<div id="overview" class="ovchart" style="width:900px;height:100px;"></div>

273+

274+<h2><a name="b0">create/relation 10x100</a></h2>

275+ <table width="100%">

276+ <tbody>

277+ <tr>

278+ <td><div id="kde0" class="kdechart"

279+ style="width:450px;height:278px;"></div></td>

280+ <td><div id="time0" class="timechart"

281+ style="width:450px;height:278px;"></div></td>

282+<!--

283+ <td><div id="cycle0" class="cyclechart"

284+ style="width:300px;height:278px;"></div></td>

285+-->

286+ </tr>

287+ </tbody>

288+ </table>

289+

290+ <table>

291+ <thead class="analysis">

292+ <th></th>

293+ <th class="cibound"

294+ title="0.95 confidence level">lower bound</th>

295+ <th>estimate</th>

296+ <th class="cibound"

297+ title="0.95 confidence level">upper bound</th>

298+ </thead>

299+ <tbody>

300+ <tr>

301+ <td>OLS regression</td>

302+ <td><span class="confinterval olstimelb0">xxx</span></td>

303+ <td><span class="olstimept0">xxx</span></td>

304+ <td><span class="confinterval olstimeub0">xxx</span></td>

305+ </tr>

306+ <tr>

307+ <td>R² goodness-of-fit</td>

308+ <td><span class="confinterval olsr2lb0">xxx</span></td>

309+ <td><span class="olsr2pt0">xxx</span></td>

310+ <td><span class="confinterval olsr2ub0">xxx</span></td>

311+ </tr>

312+ <tr>

313+ <td>Mean execution time</td>

314+ <td><span class="confinterval citime">5.891481267739451e-4</span></td>

315+ <td><span class="time">5.906283388143756e-4</span></td>

316+ <td><span class="confinterval citime">5.919056866982677e-4</span></td>

317+ </tr>

318+ <tr>

319+ <td>Standard deviation</td>

320+ <td><span class="confinterval citime">3.7867077713250133e-6</span></td>

321+ <td><span class="time">4.502571301832575e-6</span></td>

322+ <td><span class="confinterval citime">5.8062391798041006e-6</span></td>

323+ </tr>

324+ </tbody>

325+ </table>

326+

327+ <span class="outliers">

328+ <p>Outlying measurements have slight

329+ (<span class="percent">1.2343749999999981e-2</span>%)

330+ effect on estimated standard deviation.</p>

331+ </span>

332+<h2><a name="b1">create/relation 10x1000</a></h2>

333+ <table width="100%">

334+ <tbody>

335+ <tr>

336+ <td><div id="kde1" class="kdechart"

337+ style="width:450px;height:278px;"></div></td>

338+ <td><div id="time1" class="timechart"

339+ style="width:450px;height:278px;"></div></td>

340+<!--

341+ <td><div id="cycle1" class="cyclechart"

342+ style="width:300px;height:278px;"></div></td>

343+-->

344+ </tr>

345+ </tbody>

346+ </table>

347+

348+ <table>

349+ <thead class="analysis">

350+ <th></th>

351+ <th class="cibound"

352+ title="0.95 confidence level">lower bound</th>

353+ <th>estimate</th>

354+ <th class="cibound"

355+ title="0.95 confidence level">upper bound</th>

356+ </thead>

357+ <tbody>

358+ <tr>

359+ <td>OLS regression</td>

360+ <td><span class="confinterval olstimelb1">xxx</span></td>

361+ <td><span class="olstimept1">xxx</span></td>

362+ <td><span class="confinterval olstimeub1">xxx</span></td>

363+ </tr>

364+ <tr>

365+ <td>R² goodness-of-fit</td>

366+ <td><span class="confinterval olsr2lb1">xxx</span></td>

367+ <td><span class="olsr2pt1">xxx</span></td>

368+ <td><span class="confinterval olsr2ub1">xxx</span></td>

369+ </tr>

370+ <tr>

371+ <td>Mean execution time</td>

372+ <td><span class="confinterval citime">5.760191573102873e-3</span></td>

373+ <td><span class="time">5.770838309782314e-3</span></td>

374+ <td><span class="confinterval citime">5.779948952798578e-3</span></td>

375+ </tr>

376+ <tr>

377+ <td>Standard deviation</td>

378+ <td><span class="confinterval citime">2.2935863601065537e-5</span></td>

379+ <td><span class="time">2.8815215559732134e-5</span></td>

380+ <td><span class="confinterval citime">3.914144050420156e-5</span></td>

381+ </tr>

382+ </tbody>

383+ </table>

384+

385+ <span class="outliers">

386+ <p>Outlying measurements have slight

387+ (<span class="percent">2.5623268698060614e-2</span>%)

388+ effect on estimated standard deviation.</p>

389+ </span>

390+<h2><a name="b2">create/relation 10x10000</a></h2>

391+ <table width="100%">

392+ <tbody>

393+ <tr>

394+ <td><div id="kde2" class="kdechart"

395+ style="width:450px;height:278px;"></div></td>

396+ <td><div id="time2" class="timechart"

397+ style="width:450px;height:278px;"></div></td>

398+<!--

399+ <td><div id="cycle2" class="cyclechart"

400+ style="width:300px;height:278px;"></div></td>

401+-->

402+ </tr>

403+ </tbody>

404+ </table>

405+

406+ <table>

407+ <thead class="analysis">

408+ <th></th>

409+ <th class="cibound"

410+ title="0.95 confidence level">lower bound</th>

411+ <th>estimate</th>

412+ <th class="cibound"

413+ title="0.95 confidence level">upper bound</th>

414+ </thead>

415+ <tbody>

416+ <tr>

417+ <td>OLS regression</td>

418+ <td><span class="confinterval olstimelb2">xxx</span></td>

419+ <td><span class="olstimept2">xxx</span></td>

420+ <td><span class="confinterval olstimeub2">xxx</span></td>

421+ </tr>

422+ <tr>

423+ <td>R² goodness-of-fit</td>

424+ <td><span class="confinterval olsr2lb2">xxx</span></td>

425+ <td><span class="olsr2pt2">xxx</span></td>

426+ <td><span class="confinterval olsr2ub2">xxx</span></td>

427+ </tr>

428+ <tr>

429+ <td>Mean execution time</td>

430+ <td><span class="confinterval citime">5.772489494946795e-2</span></td>

431+ <td><span class="time">5.784195729887314e-2</span></td>

432+ <td><span class="confinterval citime">5.792298187695035e-2</span></td>

433+ </tr>

434+ <tr>

435+ <td>Standard deviation</td>

436+ <td><span class="confinterval citime">1.0422507194091924e-4</span></td>

437+ <td><span class="time">1.7121491767487851e-4</span></td>

438+ <td><span class="confinterval citime">2.73724491538287e-4</span></td>

439+ </tr>

440+ </tbody>

441+ </table>

442+

443+ <span class="outliers">

444+ <p>Outlying measurements have slight

445+ (<span class="percent">7.638888888888888e-2</span>%)

446+ effect on estimated standard deviation.</p>

447+ </span>

448+<h2><a name="b3">restrict/restrict relation 10x10000 to 10x1</a></h2>

449+ <table width="100%">

450+ <tbody>

451+ <tr>

452+ <td><div id="kde3" class="kdechart"

453+ style="width:450px;height:278px;"></div></td>

454+ <td><div id="time3" class="timechart"

455+ style="width:450px;height:278px;"></div></td>

456+<!--

457+ <td><div id="cycle3" class="cyclechart"

458+ style="width:300px;height:278px;"></div></td>

459+-->

460+ </tr>

461+ </tbody>

462+ </table>

463+

464+ <table>

465+ <thead class="analysis">

466+ <th></th>

467+ <th class="cibound"

468+ title="0.95 confidence level">lower bound</th>

469+ <th>estimate</th>

470+ <th class="cibound"

471+ title="0.95 confidence level">upper bound</th>

472+ </thead>

473+ <tbody>

474+ <tr>

475+ <td>OLS regression</td>

476+ <td><span class="confinterval olstimelb3">xxx</span></td>

477+ <td><span class="olstimept3">xxx</span></td>

478+ <td><span class="confinterval olstimeub3">xxx</span></td>

479+ </tr>

480+ <tr>

481+ <td>R² goodness-of-fit</td>

482+ <td><span class="confinterval olsr2lb3">xxx</span></td>

483+ <td><span class="olsr2pt3">xxx</span></td>

484+ <td><span class="confinterval olsr2ub3">xxx</span></td>

485+ </tr>

486+ <tr>

487+ <td>Mean execution time</td>

488+ <td><span class="confinterval citime">1.4337830338577313e-2</span></td>

489+ <td><span class="time">1.448797309139284e-2</span></td>

490+ <td><span class="confinterval citime">1.4763601823824296e-2</span></td>

491+ </tr>

492+ <tr>

493+ <td>Standard deviation</td>

494+ <td><span class="confinterval citime">2.772536754203617e-4</span></td>

495+ <td><span class="time">4.774249175945004e-4</span></td>

496+ <td><span class="confinterval citime">8.291091461013828e-4</span></td>

497+ </tr>

498+ </tbody>

499+ </table>

500+

501+ <span class="outliers">

502+ <p>Outlying measurements have moderate

503+ (<span class="percent">0.11563227985262721</span>%)

504+ effect on estimated standard deviation.</p>

505+ </span>

506+<h2><a name="b4">restrict/restrict relation 10x10000 to 10x5000</a></h2>

507+ <table width="100%">

508+ <tbody>

509+ <tr>

510+ <td><div id="kde4" class="kdechart"

511+ style="width:450px;height:278px;"></div></td>

512+ <td><div id="time4" class="timechart"

513+ style="width:450px;height:278px;"></div></td>

514+<!--

515+ <td><div id="cycle4" class="cyclechart"

516+ style="width:300px;height:278px;"></div></td>

517+-->

518+ </tr>

519+ </tbody>

520+ </table>

521+

522+ <table>

523+ <thead class="analysis">

524+ <th></th>

525+ <th class="cibound"

526+ title="0.95 confidence level">lower bound</th>

527+ <th>estimate</th>

528+ <th class="cibound"

529+ title="0.95 confidence level">upper bound</th>

530+ </thead>

531+ <tbody>

532+ <tr>

533+ <td>OLS regression</td>

534+ <td><span class="confinterval olstimelb4">xxx</span></td>

535+ <td><span class="olstimept4">xxx</span></td>

536+ <td><span class="confinterval olstimeub4">xxx</span></td>

537+ </tr>

538+ <tr>

539+ <td>R² goodness-of-fit</td>

540+ <td><span class="confinterval olsr2lb4">xxx</span></td>

541+ <td><span class="olsr2pt4">xxx</span></td>

542+ <td><span class="confinterval olsr2ub4">xxx</span></td>

543+ </tr>

544+ <tr>

545+ <td>Mean execution time</td>

546+ <td><span class="confinterval citime">8.322941573263729e-2</span></td>

547+ <td><span class="time">8.447258684075218e-2</span></td>

548+ <td><span class="confinterval citime">8.511386931168204e-2</span></td>

549+ </tr>

550+ <tr>

551+ <td>Standard deviation</td>

552+ <td><span class="confinterval citime">6.118316959029327e-4</span></td>

553+ <td><span class="time">1.4013810341920257e-3</span></td>

554+ <td><span class="confinterval citime">2.3016514403696887e-3</span></td>

555+ </tr>

556+ </tbody>

557+ </table>

558+

559+ <span class="outliers">

560+ <p>Outlying measurements have slight

561+ (<span class="percent">9.0e-2</span>%)

562+ effect on estimated standard deviation.</p>

563+ </span>

564+<h2><a name="b5">project/project 10x1000 to 1x1000</a></h2>

565+ <table width="100%">

566+ <tbody>

567+ <tr>

568+ <td><div id="kde5" class="kdechart"

569+ style="width:450px;height:278px;"></div></td>

570+ <td><div id="time5" class="timechart"

571+ style="width:450px;height:278px;"></div></td>

572+<!--

573+ <td><div id="cycle5" class="cyclechart"

574+ style="width:300px;height:278px;"></div></td>

575+-->

576+ </tr>

577+ </tbody>

578+ </table>

579+

580+ <table>

581+ <thead class="analysis">

582+ <th></th>

583+ <th class="cibound"

584+ title="0.95 confidence level">lower bound</th>

585+ <th>estimate</th>

586+ <th class="cibound"

587+ title="0.95 confidence level">upper bound</th>

588+ </thead>

589+ <tbody>

590+ <tr>

591+ <td>OLS regression</td>

592+ <td><span class="confinterval olstimelb5">xxx</span></td>

593+ <td><span class="olstimept5">xxx</span></td>

594+ <td><span class="confinterval olstimeub5">xxx</span></td>

595+ </tr>

596+ <tr>

597+ <td>R² goodness-of-fit</td>

598+ <td><span class="confinterval olsr2lb5">xxx</span></td>

599+ <td><span class="olsr2pt5">xxx</span></td>

600+ <td><span class="confinterval olsr2ub5">xxx</span></td>

601+ </tr>

602+ <tr>

603+ <td>Mean execution time</td>

604+ <td><span class="confinterval citime">1.2211661066456561e-2</span></td>

605+ <td><span class="time">1.243577405705988e-2</span></td>

606+ <td><span class="confinterval citime">1.2583044006972743e-2</span></td>

607+ </tr>

608+ <tr>

609+ <td>Standard deviation</td>

610+ <td><span class="confinterval citime">3.0211460384957275e-4</span></td>

611+ <td><span class="time">4.600204612133745e-4</span></td>

612+ <td><span class="confinterval citime">5.956804020691042e-4</span></td>

613+ </tr>

614+ </tbody>

615+ </table>

616+

617+ <span class="outliers">

618+ <p>Outlying measurements have moderate

619+ (<span class="percent">0.14345146934193906</span>%)

620+ effect on estimated standard deviation.</p>

621+ </span>

622+<h2><a name="b6">project/project 10x1000 to 5x1000</a></h2>

623+ <table width="100%">

624+ <tbody>

625+ <tr>

626+ <td><div id="kde6" class="kdechart"

627+ style="width:450px;height:278px;"></div></td>

628+ <td><div id="time6" class="timechart"

629+ style="width:450px;height:278px;"></div></td>

630+<!--

631+ <td><div id="cycle6" class="cyclechart"

632+ style="width:300px;height:278px;"></div></td>

633+-->

634+ </tr>

635+ </tbody>

636+ </table>

637+

638+ <table>

639+ <thead class="analysis">

640+ <th></th>

641+ <th class="cibound"

642+ title="0.95 confidence level">lower bound</th>

643+ <th>estimate</th>

644+ <th class="cibound"

645+ title="0.95 confidence level">upper bound</th>

646+ </thead>

647+ <tbody>

648+ <tr>

649+ <td>OLS regression</td>

650+ <td><span class="confinterval olstimelb6">xxx</span></td>

651+ <td><span class="olstimept6">xxx</span></td>

652+ <td><span class="confinterval olstimeub6">xxx</span></td>

653+ </tr>

654+ <tr>

655+ <td>R² goodness-of-fit</td>

656+ <td><span class="confinterval olsr2lb6">xxx</span></td>

657+ <td><span class="olsr2pt6">xxx</span></td>

658+ <td><span class="confinterval olsr2ub6">xxx</span></td>

659+ </tr>

660+ <tr>

661+ <td>Mean execution time</td>

662+ <td><span class="confinterval citime">1.5271674270594341e-2</span></td>

663+ <td><span class="time">1.547382196820991e-2</span></td>

664+ <td><span class="confinterval citime">1.5622307025724294e-2</span></td>

665+ </tr>

666+ <tr>

667+ <td>Standard deviation</td>

668+ <td><span class="confinterval citime">2.873217405621163e-4</span></td>

669+ <td><span class="time">3.978143402171812e-4</span></td>

670+ <td><span class="confinterval citime">5.247713511789067e-4</span></td>

671+ </tr>

672+ </tbody>

673+ </table>

674+

675+ <span class="outliers">

676+ <p>Outlying measurements have slight

677+ (<span class="percent">4.1587901701323225e-2</span>%)

678+ effect on estimated standard deviation.</p>

679+ </span>

680+<h2><a name="b7">union/union identical 10x1000</a></h2>

681+ <table width="100%">

682+ <tbody>

683+ <tr>

684+ <td><div id="kde7" class="kdechart"

685+ style="width:450px;height:278px;"></div></td>

686+ <td><div id="time7" class="timechart"

687+ style="width:450px;height:278px;"></div></td>

688+<!--

689+ <td><div id="cycle7" class="cyclechart"

690+ style="width:300px;height:278px;"></div></td>

691+-->

692+ </tr>

693+ </tbody>

694+ </table>

695+

696+ <table>

697+ <thead class="analysis">

698+ <th></th>

699+ <th class="cibound"

700+ title="0.95 confidence level">lower bound</th>

701+ <th>estimate</th>

702+ <th class="cibound"

703+ title="0.95 confidence level">upper bound</th>

704+ </thead>

705+ <tbody>

706+ <tr>

707+ <td>OLS regression</td>

708+ <td><span class="confinterval olstimelb7">xxx</span></td>

709+ <td><span class="olstimept7">xxx</span></td>

710+ <td><span class="confinterval olstimeub7">xxx</span></td>

711+ </tr>

712+ <tr>

713+ <td>R² goodness-of-fit</td>

714+ <td><span class="confinterval olsr2lb7">xxx</span></td>

715+ <td><span class="olsr2pt7">xxx</span></td>

716+ <td><span class="confinterval olsr2ub7">xxx</span></td>

717+ </tr>

718+ <tr>

719+ <td>Mean execution time</td>

720+ <td><span class="confinterval citime">4.908323998442862e-2</span></td>

721+ <td><span class="time">4.923173514046889e-2</span></td>

722+ <td><span class="confinterval citime">4.94547578201357e-2</span></td>

723+ </tr>

724+ <tr>

725+ <td>Standard deviation</td>

726+ <td><span class="confinterval citime">2.09615306506087e-4</span></td>

727+ <td><span class="time">3.275115670368287e-4</span></td>

728+ <td><span class="confinterval citime">4.977889379852797e-4</span></td>

729+ </tr>

730+ </tbody>

731+ </table>

732+

733+ <span class="outliers">

734+ <p>Outlying measurements have slight

735+ (<span class="percent">7.100591715976319e-2</span>%)

736+ effect on estimated standard deviation.</p>

737+ </span>

738+<h2><a name="b8">union/union identical 10x10000</a></h2>

739+ <table width="100%">

740+ <tbody>

741+ <tr>

742+ <td><div id="kde8" class="kdechart"

743+ style="width:450px;height:278px;"></div></td>

744+ <td><div id="time8" class="timechart"

745+ style="width:450px;height:278px;"></div></td>

746+<!--

747+ <td><div id="cycle8" class="cyclechart"

748+ style="width:300px;height:278px;"></div></td>

749+-->

750+ </tr>

751+ </tbody>

752+ </table>

753+

754+ <table>

755+ <thead class="analysis">

756+ <th></th>

757+ <th class="cibound"

758+ title="0.95 confidence level">lower bound</th>

759+ <th>estimate</th>

760+ <th class="cibound"

761+ title="0.95 confidence level">upper bound</th>

762+ </thead>

763+ <tbody>

764+ <tr>

765+ <td>OLS regression</td>

766+ <td><span class="confinterval olstimelb8">xxx</span></td>

767+ <td><span class="olstimept8">xxx</span></td>

768+ <td><span class="confinterval olstimeub8">xxx</span></td>

769+ </tr>

770+ <tr>

771+ <td>R² goodness-of-fit</td>

772+ <td><span class="confinterval olsr2lb8">xxx</span></td>

773+ <td><span class="olsr2pt8">xxx</span></td>

774+ <td><span class="confinterval olsr2ub8">xxx</span></td>

775+ </tr>

776+ <tr>

777+ <td>Mean execution time</td>

778+ <td><span class="confinterval citime">0.5144192261126985</span></td>

779+ <td><span class="time">0.5157808375258943</span></td>

780+ <td><span class="confinterval citime">0.5164000385072457</span></td>

781+ </tr>

782+ <tr>

783+ <td>Standard deviation</td>

784+ <td><span class="confinterval citime">0</span></td>

785+ <td><span class="time">1.1935851498586624e-3</span></td>

786+ <td><span class="confinterval citime">1.285892588023751e-3</span></td>

787+ </tr>

788+ </tbody>

789+ </table>

790+

791+ <span class="outliers">

792+ <p>Outlying measurements have moderate

793+ (<span class="percent">0.18749999999999997</span>%)

794+ effect on estimated standard deviation.</p>

795+ </span>

796+<h2><a name="b9">join/join identical 10x100</a></h2>

797+ <table width="100%">

798+ <tbody>

799+ <tr>

800+ <td><div id="kde9" class="kdechart"

801+ style="width:450px;height:278px;"></div></td>

802+ <td><div id="time9" class="timechart"

803+ style="width:450px;height:278px;"></div></td>

804+<!--

805+ <td><div id="cycle9" class="cyclechart"

806+ style="width:300px;height:278px;"></div></td>

807+-->

808+ </tr>

809+ </tbody>

810+ </table>

811+

812+ <table>

813+ <thead class="analysis">

814+ <th></th>

815+ <th class="cibound"

816+ title="0.95 confidence level">lower bound</th>

817+ <th>estimate</th>

818+ <th class="cibound"

819+ title="0.95 confidence level">upper bound</th>

820+ </thead>

821+ <tbody>

822+ <tr>

823+ <td>OLS regression</td>

824+ <td><span class="confinterval olstimelb9">xxx</span></td>

825+ <td><span class="olstimept9">xxx</span></td>

826+ <td><span class="confinterval olstimeub9">xxx</span></td>

827+ </tr>

828+ <tr>

829+ <td>R² goodness-of-fit</td>

830+ <td><span class="confinterval olsr2lb9">xxx</span></td>

831+ <td><span class="olsr2pt9">xxx</span></td>

832+ <td><span class="confinterval olsr2ub9">xxx</span></td>

833+ </tr>

834+ <tr>

835+ <td>Mean execution time</td>

836+ <td><span class="confinterval citime">0.3355841931137941</span></td>

837+ <td><span class="time">0.3374978199984254</span></td>

838+ <td><span class="confinterval citime">0.3385756312293291</span></td>

839+ </tr>

840+ <tr>

841+ <td>Standard deviation</td>

842+ <td><span class="confinterval citime">0</span></td>

843+ <td><span class="time">1.6965376723717264e-3</span></td>

844+ <td><span class="confinterval citime">1.8668238128934738e-3</span></td>

845+ </tr>

846+ </tbody>

847+ </table>

848+

849+ <span class="outliers">

850+ <p>Outlying measurements have moderate

851+ (<span class="percent">0.1875</span>%)

852+ effect on estimated standard deviation.</p>

853+ </span>

854+<h2><a name="b10">group/group 10x100</a></h2>

855+ <table width="100%">

856+ <tbody>

857+ <tr>

858+ <td><div id="kde10" class="kdechart"

859+ style="width:450px;height:278px;"></div></td>

860+ <td><div id="time10" class="timechart"

861+ style="width:450px;height:278px;"></div></td>

862+<!--

863+ <td><div id="cycle10" class="cyclechart"

864+ style="width:300px;height:278px;"></div></td>

865+-->

866+ </tr>

867+ </tbody>

868+ </table>

869+

870+ <table>

871+ <thead class="analysis">

872+ <th></th>

873+ <th class="cibound"

874+ title="0.95 confidence level">lower bound</th>

875+ <th>estimate</th>

876+ <th class="cibound"

877+ title="0.95 confidence level">upper bound</th>

878+ </thead>

879+ <tbody>

880+ <tr>

881+ <td>OLS regression</td>

882+ <td><span class="confinterval olstimelb10">xxx</span></td>

883+ <td><span class="olstimept10">xxx</span></td>

884+ <td><span class="confinterval olstimeub10">xxx</span></td>

885+ </tr>

886+ <tr>

887+ <td>R² goodness-of-fit</td>

888+ <td><span class="confinterval olsr2lb10">xxx</span></td>

889+ <td><span class="olsr2pt10">xxx</span></td>

890+ <td><span class="confinterval olsr2ub10">xxx</span></td>

891+ </tr>

892+ <tr>

893+ <td>Mean execution time</td>

894+ <td><span class="confinterval citime">4.666001885635249e-2</span></td>

895+ <td><span class="time">4.70336206675725e-2</span></td>

896+ <td><span class="confinterval citime">4.7476184359486216e-2</span></td>

897+ </tr>

898+ <tr>

899+ <td>Standard deviation</td>

900+ <td><span class="confinterval citime">5.178696454087703e-4</span></td>

901+ <td><span class="time">7.389605929837668e-4</span></td>

902+ <td><span class="confinterval citime">1.1404867684675546e-3</span></td>

903+ </tr>

904+ </tbody>

905+ </table>

906+

907+ <span class="outliers">

908+ <p>Outlying measurements have slight

909+ (<span class="percent">7.100591715976322e-2</span>%)

910+ effect on estimated standard deviation.</p>

911+ </span>

912+<h2><a name="b11">write/write 10x1000</a></h2>

913+ <table width="100%">

914+ <tbody>

915+ <tr>

916+ <td><div id="kde11" class="kdechart"

917+ style="width:450px;height:278px;"></div></td>

918+ <td><div id="time11" class="timechart"

919+ style="width:450px;height:278px;"></div></td>

920+<!--

921+ <td><div id="cycle11" class="cyclechart"

922+ style="width:300px;height:278px;"></div></td>

923+-->

924+ </tr>

925+ </tbody>

926+ </table>

927+

928+ <table>

929+ <thead class="analysis">

930+ <th></th>

931+ <th class="cibound"

932+ title="0.95 confidence level">lower bound</th>

933+ <th>estimate</th>

934+ <th class="cibound"

935+ title="0.95 confidence level">upper bound</th>

936+ </thead>

937+ <tbody>

938+ <tr>

939+ <td>OLS regression</td>

940+ <td><span class="confinterval olstimelb11">xxx</span></td>

941+ <td><span class="olstimept11">xxx</span></td>

942+ <td><span class="confinterval olstimeub11">xxx</span></td>

943+ </tr>

944+ <tr>

945+ <td>R² goodness-of-fit</td>

946+ <td><span class="confinterval olsr2lb11">xxx</span></td>

947+ <td><span class="olsr2pt11">xxx</span></td>

948+ <td><span class="confinterval olsr2ub11">xxx</span></td>

949+ </tr>

950+ <tr>

951+ <td>Mean execution time</td>

952+ <td><span class="confinterval citime">1.5472953190097016e-3</span></td>

953+ <td><span class="time">1.5673276303702817e-3</span></td>

954+ <td><span class="confinterval citime">1.5890440248897237e-3</span></td>

955+ </tr>

956+ <tr>

957+ <td>Standard deviation</td>

958+ <td><span class="confinterval citime">6.110376965683773e-5</span></td>

959+ <td><span class="time">6.970009193368111e-5</span></td>

960+ <td><span class="confinterval citime">7.954403273020534e-5</span></td>

961+ </tr>

962+ </tbody>

963+ </table>

964+

965+ <span class="outliers">

966+ <p>Outlying measurements have moderate

967+ (<span class="percent">0.30346203307926556</span>%)

968+ effect on estimated standard deviation.</p>

969+ </span>

970+

971+ <h2><a name="grokularation">understanding this report</a></h2>

972+

973+ <p>In this report, each function benchmarked by criterion is assigned

974+ a section of its own. The charts in each section are active; if

975+ you hover your mouse over data points and annotations, you will see

976+ more details.</p>

977+

978+ <ul>

979+ <li>The chart on the left is a

980+ <a href="http://en.wikipedia.org/wiki/Kernel_density_estimation">kernel

981+ density estimate</a> (also known as a KDE) of time

982+ measurements. This graphs the probability of any given time

983+ measurement occurring. A spike indicates that a measurement of a

984+ particular time occurred; its height indicates how often that

985+ measurement was repeated.</li>

986+

987+ <li>The chart on the right is the raw data from which the kernel

988+ density estimate is built. The <i>x</i> axis indicates the

989+ number of loop iterations, while the <i>y</i> axis shows measured

990+ execution time for the given number of loop iterations. The

991+ line behind the values is the linear regression prediction of

992+ execution time for a given number of iterations. Ideally, all

993+ measurements will be on (or very near) this line.</li>

994+ </ul>

995+

996+ <p>Under the charts is a small table.

997+ The first two rows are the results of a linear regression run

998+ on the measurements displayed in the right-hand chart.</p>

999+

1000+ <ul>

1001+ <li><i>OLS regression</i> indicates the

1002+ time estimated for a single loop iteration using an ordinary

1003+ least-squares regression model. This number is more accurate

1004+ than the <i>mean</i> estimate below it, as it more effectively

1005+ eliminates measurement overhead and other constant factors.</li>

1006+ <li><i>R² goodness-of-fit</i> is a measure of how

1007+ accurately the linear regression model fits the observed

1008+ measurements. If the measurements are not too noisy, R²

1009+ should lie between 0.99 and 1, indicating an excellent fit. If

1010+ the number is below 0.99, something is confounding the accuracy

1011+ of the linear model.</li>

1012+ <li><i>Mean execution time</i> and <i>standard deviation</i> are

1013+ statistics calculated from execution time

1014+ divided by number of iterations.</li>

1015+ </ul>

1016+

1017+ <p>We use a statistical technique called

1018+ the <a href="http://en.wikipedia.org/wiki/Bootstrapping_(statistics)">bootstrap</a>

1019+ to provide confidence intervals on our estimates. The

1020+ bootstrap-derived upper and lower bounds on estimates let you see

1021+ how accurate we believe those estimates to be. (Hover the mouse

1022+ over the table headers to see the confidence levels.)</p>

1023+

1024+ <p>A noisy benchmarking environment can cause some or many

1025+ measurements to fall far from the mean. These outlying

1026+ measurements can have a significant inflationary effect on the

1027+ estimate of the standard deviation. We calculate and display an

1028+ estimate of the extent to which the standard deviation has been

1029+ inflated by outliers.</p>

1030+

1031+<script type="text/javascript">

1032+$(function () {

1033+ function mangulate(rpt) {

1034+ var measured = function(key) {

1035+ var idx = rpt.reportKeys.indexOf(key);

1036+ return rpt.reportMeasured.map(function(r) { return r[idx]; });

1037+ };

1038+ var lowerBound = function(est) {

1039+ return est.estPoint - est.estError.confIntLDX;

1040+ };

1041+ var upperBound = function(est) {

1042+ return est.estPoint + est.estError.confIntUDX;

1043+ };

1044+ var number = rpt.reportNumber;

1045+ var name = rpt.reportName;

1046+ var mean = rpt.reportAnalysis.anMean.estPoint;

1047+ var iters = measured("iters");

1048+ var times = measured("time");

1049+ var kdetimes = rpt.reportKDEs[0].kdeValues;

1050+ var kdepdf = rpt.reportKDEs[0].kdePDF;

1051+

1052+ var meanSecs = mean;

1053+ var units = $.timeUnits(mean);

1054+ var rgrs = rpt.reportAnalysis.anRegress[0];

1055+ var scale = units[0];

1056+ var olsTime = rgrs.regCoeffs.iters;

1057+ $(".olstimept" + number).text(function() {

1058+ return $.renderTime(olsTime.estPoint);

1059+ });

1060+ $(".olstimelb" + number).text(function() {

1061+ return $.renderTime(lowerBound(olsTime));

1062+ });

1063+ $(".olstimeub" + number).text(function() {

1064+ return $.renderTime(upperBound(olsTime));

1065+ });

1066+ $(".olsr2pt" + number).text(function() {

1067+ return rgrs.regRSquare.estPoint.toFixed(3);

1068+ });

1069+ $(".olsr2lb" + number).text(function() {

1070+ return lowerBound(rgrs.regRSquare).toFixed(3);

1071+ });

1072+ $(".olsr2ub" + number).text(function() {

1073+ return upperBound(rgrs.regRSquare).toFixed(3);

1074+ });

1075+ mean *= scale;

1076+ kdetimes = $.scaleBy(scale, kdetimes);

1077+ var kq = $("#kde" + number);

1078+ var k = $.plot(kq,

1079+ [{ label: name + " time densities",

1080+ data: $.zip(kdetimes, kdepdf),

1081+ }],

1082+ { xaxis: { tickFormatter: $.unitFormatter(scale) },

1083+ yaxis: { ticks: false },

1084+ grid: { borderColor: "#777",

1085+ hoverable: true, markings: [ { color: '#6fd3fb',

1086+ lineWidth: 1.5, xaxis: { from: mean, to: mean } } ] },

1087+ });

1088+ var o = k.pointOffset({ x: mean, y: 0});

1089+ kq.append('<div class="meanlegend" title="' + $.renderTime(meanSecs) +

1090+ '" style="position:absolute;left:' + (o.left + 4) +

1091+ 'px;bottom:139px;">mean</div>');

1092+ $.addTooltip("#kde" + number,

1093+ function(secs) { return $.renderTime(secs / scale); });

1094+ var timepairs = new Array(times.length);

1095+ var lastiter = iters[iters.length-1];

1096+ var olspairs = [[0,0], [lastiter, lastiter * scale * olsTime.estPoint]];

1097+ for (var i = 0; i < times.length; i++)

1098+ timepairs[i] = [iters[i],times[i]*scale];

1099+ iterFormatter = function() {

1100+ var denom = 0;

1101+ return function(iters) {

1102+ if (iters == 0)

1103+ return '';

1104+ if (denom > 0)

1105+ return (iters / denom).toFixed();

1106+ var power;

1107+ if (iters >= 1e9) {

1108+ denom = '1e9'; power = '⁹';

1109+ }

1110+ if (iters >= 1e6) {

1111+ denom = '1e6'; power = '⁶';

1112+ }

1113+ else if (iters >= 1e3) {

1114+ denom = '1e3'; power = '³';

1115+ }

1116+ else denom = 1;

1117+ if (denom > 1) {

1118+ iters = (iters / denom).toFixed();

1119+ iters += '×10' + power + ' iters';

1120+ } else {

1121+ iters += ' iters';

1122+ }

1123+ return iters;

1124+ };

1125+ };

1126+ $.plot($("#time" + number),

1127+ [{ label: "regression", data: olspairs,

1128+ lines: { show: true } },

1129+ { label: name + " times", data: timepairs,

1130+ points: { show: true } }],

1131+ { grid: { borderColor: "#777", hoverable: true },

1132+ xaxis: { tickFormatter: iterFormatter() },

1133+ yaxis: { tickFormatter: $.unitFormatter(scale) } });

1134+ $.addTooltip("#time" + number,

1135+ function(iters,secs) {

1136+ return ($.renderTime(secs / scale) + ' / ' +

1137+ iters.toLocaleString() + ' iters');

1138+ });

1139+ if (0) {

1140+ var cyclepairs = new Array(cycles.length);

1141+ for (var i = 0; i < cycles.length; i++)

1142+ cyclepairs[i] = [cycles[i],i];

1143+ $.plot($("#cycle" + number),

1144+ [{ label: name + " cycles",

1145+ data: cyclepairs }],

1146+ { points: { show: true },

1147+ grid: { borderColor: "#777", hoverable: true },

1148+ xaxis: { tickFormatter:

1149+ function(cycles,axis) { return cycles + ' cycles'; }},

1150+ yaxis: { ticks: false },

1151+ });

1152+ $.addTooltip("#cycles" + number, function(x,y) { return x + ' cycles'; });

1153+ }

1154+ };

1155+ var reports = [{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":1.480212040430454e-6,"confIntUDX":1.2773478838920983e-6,"confIntCL":5.0e-2},"estPoint":5.906283388143756e-4},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":3.555021666379332e-6,"confIntUDX":3.2835390818553023e-6,"confIntCL":5.0e-2},"estPoint":0.999994210390811},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":3.992840580325896e-5,"confIntUDX":3.5096033885701615e-5,"confIntCL":5.0e-2},"estPoint":4.5018032731655834e-5},"iters":{"estError":{"confIntLDX":4.916701435576497e-7,"confIntUDX":6.481819002255793e-7,"confIntCL":5.0e-2},"estPoint":5.990242120138069e-4}}}],"anStdDev":{"estError":{"confIntLDX":7.158635305075615e-7,"confIntUDX":1.3036678779715258e-6,"confIntCL":5.0e-2},"estPoint":4.502571301832575e-6},"anOutlierVar":{"ovFraction":1.2343749999999981e-2,"ovDesc":"slight","ovEffect":"Slight"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[5.767309127295322e-4,5.769143047848586e-4,5.770976968401851e-4,5.772810888955115e-4,5.77464480950838e-4,5.776478730061645e-4,5.77831265061491e-4,5.780146571168174e-4,5.781980491721439e-4,5.783814412274703e-4,5.785648332827969e-4,5.787482253381233e-4,5.789316173934497e-4,5.791150094487762e-4,5.792984015041027e-4,5.794817935594292e-4,5.796651856147556e-4,5.798485776700821e-4,5.800319697254085e-4,5.802153617807351e-4,5.803987538360615e-4,5.80582145891388e-4,5.807655379467144e-4,5.80948930002041e-4,5.811323220573674e-4,5.813157141126938e-4,5.814991061680203e-4,5.816824982233467e-4,5.818658902786733e-4,5.820492823339997e-4,5.822326743893262e-4,5.824160664446526e-4,5.825994584999791e-4,5.827828505553056e-4,5.829662426106321e-4,5.831496346659585e-4,5.833330267212849e-4,5.835164187766114e-4,5.836998108319379e-4,5.838832028872644e-4,5.840665949425908e-4,5.842499869979173e-4,5.844333790532437e-4,5.846167711085703e-4,5.848001631638967e-4,5.849835552192232e-4,5.851669472745496e-4,5.85350339329876e-4,5.855337313852026e-4,5.85717123440529e-4,5.859005154958555e-4,5.860839075511819e-4,5.862672996065085e-4,5.864506916618349e-4,5.866340837171614e-4,5.868174757724878e-4,5.870008678278143e-4,5.871842598831408e-4,5.873676519384673e-4,5.875510439937937e-4,5.877344360491201e-4,5.879178281044466e-4,5.881012201597731e-4,5.882846122150996e-4,5.88468004270426e-4,5.886513963257525e-4,5.88834788381079e-4,5.890181804364055e-4,5.892015724917319e-4,5.893849645470584e-4,5.895683566023848e-4,5.897517486577112e-4,5.899351407130378e-4,5.901185327683642e-4,5.903019248236907e-4,5.904853168790171e-4,5.906687089343437e-4,5.908521009896701e-4,5.910354930449966e-4,5.91218885100323e-4,5.914022771556495e-4,5.91585669210976e-4,5.917690612663024e-4,5.919524533216289e-4,5.921358453769553e-4,5.923192374322818e-4,5.925026294876083e-4,5.926860215429348e-4,5.928694135982612e-4,5.930528056535877e-4,5.932361977089142e-4,5.934195897642407e-4,5.936029818195671e-4,5.937863738748935e-4,5.9396976593022e-4,5.941531579855465e-4,5.94336550040873e-4,5.945199420961994e-4,5.947033341515259e-4,5.948867262068523e-4,5.950701182621789e-4,5.952535103175053e-4,5.954369023728318e-4,5.956202944281582e-4,5.958036864834846e-4,5.959870785388112e-4,5.961704705941376e-4,5.963538626494641e-4,5.965372547047905e-4,5.96720646760117e-4,5.969040388154435e-4,5.9708743087077e-4,5.972708229260964e-4,5.974542149814229e-4,5.976376070367494e-4,5.978209990920759e-4,5.980043911474023e-4,5.981877832027287e-4,5.983711752580552e-4,5.985545673133817e-4,5.987379593687082e-4,5.989213514240346e-4,5.991047434793611e-4,5.992881355346875e-4,5.994715275900141e-4,5.996549196453405e-4,5.99838311700667e-4,6.000217037559934e-4],"kdeType":"time","kdePDF":[7439.606200664009,7463.860772581996,7512.519471367643,7585.879034733249,7684.378650480464,7808.59288896541,7959.222344451404,8137.082052941013,8343.087784506373,8578.240345240563,8843.608066987465,9140.307710396293,9469.484056270247,9832.288508711508,10229.85707790064,10663.288147018666,11133.620453497775,11641.811726519703,12188.718418185661,12775.076943623719,13401.48680508669,14068.395917549335,14776.088380313859,15524.674853637032,16314.085605322467,17144.066194245657,18014.17566107358,18923.787006368777,19872.089658085122,20858.093568968376,21880.63454363045,22938.38037810305,24029.837403295212,25153.35705838,26307.1421796571,27489.252772337637,28697.611133056118,29930.00630457071,31184.097964923378,32457.419974418754,33747.38391792052,35051.283079886554,36366.2973683962,37689.499755989564,39017.864824376906,40348.27998326451,41677.55987863412,43002.46441251096,44319.720666231085,45626.048855992674,46918.19225848234,48192.9508326456,49447.218039767664,50678.02013753379,51882.55700504304,53058.24335548316,54202.74902189472,55314.036869023075,56390.396799555885,57430.47429337121,58433.29194928923,59398.26259347494,60325.19267798467,61214.27491525301,62066.069375311075,62881.472605315255,63661.67470632853,64408.10470879936,65122.36501266323,65806.15608584625,66461.19303076026,67089.1160163213,67691.39691757591,68269.24479142003,68823.51303185195,69354.61118031963,69862.42440713938,70346.24362265936,70804.70901910632,71235.76958662862,71636.66079434061,72003.90218716432,72333.31613345034,72620.06838137904,72858.73046143548,73043.3633274288,73167.62098077408,73224.87219401666,73208.33786178584,73111.2409815332,72926.96582184076,72649.22248949985,72272.2128714332,71790.79381341882,71200.63340969513,70498.35641645365,69681.67506379938,68749.50191620484,67702.04190771938,66540.86123835878,65268.93144221416,63890.64760364616,62411.82038186993,60839.642182361524,59182.628462524866,57450.535757302285,55654.25853871905,53805.707465851454,51917.67192636734,50003.67000988945,48077.78918372171,46154.520964229625,44248.59279791539,42374.80019444325,40547.841902338376,38782.160602275166,37091.79123010303,35490.21865040699,33990.24599998552,32603.874627041063,31342.19618255019,30215.2970895606,29232.17533570354,28400.669312593527,27727.39826820856,27217.713846527327,26875.662160911106,26703.955878966048]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":0,"reportName":"create/relation 10x100","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":0,"samplesSeen":42,"lowSevere":0},"reportMeasured":[[6.813240033807233e-4,6.795370000000009e-4,1291970,1,null,null,null,null,null,null,null],[1.2316010033828206e-3,1.2288760000000003e-3,2337568,2,null,null,null,null,null,null,null],[1.8350910031585954e-3,1.8311770000000033e-3,3484055,3,null,null,null,null,null,null,null],[2.427155995974317e-3,2.4221040000000013e-3,4608527,4,null,null,null,null,null,null,null],[3.0626340012531728e-3,3.052128000000001e-3,5816367,5,null,null,null,null,null,null,null],[3.638373003923334e-3,3.6385010000000023e-3,6911175,6,null,null,null,null,null,null,null],[4.216387998894788e-3,4.203885999999997e-3,8007897,7,null,null,null,null,null,null,null],[4.8334379971493036e-3,4.838462000000002e-3,9181602,8,null,null,null,null,null,null,null],[5.428168005892076e-3,5.415576000000005e-3,10312089,9,null,null,null,null,null,null,null],[6.012180994730443e-3,6.00813e-3,11421128,10,null,null,null,null,null,null,null],[6.5902550049941055e-3,6.592010999999995e-3,12518912,11,null,null,null,null,null,null,null],[7.23675199697027e-3,7.229662999999997e-3,13747464,12,null,null,null,null,null,null,null],[7.84011700307019e-3,7.831859999999996e-3,14893518,13,null,null,null,null,null,null,null],[8.434026000031736e-3,8.425254999999993e-3,16022852,14,null,null,null,null,null,null,null],[9.01525300287176e-3,9.005011000000007e-3,17125378,15,null,null,null,null,null,null,null],[9.62481100577861e-3,9.613589000000006e-3,18284524,16,null,null,null,null,null,null,null],[1.0174692004511598e-2,1.0159233000000017e-2,19330158,17,null,null,null,null,null,null,null],[1.0838796995813027e-2,1.0825276000000023e-2,20590579,18,null,null,null,null,null,null,null],[1.1404266006138641e-2,1.1396694000000013e-2,21666369,19,null,null,null,null,null,null,null],[1.2019466004858259e-2,1.200773400000002e-2,22835526,20,null,null,null,null,null,null,null],[1.2612122001883108e-2,1.2602988999999981e-2,23960806,21,null,null,null,null,null,null,null],[1.3185921001422685e-2,1.3175439999999983e-2,25039019,22,null,null,null,null,null,null,null],[1.380999500543112e-2,1.3800904000000003e-2,26235900,23,null,null,null,null,null,null,null],[1.5010613002232276e-2,1.5004187000000002e-2,28517754,25,null,null,null,null,null,null,null],[1.5596878998621833e-2,1.5588999999999964e-2,29631118,26,null,null,null,null,null,null,null],[1.619237400154816e-2,1.6183787000000005e-2,30763246,27,null,null,null,null,null,null,null],[1.6726298003050033e-2,1.6716809e-2,31778366,28,null,null,null,null,null,null,null],[1.7975681999814697e-2,1.7950438999999985e-2,34152290,30,null,null,null,null,null,null,null],[1.8578729999717325e-2,1.856606700000002e-2,35298278,31,null,null,null,null,null,null,null],[1.9729389998246916e-2,1.972127800000001e-2,37482481,33,null,null,null,null,null,null,null],[2.0979664994229097e-2,2.0962800000000004e-2,39859087,35,null,null,null,null,null,null,null],[2.1577223000349477e-2,2.1558966000000013e-2,40993942,36,null,null,null,null,null,null,null],[2.283525199891301e-2,2.282013599999999e-2,43384199,38,null,null,null,null,null,null,null],[2.397813599964138e-2,2.3962815000000026e-2,45555911,40,null,null,null,null,null,null,null],[2.510333999816794e-2,2.5077219999999956e-2,47676154,42,null,null,null,null,null,null,null],[2.6329069005441852e-2,2.6309212000000026e-2,50021602,44,null,null,null,null,null,null,null],[2.815628200187348e-2,2.8133567000000026e-2,53494575,47,null,null,null,null,null,null,null],[2.939282599982107e-2,2.937685499999998e-2,55844069,49,null,null,null,null,null,null,null],[3.1181958998786286e-2,3.1156967000000035e-2,59243868,52,null,null,null,null,null,null,null],[3.252649400383234e-2,3.249802700000004e-2,61797251,54,null,null,null,null,null,null,null],[3.4448503000021446e-2,3.442938200000001e-2,65450278,57,null,null,null,null,null,null,null],[3.607152900076471e-2,3.6039925000000084e-2,68534608,60,null,null,null,null,null,null,null],[3.795692800485995e-2,3.7922617999999964e-2,72115683,63,null,null,null,null,null,null,null],[3.981165000004694e-2,3.978681899999992e-2,75640494,66,null,null,null,null,null,null,null],[4.13812839979073e-2,4.134547600000005e-2,78620459,69,null,null,null,null,null,null,null],[4.381340800318867e-2,4.3773587e-2,83243475,73,null,null,null,null,null,null,null],[4.59521769953426e-2,4.591688100000002e-2,87305971,76,null,null,null,null,null,null,null],[4.8131951996765565e-2,4.807948400000006e-2,91447845,80,null,null,null,null,null,null,null],[5.042989100184059e-2,5.0378136000000184e-2,95814508,84,null,null,null,null,null,null,null],[5.349220000061905e-2,5.3437803000000006e-2,101632803,89,null,null,null,null,null,null,null],[5.570261099637719e-2,5.566170800000014e-2,105832608,93,null,null,null,null,null,null,null],[5.8637883004848845e-2,5.8586950000000027e-2,111410682,98,null,null,null,null,null,null,null],[6.1715287003607955e-2,6.1675520000000095e-2,117257562,103,null,null,null,null,null,null,null],[6.46549410012085e-2,6.460622500000013e-2,122841390,108,null,null,null,null,null,null,null],[6.766005199460778e-2,6.762474500000004e-2,128551690,113,null,null,null,null,null,null,null],[7.115251399955014e-2,7.110800200000011e-2,135187173,119,null,null,null,null,null,null,null],[7.494805199530674e-2,7.490005500000008e-2,142399851,125,null,null,null,null,null,null,null],[7.836887799930992e-2,7.830414600000002e-2,148897308,131,null,null,null,null,null,null,null],[8.264995200443082e-2,8.25901229999999e-2,157032133,138,null,null,null,null,null,null,null],[8.62455440001213e-2,8.619491499999987e-2,163865596,144,null,null,null,null,null,null,null],[9.091036900645122e-2,9.084664899999995e-2,172727386,152,null,null,null,null,null,null,null],[9.528734099876601e-2,9.521602299999987e-2,181043100,159,null,null,null,null,null,null,null],[0.10003491100360407,9.9945022e-2,190062923,167,null,null,null,null,null,null,null],[0.10540352200041525,0.1053145390000001,200264351,176,null,null,null,null,null,null,null],[0.1109114220016636,0.11082174499999997,210729214,185,null,null,null,null,null,null,null],[0.11628856800234644,0.11619333099999984,220946401,194,null,null,null,null,null,null,null],[0.12236196899903007,0.12219322300000002,232485189,204,null,null,null,null,null,null,null],[0.1280951240041759,0.12801656100000036,243377425,214,null,null,null,null,null,null,null],[0.13404688699665712,0.13395500699999996,254686351,224,null,null,null,null,null,null,null],[0.14159004599787295,0.14147092299999997,269018879,236,null,null,null,null,null,null,null],[0.14789382999879308,0.14779020099999984,280995516,247,null,null,null,null,null,null,null],[0.15566811999451602,0.1555507089999999,295767514,260,null,null,null,null,null,null,null],[0.16341256899613654,0.1632890299999996,310480881,273,null,null,null,null,null,null,null],[0.17193876200326486,0.17182209000000004,326682249,287,null,null,null,null,null,null,null],[0.18065470200235723,0.18048433699999977,343241359,301,null,null,null,null,null,null,null],[0.19008455899893306,0.18990984600000038,361158953,316,null,null,null,null,null,null,null],[0.19925997099926462,0.19908731799999924,378591096,332,null,null,null,null,null,null,null],[0.20827979499881621,0.2080981780000002,395729002,348,null,null,null,null,null,null,null],[0.21893202800129075,0.21876482700000022,415967666,366,null,null,null,null,null,null,null],[0.22986117999971611,0.2297205800000004,436734977,384,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":1.064673667944098e-5,"confIntUDX":9.11064301626404e-6,"confIntCL":5.0e-2},"estPoint":5.770838309782314e-3},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":5.15058316596928e-6,"confIntUDX":3.7708817312021026e-6,"confIntCL":5.0e-2},"estPoint":0.9999926782872085},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":1.2175205858588846e-4,"confIntUDX":1.1025796245932467e-4,"confIntCL":5.0e-2},"estPoint":1.2610346963985624e-4},"iters":{"estError":{"confIntLDX":5.124258960720503e-6,"confIntUDX":5.297958354179462e-6,"confIntCL":5.0e-2},"estPoint":5.823855877516418e-3}}}],"anStdDev":{"estError":{"confIntLDX":5.879351958666597e-6,"confIntUDX":1.0326224944469426e-5,"confIntCL":5.0e-2},"estPoint":2.8815215559732134e-5},"anOutlierVar":{"ovFraction":2.5623268698060614e-2,"ovDesc":"slight","ovEffect":"Slight"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[5.671752972753566e-3,5.672973797666535e-3,5.674194622579503e-3,5.675415447492472e-3,5.676636272405441e-3,5.67785709731841e-3,5.679077922231379e-3,5.6802987471443476e-3,5.681519572057317e-3,5.682740396970285e-3,5.683961221883254e-3,5.685182046796224e-3,5.686402871709192e-3,5.687623696622161e-3,5.6888445215351295e-3,5.690065346448099e-3,5.691286171361068e-3,5.692506996274036e-3,5.6937278211870055e-3,5.694948646099974e-3,5.696169471012943e-3,5.697390295925912e-3,5.698611120838881e-3,5.69983194575185e-3,5.701052770664818e-3,5.7022735955777875e-3,5.703494420490757e-3,5.704715245403725e-3,5.705936070316694e-3,5.707156895229663e-3,5.708377720142632e-3,5.709598545055601e-3,5.7108193699685695e-3,5.712040194881539e-3,5.713261019794507e-3,5.714481844707476e-3,5.7157026696204455e-3,5.716923494533414e-3,5.718144319446383e-3,5.719365144359351e-3,5.720585969272321e-3,5.72180679418529e-3,5.723027619098258e-3,5.7242484440112274e-3,5.725469268924196e-3,5.726690093837165e-3,5.727910918750134e-3,5.729131743663103e-3,5.730352568576072e-3,5.73157339348904e-3,5.732794218402009e-3,5.734015043314979e-3,5.735235868227947e-3,5.736456693140916e-3,5.737677518053885e-3,5.738898342966854e-3,5.740119167879823e-3,5.741339992792791e-3,5.742560817705761e-3,5.743781642618729e-3,5.745002467531698e-3,5.746223292444667e-3,5.747444117357636e-3,5.748664942270605e-3,5.749885767183573e-3,5.7511065920965426e-3,5.752327417009512e-3,5.75354824192248e-3,5.754769066835449e-3,5.755989891748418e-3,5.757210716661387e-3,5.758431541574355e-3,5.7596523664873245e-3,5.760873191400294e-3,5.762094016313262e-3,5.763314841226231e-3,5.7645356661392e-3,5.765756491052169e-3,5.766977315965138e-3,5.7681981408781065e-3,5.769418965791076e-3,5.770639790704044e-3,5.771860615617013e-3,5.7730814405299825e-3,5.774302265442951e-3,5.77552309035592e-3,5.7767439152688884e-3,5.777964740181858e-3,5.779185565094827e-3,5.780406390007795e-3,5.7816272149207645e-3,5.782848039833733e-3,5.784068864746702e-3,5.785289689659671e-3,5.78651051457264e-3,5.787731339485609e-3,5.788952164398577e-3,5.790172989311546e-3,5.791393814224516e-3,5.792614639137484e-3,5.793835464050453e-3,5.795056288963422e-3,5.796277113876391e-3,5.79749793878936e-3,5.798718763702328e-3,5.799939588615298e-3,5.801160413528266e-3,5.802381238441235e-3,5.803602063354204e-3,5.804822888267173e-3,5.806043713180142e-3,5.80726453809311e-3,5.80848536300608e-3,5.809706187919049e-3,5.810927012832017e-3,5.812147837744986e-3,5.813368662657955e-3,5.814589487570924e-3,5.815810312483893e-3,5.8170311373968615e-3,5.818251962309831e-3,5.819472787222799e-3,5.820693612135768e-3,5.8219144370487376e-3,5.823135261961706e-3,5.824356086874675e-3,5.8255769117876435e-3,5.826797736700613e-3],"kdeType":"time","kdePDF":[1019.5373084237668,1019.7637421621965,1020.2533075587864,1021.0792144186191,1022.3508072300559,1024.2129867878552,1026.8454162718053,1030.4614937957865,1035.3070707871354,1041.6588940448357,1049.8227491047244,1060.1312837170783,1072.941492877457,1088.6318509576324,1107.5990820219793,1130.2545662959658,1157.0203888375997,1188.325045561594,1224.5988316461085,1266.268947740355,1313.7543699811238,1367.4605402846023,1427.7739433567695,1495.0566460032612,1569.6408822636686,1651.8237743055083,1741.8622835752412,1839.9684891405898,1946.3052902416885,2060.9826276280264,2184.0543131922036,2315.515549693471,2455.3012120490203,2603.284948897687,2759.2791481342897,2923.0357931793324,3094.248218274285,3272.553751529788,3457.537214316371,3648.7352254287057,3845.6412388599433,4047.7112255820925,4254.369893024689,4465.017321523728,4679.035885376282,4895.797317705572,5114.669773457488,5335.024743740762,5556.2436775111355,5777.72417327335,5998.885613905776,6219.1741316372745,6438.066807253191,6655.07502728686,6869.746944694798,7081.6690116630525,7290.466577058243,7495.80356489116,7697.381273290746,7894.936355194286,8088.238061616294,8277.084845397681,8461.30043730499,8640.729516891945,8815.233107438498,8984.683827447849,9148.961130658738,9307.94666247959,9461.519853464551,9609.553860308291,9751.911952311124,9888.444426880076,10018.986121954547,10143.354576845091,10261.348876416434,10372.749197347559,10477.317059833256,10574.796273936703,10664.914557169564,10747.385788965996,10821.912858643147,10888.191056211128,10945.911949936743,10994.767690718814,11034.455680884012,11064.683543693101,11085.17432937169,11095.671893546707,11095.946384299015,11085.799774378575,11065.071375267627,11033.643269570874,10991.445597583166,10938.46163282784,10874.732579941767,10800.36202664313,10715.51997985466,10620.446414617943,10515.454263509158,10400.93177415873,10277.34416349412,10145.234499758115,10005.22374746179,9858.009916420577,9704.366264036635,9545.13851010128,9381.241035581452,9213.652051023826,9043.407736167,8871.595369822204,8699.345487711116,8527.823125314791,8358.218222412313,8191.735285356814,8029.582421708993,7872.959879083788,7723.0482354335945,7580.996400997628,7447.909602344188,7324.837525942117,7212.76280221673,7112.590010864868,7025.135384208468,6951.117377548318,6891.148263932293,6845.726895675284,6815.232756655521,6799.921408252735]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":1,"reportName":"create/relation 10x1000","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":1,"samplesSeen":33,"lowSevere":0},"reportMeasured":[[5.887054001505021e-3,5.879581999999495e-3,11182234,1,null,null,null,null,null,null,null],[1.1682764001307078e-2,1.1675040000000081e-2,22194893,2,null,null,null,null,null,null,null],[1.7509942001197487e-2,1.74909379999999e-2,33265063,3,null,null,null,null,null,null,null],[2.3410166999383364e-2,2.3395288999999764e-2,44477630,4,null,null,null,null,null,null,null],[2.9472086003806908e-2,2.9430035999999937e-2,55992906,5,null,null,null,null,null,null,null],[3.5199064994230866e-2,3.516572100000026e-2,66874109,6,null,null,null,null,null,null,null],[4.122917899803724e-2,4.1192778000000096e-2,78332155,7,null,null,null,null,null,null,null],[4.701189199840883e-2,4.6936478000000115e-2,89320165,8,null,null,null,null,null,null,null],[5.271683200408006e-2,5.2686497999999915e-2,100160078,9,null,null,null,null,null,null,null],[5.865615299990168e-2,5.859188300000007e-2,111442987,10,null,null,null,null,null,null,null],[6.451627500064205e-2,6.446151800000077e-2,122578882,11,null,null,null,null,null,null,null],[6.994964399927994e-2,6.990481299999995e-2,132901645,12,null,null,null,null,null,null,null],[7.564991200342774e-2,7.560714800000046e-2,143731876,13,null,null,null,null,null,null,null],[8.150492400454823e-2,8.145551299999987e-2,154856276,14,null,null,null,null,null,null,null],[8.717107799748192e-2,8.711902599999988e-2,165622826,15,null,null,null,null,null,null,null],[9.312852899893187e-2,9.307294599999949e-2,176940830,16,null,null,null,null,null,null,null],[9.896839800057933e-2,9.890558900000013e-2,188037060,17,null,null,null,null,null,null,null],[0.10488027700193925,0.10481192300000064,199268869,18,null,null,null,null,null,null,null],[0.11073017199669266,0.11065237000000039,210383777,19,null,null,null,null,null,null,null],[0.1164985559953493,0.11641449700000006,221345187,20,null,null,null,null,null,null,null],[0.12229861300147604,0.12221939399999915,232363084,21,null,null,null,null,null,null,null],[0.12807984399842098,0.12799171500000028,243349421,22,null,null,null,null,null,null,null],[0.13390199199784547,0.1338048280000006,254410896,23,null,null,null,null,null,null,null],[0.14545249000366312,0.1453479619999989,276355041,25,null,null,null,null,null,null,null],[0.15155094099463895,0.15144441099999995,287943394,26,null,null,null,null,null,null,null],[0.15711575300520053,0.1570216500000008,298516821,27,null,null,null,null,null,null,null],[0.1631851429992821,0.16307090699999982,310048392,28,null,null,null,null,null,null,null],[0.1747862139964127,0.1746803400000001,332090436,30,null,null,null,null,null,null,null],[0.18045503400207963,0.1803195800000008,342861401,31,null,null,null,null,null,null,null],[0.19231173899606802,0.1921958280000009,365388724,33,null,null,null,null,null,null,null],[0.2039038500006427,0.20378220699999972,387412480,35,null,null,null,null,null,null,null],[0.21039060900511686,0.21022488999999922,399739724,36,null,null,null,null,null,null,null],[0.22193210600380553,0.22176617799999931,421666776,38,null,null,null,null,null,null,null],[0.2330857230044785,0.23292181699999936,442860210,40,null,null,null,null,null,null,null],[0.24479770500329323,0.24462668700000023,465112860,42,null,null,null,null,null,null,null],[0.25617124199925456,0.25600337800000084,486722943,44,null,null,null,null,null,null,null],[0.27382572499482194,0.2736053199999997,520266634,47,null,null,null,null,null,null,null],[0.28562600299483165,0.28540836500000033,542685866,49,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":1.1706234940519339e-4,"confIntUDX":8.102457807721009e-5,"confIntCL":5.0e-2},"estPoint":5.784195729887314e-2},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":1.0044644099260758e-5,"confIntUDX":5.5926182669363556e-6,"confIntCL":5.0e-2},"estPoint":0.9999927443132401},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":4.549259207879345e-4,"confIntUDX":5.647312782263292e-4,"confIntCL":5.0e-2},"estPoint":-1.3937853123716963e-4},"iters":{"estError":{"confIntLDX":1.1138027169087239e-4,"confIntUDX":8.933946864835007e-5,"confIntCL":5.0e-2},"estPoint":5.807704609456791e-2}}}],"anStdDev":{"estError":{"confIntLDX":6.698984573395927e-5,"confIntUDX":1.0250957386340848e-4,"confIntCL":5.0e-2},"estPoint":1.7121491767487851e-4},"anOutlierVar":{"ovFraction":7.638888888888888e-2,"ovDesc":"slight","ovEffect":"Slight"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[5.741071695578914e-2,5.741628100214218e-2,5.742184504849522e-2,5.742740909484826e-2,5.74329731412013e-2,5.743853718755434e-2,5.744410123390738e-2,5.7449665280260416e-2,5.7455229326613455e-2,5.7460793372966494e-2,5.746635741931953e-2,5.747192146567257e-2,5.747748551202561e-2,5.748304955837865e-2,5.748861360473169e-2,5.749417765108473e-2,5.749974169743777e-2,5.7505305743790806e-2,5.7510869790143845e-2,5.7516433836496884e-2,5.752199788284992e-2,5.752756192920296e-2,5.7533125975556e-2,5.753869002190904e-2,5.754425406826208e-2,5.754981811461512e-2,5.755538216096816e-2,5.75609462073212e-2,5.7566510253674236e-2,5.7572074300027275e-2,5.7577638346380314e-2,5.758320239273335e-2,5.758876643908639e-2,5.759433048543943e-2,5.759989453179247e-2,5.760545857814551e-2,5.761102262449855e-2,5.761658667085159e-2,5.7622150717204626e-2,5.7627714763557665e-2,5.7633278809910704e-2,5.763884285626374e-2,5.764440690261678e-2,5.764997094896982e-2,5.765553499532286e-2,5.76610990416759e-2,5.766666308802894e-2,5.767222713438198e-2,5.7677791180735016e-2,5.7683355227088055e-2,5.7688919273441094e-2,5.769448331979413e-2,5.770004736614717e-2,5.770561141250021e-2,5.771117545885325e-2,5.771673950520629e-2,5.772230355155933e-2,5.772786759791237e-2,5.773343164426541e-2,5.7738995690618446e-2,5.7744559736971485e-2,5.7750123783324524e-2,5.775568782967756e-2,5.77612518760306e-2,5.776681592238364e-2,5.777237996873668e-2,5.777794401508972e-2,5.778350806144276e-2,5.77890721077958e-2,5.7794636154148836e-2,5.7800200200501875e-2,5.7805764246854914e-2,5.781132829320795e-2,5.781689233956099e-2,5.782245638591403e-2,5.782802043226707e-2,5.783358447862011e-2,5.783914852497315e-2,5.784471257132619e-2,5.7850276617679226e-2,5.7855840664032265e-2,5.7861404710385304e-2,5.786696875673834e-2,5.787253280309138e-2,5.787809684944442e-2,5.788366089579746e-2,5.78892249421505e-2,5.789478898850354e-2,5.790035303485658e-2,5.790591708120962e-2,5.7911481127562656e-2,5.7917045173915695e-2,5.7922609220268734e-2,5.792817326662177e-2,5.793373731297481e-2,5.793930135932785e-2,5.794486540568089e-2,5.795042945203393e-2,5.795599349838697e-2,5.796155754474001e-2,5.7967121591093046e-2,5.7972685637446085e-2,5.7978249683799124e-2,5.798381373015216e-2,5.79893777765052e-2,5.799494182285824e-2,5.800050586921128e-2,5.800606991556432e-2,5.801163396191736e-2,5.80171980082704e-2,5.8022762054623436e-2,5.8028326100976475e-2,5.8033890147329514e-2,5.803945419368255e-2,5.804501824003559e-2,5.805058228638863e-2,5.805614633274167e-2,5.806171037909471e-2,5.806727442544775e-2,5.807283847180079e-2,5.807840251815383e-2,5.8083966564506866e-2,5.8089530610859905e-2,5.8095094657212944e-2,5.810065870356598e-2,5.810622274991902e-2,5.811178679627206e-2,5.81173508426251e-2],"kdeType":"time","kdePDF":[864.337780567609,864.7149663440533,865.4691143773614,866.5997771575265,868.1062822472436,869.9877308886195,872.2429961678006,874.8707207565141,877.869314254025,881.23695015743,884.9715624924057,889.0708421405709,893.5322329034202,898.3529273463608,903.5298624696674,909.0597152562005,914.9388981484232,921.1635545096367,927.729554126396,934.632488810753,941.8676681622743,949.4301155507385,957.3145643809444,965.5154547012332,974.0269302170491,982.8428357702603,991.9567153438611,1001.3618106502569,1011.0510603594689,1021.0171000213678,1031.252262733412,1041.7485806023867,1052.4977870452958,1063.491319970846,1074.7203258789777,1086.1756649115468,1097.8479168826773,1109.7273883124024,1121.8041204821538,1134.0678985252673,1146.5082615602405,1159.1145138687505,1171.8757371147092,1184.7808035946825,1197.8183905041446,1210.97699519794,1224.2449514174898,1237.6104464512014,1251.0615391888011,1264.5861790244194,1278.17222555776,1291.8074690370927,1305.4796514826935,1319.176488424201,1332.8856911807407,1346.594989608087,1360.2921552331238,1373.9650246919678,1387.6015233848482,1401.189689257703,1414.7176966180257,1428.173879890213,1441.5467572141677,1454.8250537895403,1467.9977248674795,1481.0539782913854,1493.9832964886293,1506.7754578158913,1519.4205571622201,1531.909025715667,1544.2316498018174,1556.3795887053034,1568.34439138886,1580.1180120282238,1591.6928242856093,1603.0616342491494,1614.2176919710232,1625.1547015424637,1635.8668296499902,1646.3487125634085,1656.5954615129635,1666.6026664198482,1676.3663979516655,1685.8832078817686,1695.15012773918,1704.1646657434887,1712.9248020271448,1721.428982155464,1729.6761089627587,1737.6655327309381,1745.397039744956,1752.87083926725,1760.0875489811233,1767.0481789604837,1773.7541142307196,1780.2070959925284,1786.4092015872814,1792.3628232889182,1798.0706460134295,1803.5356240426133,1808.7609568640078,1813.7500642336247,1818.5065605723607,1823.034228810673,1827.3369937992732,1831.418895406227,1835.2840614228421,1838.9366804022002,1842.3809745549881,1845.6211728275348,1848.661484286526,1851.506071933908,1854.1590270738127,1856.6243443511423,1858.9058975785972,1861.0074164655264,1862.9324643579657,1864.684417094723,1866.2664430792536,1867.6814846615316,1868.9322409180254,1870.0211519114143,1870.9503845047345,1871.7218197973543,1872.337042242516,1872.7973304982488,1873.1036500552098,1873.2566476765892]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":2,"reportName":"create/relation 10x10000","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":1,"samplesSeen":11,"lowSevere":0},"reportMeasured":[[5.802666299859993e-2,5.799217000000034e-2,110247192,1,null,null,null,null,null,null,null],[0.11603023100178689,0.11595200700000063,220455093,2,null,null,null,null,null,null,null],[0.1739662089967169,0.1738531520000013,330532285,3,null,null,null,null,null,null,null],[0.23227401099575218,0.2321224449999999,441317043,4,null,null,null,null,null,null,null],[0.2908108289993834,0.2905827829999996,552537826,5,null,null,null,null,null,null,null],[0.34785422600543825,0.34761730600000007,660920579,6,null,null,null,null,null,null,null],[0.40712012400035746,0.40688040700000094,773525905,7,null,null,null,null,null,null,null],[0.4638553500044509,0.46359462299999876,881324905,8,null,null,null,null,null,null,null],[0.5220888359981473,0.5217654560000007,991965021,9,null,null,null,null,null,null,null],[0.5797449680030695,0.5794075549999995,1101513012,10,null,null,null,null,null,null,null],[0.638773004997347,0.6383390959999993,1213664465,11,null,null,null,null,null,null,null],[0.6977926010004012,0.6972165320000006,1325803613,12,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":1.501427528155276e-4,"confIntUDX":2.7562873243145575e-4,"confIntCL":5.0e-2},"estPoint":1.448797309139284e-2},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":7.047959918693447e-4,"confIntUDX":5.488466394070191e-4,"confIntCL":5.0e-2},"estPoint":0.9988610048876899},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":2.8646289933435686e-3,"confIntUDX":3.244918023182094e-3,"confIntCL":5.0e-2},"estPoint":5.033271389983918e-4},"iters":{"estError":{"confIntLDX":2.0722653404042432e-4,"confIntUDX":2.1460011194947975e-4,"confIntCL":5.0e-2},"estPoint":1.4458875553677806e-2}}}],"anStdDev":{"estError":{"confIntLDX":2.0017124217413867e-4,"confIntUDX":3.516842285068824e-4,"confIntCL":5.0e-2},"estPoint":4.774249175945004e-4},"anOutlierVar":{"ovFraction":0.11563227985262721,"ovDesc":"moderate","ovEffect":"Moderate"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[1.3629004076506593e-2,1.3650202404333968e-2,1.367140073216134e-2,1.3692599059988715e-2,1.3713797387816088e-2,1.3734995715643463e-2,1.3756194043470836e-2,1.377739237129821e-2,1.3798590699125585e-2,1.3819789026952958e-2,1.3840987354780333e-2,1.3862185682607706e-2,1.388338401043508e-2,1.3904582338262453e-2,1.3925780666089828e-2,1.39469789939172e-2,1.3968177321744575e-2,1.398937564957195e-2,1.4010573977399323e-2,1.4031772305226698e-2,1.405297063305407e-2,1.4074168960881445e-2,1.4095367288708818e-2,1.4116565616536193e-2,1.4137763944363568e-2,1.415896227219094e-2,1.4180160600018315e-2,1.4201358927845688e-2,1.4222557255673063e-2,1.4243755583500436e-2,1.426495391132781e-2,1.4286152239155185e-2,1.4307350566982558e-2,1.4328548894809933e-2,1.4349747222637306e-2,1.437094555046468e-2,1.4392143878292053e-2,1.4413342206119428e-2,1.4434540533946803e-2,1.4455738861774176e-2,1.447693718960155e-2,1.4498135517428923e-2,1.4519333845256298e-2,1.454053217308367e-2,1.4561730500911045e-2,1.458292882873842e-2,1.4604127156565793e-2,1.4625325484393168e-2,1.464652381222054e-2,1.4667722140047915e-2,1.4688920467875288e-2,1.4710118795702663e-2,1.4731317123530038e-2,1.475251545135741e-2,1.4773713779184785e-2,1.4794912107012158e-2,1.4816110434839533e-2,1.4837308762666906e-2,1.485850709049428e-2,1.4879705418321653e-2,1.4900903746149028e-2,1.4922102073976401e-2,1.4943300401803776e-2,1.496449872963115e-2,1.4985697057458523e-2,1.5006895385285898e-2,1.5028093713113271e-2,1.5049292040940646e-2,1.5070490368768018e-2,1.5091688696595393e-2,1.5112887024422768e-2,1.513408535225014e-2,1.5155283680077515e-2,1.5176482007904888e-2,1.5197680335732263e-2,1.5218878663559636e-2,1.524007699138701e-2,1.5261275319214385e-2,1.5282473647041758e-2,1.5303671974869133e-2,1.5324870302696506e-2,1.534606863052388e-2,1.5367266958351253e-2,1.5388465286178628e-2,1.5409663614006003e-2,1.5430861941833376e-2,1.545206026966075e-2,1.5473258597488123e-2,1.5494456925315498e-2,1.5515655253142871e-2,1.5536853580970246e-2,1.555805190879762e-2,1.5579250236624993e-2,1.5600448564452368e-2,1.562164689227974e-2,1.5642845220107116e-2,1.566404354793449e-2,1.568524187576186e-2,1.5706440203589238e-2,1.572763853141661e-2,1.5748836859243984e-2,1.577003518707136e-2,1.5791233514898733e-2,1.5812431842726106e-2,1.5833630170553482e-2,1.5854828498380855e-2,1.5876026826208228e-2,1.58972251540356e-2,1.5918423481862978e-2,1.593962180969035e-2,1.5960820137517723e-2,1.5982018465345096e-2,1.6003216793172473e-2,1.6024415120999846e-2,1.604561344882722e-2,1.6066811776654595e-2,1.6088010104481968e-2,1.610920843230934e-2,1.6130406760136714e-2,1.615160508796409e-2,1.6172803415791463e-2,1.6194001743618836e-2,1.621520007144621e-2,1.6236398399273586e-2,1.625759672710096e-2,1.627879505492833e-2,1.6299993382755708e-2,1.632119171058308e-2],"kdeType":"time","kdePDF":[236.1468506342645,238.42315975933295,242.96912858425986,249.77198675890781,258.8138142621554,270.07279242351245,283.52451076567814,299.1430674014351,316.90168943873925,336.77261765772505,358.72604613157625,382.72797946098194,408.7369625833353,436.69974353713724,466.5460396403535,498.1826831747923,531.4875148321455,566.3034636291537,602.4332939206391,639.6355086652782,677.6218707076326,716.0569405724475,754.5599327746658,792.7090680628882,830.0484536556194,866.0973664698996,900.3616558446292,932.3468331312696,961.5722863992992,987.5859591179271,1009.978770149166,1028.3980345754383,1042.5591738408243,1052.255079284244,1057.3626119132182,1057.8458764597917,1053.7560896840748,1045.228059505023,1032.4734892826261,1015.7715063844435,995.4569725890917,971.9072541984668,945.5282030112918,916.7401202180627,885.9644426127243,853.6118073895211,820.0720254013871,785.7063337796247,750.8421204799047,715.7701302205685,680.7439880684003,645.9817270145621,611.6688902672513,577.9627053380816,544.9967990765202,512.8859402702265,481.73035503504656,451.6192523818604,422.6333129877053,394.8460217808541,368.32385260089035,343.1254297925042,319.29988770945994,296.88471774821517,275.9034295927156,256.36335778327094,238.25391840349252,221.5455680459126,206.18964467993428,192.11918528566417,179.25072631553067,167.48700813895317,156.72043063320865,146.83704957553374,137.7208662156558,129.2581471128136,121.34151775755043,113.87359959872839,106.77000229107666,99.96153662365278,93.39557344526342,87.03653463389456,80.86555879591435,74.87943272728975,69.08891658802744,63.516614347273304,58.19455077189301,53.161612727553226,48.46099759342363,44.13778775416025,40.236740558202534,36.80035116808556,33.86721462261318,31.4706860431445,29.637816491489335,28.388527993554806,27.734985289792334,27.681123706087906,28.222301108778947,29.345055507877436,31.02696632313282,33.23663419562585,35.93380906597205,39.069706823689295,42.58755937487617,46.42344031070433,50.507398070112885,54.76491097350307,59.118654965810116,63.49054728078228,67.80400003385625,71.9862898417851,75.97092592957311,79.6998826143421,83.12555488150204,86.21229959990345,88.93744044624657,91.29164146592449,93.278590954289,94.91398156497118,96.22382098041126,97.24215629121531,98.00834036880944,98.56400605518164,98.94994050786177,99.20306493132794,99.35372269439145,99.42346123269024]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":3,"reportName":"restrict/restrict relation 10x10000 to 10x1","reportOutliers":{"highSevere":1,"highMild":0,"lowMild":0,"samplesSeen":22,"lowSevere":0},"reportMeasured":[[1.254821499605896e-2,1.253168299999885e-2,23833172,1,null,null,null,null,null,null,null],[2.469259400095325e-2,2.4657473000001318e-2,46908325,2,null,null,null,null,null,null,null],[4.938155299896607e-2,4.931847499999975e-2,93819295,3,null,null,null,null,null,null,null],[5.7797679997747764e-2,5.77268619999991e-2,109805686,4,null,null,null,null,null,null,null],[7.035779000580078e-2,7.0287411999999e-2,133671460,5,null,null,null,null,null,null,null],[9.253486299712677e-2,9.243146399999702e-2,175809034,6,null,null,null,null,null,null,null],[0.10170249599468661,0.10158981499999697,193225303,7,null,null,null,null,null,null,null],[0.11512309200043092,0.11497926600000241,218724826,8,null,null,null,null,null,null,null],[0.12616992999392096,0.1260058870000016,239715692,9,null,null,null,null,null,null,null],[0.14971562999562593,0.14953576899999987,284452564,10,null,null,null,null,null,null,null],[0.1593516780048958,0.15915635500000036,302758476,11,null,null,null,null,null,null,null],[0.16994197700114455,0.16973221199999955,322882229,12,null,null,null,null,null,null,null],[0.19297148700570688,0.19272797600000047,366638785,13,null,null,null,null,null,null,null],[0.20395877199916868,0.20370798700000137,387512061,14,null,null,null,null,null,null,null],[0.21702719799941406,0.21678522699999903,412342135,15,null,null,null,null,null,null,null],[0.2289532409995445,0.22868242799999905,435003398,16,null,null,null,null,null,null,null],[0.25124789999972563,0.2509605150000027,477365114,17,null,null,null,null,null,null,null],[0.2602841040061321,0.25986185000000006,494530761,18,null,null,null,null,null,null,null],[0.27312203800102,0.2727749569999993,518923833,19,null,null,null,null,null,null,null],[0.2951591550008743,0.29479497700000223,560790800,20,null,null,null,null,null,null,null],[0.30637529699743027,0.3059842109999984,582103272,21,null,null,null,null,null,null,null],[0.3175946830015164,0.31720702700000203,603421740,22,null,null,null,null,null,null,null],[0.3274035539943725,0.32700220600000307,622057602,23,null,null,null,null,null,null,null],[0.36078646600071806,0.36023960700000046,685484566,25,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":1.2431711081148933e-3,"confIntUDX":6.412824709298576e-4,"confIntCL":5.0e-2},"estPoint":8.447258684075218e-2},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":3.1814620502657043e-4,"confIntUDX":1.8060952075904524e-4,"confIntCL":5.0e-2},"estPoint":0.9997530519626538},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":5.320556288099867e-3,"confIntUDX":6.507065883152455e-3,"confIntCL":5.0e-2},"estPoint":-1.3701538662041516e-3},"iters":{"estError":{"confIntLDX":9.266209026589783e-4,"confIntUDX":1.1153229224582645e-3,"confIntCL":5.0e-2},"estPoint":8.504563215758416e-2}}}],"anStdDev":{"estError":{"confIntLDX":7.89549338289093e-4,"confIntUDX":9.00270406177663e-4,"confIntCL":5.0e-2},"estPoint":1.4013810341920257e-3},"anOutlierVar":{"ovFraction":9.0e-2,"ovDesc":"slight","ovEffect":"Slight"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[8.070310981625707e-2,8.075036357653102e-2,8.079761733680496e-2,8.084487109707891e-2,8.089212485735285e-2,8.09393786176268e-2,8.098663237790076e-2,8.10338861381747e-2,8.108113989844865e-2,8.112839365872258e-2,8.117564741899654e-2,8.122290117927049e-2,8.127015493954443e-2,8.131740869981838e-2,8.136466246009232e-2,8.141191622036627e-2,8.145916998064022e-2,8.150642374091416e-2,8.155367750118811e-2,8.160093126146205e-2,8.1648185021736e-2,8.169543878200995e-2,8.174269254228389e-2,8.178994630255784e-2,8.183720006283178e-2,8.188445382310573e-2,8.193170758337968e-2,8.197896134365362e-2,8.202621510392757e-2,8.207346886420151e-2,8.212072262447546e-2,8.216797638474942e-2,8.221523014502335e-2,8.22624839052973e-2,8.230973766557124e-2,8.23569914258452e-2,8.240424518611915e-2,8.245149894639309e-2,8.249875270666704e-2,8.254600646694098e-2,8.259326022721493e-2,8.264051398748888e-2,8.268776774776282e-2,8.273502150803677e-2,8.278227526831071e-2,8.282952902858466e-2,8.287678278885861e-2,8.292403654913255e-2,8.29712903094065e-2,8.301854406968044e-2,8.30657978299544e-2,8.311305159022835e-2,8.316030535050228e-2,8.320755911077624e-2,8.325481287105017e-2,8.330206663132413e-2,8.334932039159808e-2,8.339657415187202e-2,8.344382791214597e-2,8.34910816724199e-2,8.353833543269386e-2,8.358558919296781e-2,8.363284295324175e-2,8.36800967135157e-2,8.372735047378964e-2,8.377460423406359e-2,8.382185799433753e-2,8.386911175461148e-2,8.391636551488543e-2,8.396361927515937e-2,8.401087303543332e-2,8.405812679570726e-2,8.410538055598121e-2,8.415263431625516e-2,8.41998880765291e-2,8.424714183680306e-2,8.4294395597077e-2,8.434164935735095e-2,8.43889031176249e-2,8.443615687789884e-2,8.448341063817279e-2,8.453066439844673e-2,8.457791815872068e-2,8.462517191899463e-2,8.467242567926857e-2,8.471967943954252e-2,8.476693319981646e-2,8.481418696009041e-2,8.486144072036436e-2,8.49086944806383e-2,8.495594824091225e-2,8.500320200118619e-2,8.505045576146014e-2,8.50977095217341e-2,8.514496328200803e-2,8.519221704228198e-2,8.523947080255592e-2,8.528672456282987e-2,8.533397832310383e-2,8.538123208337776e-2,8.542848584365172e-2,8.547573960392565e-2,8.55229933641996e-2,8.557024712447356e-2,8.56175008847475e-2,8.566475464502145e-2,8.571200840529539e-2,8.575926216556934e-2,8.580651592584329e-2,8.585376968611723e-2,8.590102344639118e-2,8.594827720666512e-2,8.599553096693907e-2,8.604278472721302e-2,8.609003848748696e-2,8.613729224776091e-2,8.618454600803485e-2,8.62317997683088e-2,8.627905352858276e-2,8.63263072888567e-2,8.637356104913065e-2,8.642081480940458e-2,8.646806856967854e-2,8.651532232995249e-2,8.656257609022643e-2,8.660982985050038e-2,8.665708361077432e-2,8.670433737104827e-2],"kdeType":"time","kdePDF":[92.3086773908225,92.357761886428,92.45590651832431,92.60306248601609,92.79915638482603,93.04408996321756,93.33773980261624,93.67995692261259,94.07056631511186,94.50936641166705,94.99612848886476,95.53059601724885,96.11248395983819,96.7414780268368,97.4172338936303,98.13937638961931,98.90749866584518,99.72116134972482,100.57989169551458,101.4831827393787,102.430492468132,103.42124301086862,104.4548198627676,105.53057115039063,106.64780694774748,107.8057986523098,109.00377842999379,110.2409387379196,111.51643193347834,112.82936997790614,114.17882424217945,115.5638254226023,116.98336357296606,118.43638825961767,119.92180884518928,121.43849490610339,122.98527678830536,124.5609463049578,126.16425757910008,127.79392803349742,129.4486395291201,131.1270396528686,132.82774315434182,134.54933353059192,136.2903647569761,138.0493631613498,139.82482943801733,141.61524079699913,143.41905324336705,145.23470398057296,147.06061393092673,148.89519036560333,150.7368296358464,152.58391999632633,154.43484451097473,156.28798403098938,158.14172023415975,159.99443871413416,161.84453210781078,163.6904032486151,165.5304683331085,167.3631600880728,169.1869309250239,171.00025606894118,172.80163664793898,174.58960273057647,176.36271629758048,178.1195741348641,179.85881063494068,181.5791004940798,183.2791612929059,184.95775594852157,186.61369502672306,188.24583890338815,189.85309976472294,191.4344434366877,192.98889103464302,194.51552042499648,196.01346749145253,197.48192719930077,198.9201544520853,200.32746473590544,201.7032345475745,203.0469016038301,204.357964829811,205.63598412602408,206.88057991407305,208.09143246244727,209.2682809947231,210.41092258355513,211.51921083487218,212.5930543676943,213.63241509598726,214.63730631992814,215.60779063489645,216.5439776673988,217.44602164799662,218.3141188321171,219.14850478039233,219.9494515108795,220.71726453617,221.45227979898345,222.15486052037198,222.8253939751184,223.46428820930262,224.0719687153282,224.64887507994445,225.19545762097002,225.71217402851266,226.19948602649902,226.6578560702619,227.08774409579618,227.489604336074,227.86388221952174,228.21101136538908,228.53141069030488,228.8254816397991,229.09360555799407,229.3361412080195,229.55342245500205,229.74575612270667,229.9134200340936,230.0566612451716,230.1756944806159,230.27070077864968,230.34182635169338,230.38918166824777,230.4128407604204]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":4,"reportName":"restrict/restrict relation 10x10000 to 10x5000","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":0,"samplesSeen":9,"lowSevere":1},"reportMeasured":[[8.242733500082977e-2,8.23534549999998e-2,156602833,1,null,null,null,null,null,null,null],[0.16349744900071528,0.16337303199999909,310634560,2,null,null,null,null,null,null,null],[0.259703730000183,0.2595030559999998,493428789,3,null,null,null,null,null,null,null],[0.34040561800065916,0.340130073000001,646761164,4,null,null,null,null,null,null,null],[0.4212543219982763,0.4209288019999988,800374404,5,null,null,null,null,null,null,null],[0.5070945240004221,0.5067263110000013,963471707,6,null,null,null,null,null,null,null],[0.5995631650002906,0.599115004999998,1139160942,7,null,null,null,null,null,null,null],[0.6832402630025172,0.6827478420000013,1298146922,8,null,null,null,null,null,null,null],[0.7608672300048056,0.7602914290000022,1445639167,9,null,null,null,null,null,null,null],[0.8457545939963893,0.8451073460000025,1606924694,10,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":2.241129906033184e-4,"confIntUDX":1.4726994991286387e-4,"confIntCL":5.0e-2},"estPoint":1.243577405705988e-2},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":4.874527268268203e-4,"confIntUDX":3.9628034480598817e-4,"confIntCL":5.0e-2},"estPoint":0.999248061855069},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":2.138261771143397e-3,"confIntUDX":1.7479280365314538e-3,"confIntCL":5.0e-2},"estPoint":-4.138930822500715e-3},"iters":{"estError":{"confIntLDX":1.521867184636535e-4,"confIntUDX":1.4879101356986973e-4,"confIntCL":5.0e-2},"estPoint":1.2976132037824937e-2}}}],"anStdDev":{"estError":{"confIntLDX":1.5790585736380177e-4,"confIntUDX":1.3565994085572964e-4,"confIntCL":5.0e-2},"estPoint":4.600204612133745e-4},"anOutlierVar":{"ovFraction":0.14345146934193906,"ovDesc":"moderate","ovEffect":"Moderate"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[1.1216415464752303e-2,1.1231742709670032e-2,1.1247069954587761e-2,1.1262397199505492e-2,1.1277724444423222e-2,1.129305168934095e-2,1.130837893425868e-2,1.132370617917641e-2,1.1339033424094138e-2,1.135436066901187e-2,1.1369687913929599e-2,1.1385015158847328e-2,1.1400342403765057e-2,1.1415669648682786e-2,1.1430996893600515e-2,1.1446324138518246e-2,1.1461651383435975e-2,1.1476978628353705e-2,1.1492305873271434e-2,1.1507633118189163e-2,1.1522960363106892e-2,1.1538287608024623e-2,1.1553614852942352e-2,1.1568942097860082e-2,1.158426934277781e-2,1.159959658769554e-2,1.1614923832613271e-2,1.1630251077531e-2,1.164557832244873e-2,1.1660905567366459e-2,1.1676232812284188e-2,1.1691560057201917e-2,1.1706887302119648e-2,1.1722214547037377e-2,1.1737541791955106e-2,1.1752869036872836e-2,1.1768196281790565e-2,1.1783523526708294e-2,1.1798850771626025e-2,1.1814178016543754e-2,1.1829505261461483e-2,1.1844832506379212e-2,1.1860159751296942e-2,1.187548699621467e-2,1.1890814241132402e-2,1.1906141486050131e-2,1.192146873096786e-2,1.193679597588559e-2,1.1952123220803319e-2,1.196745046572105e-2,1.1982777710638779e-2,1.1998104955556508e-2,1.2013432200474237e-2,1.2028759445391966e-2,1.2044086690309696e-2,1.2059413935227426e-2,1.2074741180145156e-2,1.2090068425062885e-2,1.2105395669980614e-2,1.2120722914898343e-2,1.2136050159816072e-2,1.2151377404733803e-2,1.2166704649651533e-2,1.2182031894569262e-2,1.2197359139486991e-2,1.221268638440472e-2,1.2228013629322451e-2,1.224334087424018e-2,1.225866811915791e-2,1.2273995364075639e-2,1.2289322608993368e-2,1.2304649853911097e-2,1.2319977098828826e-2,1.2335304343746557e-2,1.2350631588664287e-2,1.2365958833582016e-2,1.2381286078499745e-2,1.2396613323417474e-2,1.2411940568335205e-2,1.2427267813252934e-2,1.2442595058170663e-2,1.2457922303088393e-2,1.2473249548006122e-2,1.2488576792923851e-2,1.2503904037841582e-2,1.2519231282759311e-2,1.253455852767704e-2,1.254988577259477e-2,1.2565213017512499e-2,1.2580540262430228e-2,1.2595867507347959e-2,1.2611194752265688e-2,1.2626521997183417e-2,1.2641849242101147e-2,1.2657176487018876e-2,1.2672503731936607e-2,1.2687830976854336e-2,1.2703158221772065e-2,1.2718485466689794e-2,1.2733812711607524e-2,1.2749139956525253e-2,1.2764467201442982e-2,1.2779794446360713e-2,1.2795121691278442e-2,1.2810448936196171e-2,1.28257761811139e-2,1.284110342603163e-2,1.285643067094936e-2,1.287175791586709e-2,1.2887085160784819e-2,1.2902412405702548e-2,1.2917739650620277e-2,1.2933066895538008e-2,1.2948394140455738e-2,1.2963721385373467e-2,1.2979048630291196e-2,1.2994375875208925e-2,1.3009703120126654e-2,1.3025030365044384e-2,1.3040357609962114e-2,1.3055684854879844e-2,1.3071012099797573e-2,1.3086339344715302e-2,1.3101666589633031e-2,1.3116993834550762e-2,1.3132321079468491e-2,1.314764832438622e-2,1.316297556930395e-2],"kdeType":"time","kdePDF":[226.39213579040626,227.74737208286672,230.4240209777485,234.35520446525166,239.44251189763614,245.55824020542485,252.54830281977044,260.23574239210177,268.42476856524763,276.90522970074903,285.4574168248726,293.857089327339,301.88060533640714,309.3100354147814,315.9381364991158,321.5730640786122,326.04270470946744,329.1985183000614,330.91879032668004,331.11120830482804,329.7146943643358,326.70044640392877,322.07216358193614,315.8654571759498,308.1464742561771,299.0097881330211,288.5756350012319,276.9865993921043,264.4038707584309,251.00320864962754,236.9707635617167,222.4989039966407,207.78219717561993,193.01368120718084,178.38155065714358,164.06635609851597,150.23879233903116,137.05812089351653,124.67124133043687,113.21239491946292,102.80345409486672,93.55472411010112,85.56616022287774,78.92888592916546,73.72688599788663,70.03874287314144,67.93928660130277,67.50103665813326,68.79532841542114,71.89303670435095,76.86483293611263,83.78093923284351,92.71037154239649,103.71969220152411,116.87131930550787,132.22146404469964,149.8177865562957,169.69687474606908,191.8816582336357,216.3788707422337,243.17666901250362,272.2425052447056,303.52133417118614,336.9342164993303,372.37735927907704,409.721612502002,448.8124216740795,489.4702197772223,531.4912301625712,574.6486452440753,618.6941445652857,663.3597194720666,708.3597792379582,753.3935235600917,798.1475770274628,842.2988904557856,885.5179199440715,927.4720954846134,967.8295857961837,1006.2633542572273,1042.4554826658525,1076.1017161094705,1106.9161552836308,1134.6359945388488,1159.0261775156848,1179.8838203249143,1197.0422375434712,1210.374401077014,1219.7956677387433,1225.2656288821559,1226.7889642908985,1224.4152214676953,1218.237488266476,1208.3899785330054,1195.044603621632,1178.4066536929734,1158.709758016505,1136.2103299323414,1111.181727129456,1083.9083697562796,1054.6800568134404,1023.7867054776729,991.5137095872026,958.1380744126301,923.9254376202575,889.1280340279541,853.9836076027433,818.715221407658,783.5318679329476,748.629741137533,714.1939997715211,680.4008307382902,647.4196123111446,615.4149801841269,584.5486141706749,554.9805887901812,526.8701653502904,500.3759443079053,475.65534216819646,452.86340421171957,432.151010083949,413.6625709617908,397.53335207497497,383.88658063512054,372.8305150623065,364.4556557868969,358.8322705486918,356.00838847365]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":5,"reportName":"project/project 10x1000 to 1x1000","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":4,"samplesSeen":24,"lowSevere":0},"reportMeasured":[[1.1805506001110189e-2,1.1793334000000044e-2,22422097,1,null,null,null,null,null,null,null],[2.3688543995376676e-2,2.3665619999999166e-2,44998973,2,null,null,null,null,null,null,null],[3.559850100282347e-2,3.5557807e-2,67629392,3,null,null,null,null,null,null,null],[4.660554000292905e-2,4.656808600000062e-2,88522841,4,null,null,null,null,null,null,null],[5.880757200066e-2,5.875392799999801e-2,111725134,5,null,null,null,null,null,null,null],[7.08814989993698e-2,7.08285650000029e-2,134666505,6,null,null,null,null,null,null,null],[8.951854199403897e-2,8.944563700000074e-2,170086558,7,null,null,null,null,null,null,null],[0.10135353299847338,0.10126066199999784,192564595,8,null,null,null,null,null,null,null],[0.11417685800552135,0.1140760279999995,216925949,9,null,null,null,null,null,null,null],[0.1255695689978893,0.1254597309999994,238572908,10,null,null,null,null,null,null,null],[0.13713935700070579,0.13703011200000148,260557082,11,null,null,null,null,null,null,null],[0.14897361699695466,0.1488434130000016,283042615,12,null,null,null,null,null,null,null],[0.16108048299793154,0.16094834200000108,306044257,13,null,null,null,null,null,null,null],[0.1797490840035607,0.17961487999999903,341513638,14,null,null,null,null,null,null,null],[0.19128122000256553,0.19112937800000296,363427079,15,null,null,null,null,null,null,null],[0.2028727059951052,0.20270760100000018,385452590,16,null,null,null,null,null,null,null],[0.21521219300484518,0.2150410849999993,408892984,17,null,null,null,null,null,null,null],[0.22753583099984098,0.22735460599999868,432309224,18,null,null,null,null,null,null,null],[0.23789910299819894,0.23770649300000102,452001413,19,null,null,null,null,null,null,null],[0.25045923499419587,0.2502648369999996,475864654,20,null,null,null,null,null,null,null],[0.26928186200530035,0.2690656770000004,511629312,21,null,null,null,null,null,null,null],[0.2863831520007807,0.28614335399999646,544120390,22,null,null,null,null,null,null,null],[0.3001085560026695,0.2998305869999953,570198325,23,null,null,null,null,null,null,null],[0.31689061599900015,0.3166167309999963,602084550,25,null,null,null,null,null,null,null],[0.33565128299960634,0.335338225000001,637727896,26,null,null,null,null,null,null,null],[0.3474145780055551,0.3470547940000017,660078787,27,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":2.0214769761556922e-4,"confIntUDX":1.4848505751438416e-4,"confIntCL":5.0e-2},"estPoint":1.547382196820991e-2},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":3.8860730800849286e-4,"confIntUDX":3.083141884447915e-4,"confIntCL":5.0e-2},"estPoint":0.9994214827754374},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":2.459566718063007e-3,"confIntUDX":1.8356311328678744e-3,"confIntCL":5.0e-2},"estPoint":-3.352632585310556e-3},"iters":{"estError":{"confIntLDX":1.8636327388533297e-4,"confIntUDX":1.8116858527507038e-4,"confIntCL":5.0e-2},"estPoint":1.596884111763632e-2}}}],"anStdDev":{"estError":{"confIntLDX":1.1049259965506493e-4,"confIntUDX":1.2695701096172553e-4,"confIntCL":5.0e-2},"estPoint":3.978143402171812e-4},"anOutlierVar":{"ovFraction":4.1587901701323225e-2,"ovDesc":"slight","ovEffect":"Slight"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[1.449190814844687e-2,1.450530902167609e-2,1.451870989490531e-2,1.453211076813453e-2,1.454551164136375e-2,1.4558912514592971e-2,1.4572313387822191e-2,1.4585714261051411e-2,1.4599115134280631e-2,1.4612516007509851e-2,1.4625916880739071e-2,1.4639317753968291e-2,1.4652718627197511e-2,1.4666119500426731e-2,1.4679520373655951e-2,1.4692921246885171e-2,1.4706322120114391e-2,1.4719722993343612e-2,1.4733123866572832e-2,1.4746524739802052e-2,1.4759925613031272e-2,1.4773326486260492e-2,1.4786727359489712e-2,1.4800128232718932e-2,1.4813529105948152e-2,1.4826929979177372e-2,1.4840330852406592e-2,1.4853731725635812e-2,1.4867132598865032e-2,1.4880533472094252e-2,1.4893934345323472e-2,1.4907335218552692e-2,1.4920736091781912e-2,1.4934136965011132e-2,1.4947537838240352e-2,1.4960938711469573e-2,1.4974339584698793e-2,1.4987740457928013e-2,1.5001141331157233e-2,1.5014542204386453e-2,1.5027943077615673e-2,1.5041343950844893e-2,1.5054744824074113e-2,1.5068145697303333e-2,1.5081546570532553e-2,1.5094947443761773e-2,1.5108348316990993e-2,1.5121749190220213e-2,1.5135150063449433e-2,1.5148550936678653e-2,1.5161951809907873e-2,1.5175352683137093e-2,1.5188753556366313e-2,1.5202154429595533e-2,1.5215555302824754e-2,1.5228956176053974e-2,1.5242357049283194e-2,1.5255757922512414e-2,1.5269158795741634e-2,1.5282559668970854e-2,1.5295960542200074e-2,1.5309361415429296e-2,1.5322762288658514e-2,1.5336163161887736e-2,1.5349564035116954e-2,1.5362964908346176e-2,1.5376365781575394e-2,1.5389766654804616e-2,1.5403167528033834e-2,1.5416568401263056e-2,1.5429969274492276e-2,1.5443370147721496e-2,1.5456771020950716e-2,1.5470171894179936e-2,1.5483572767409156e-2,1.5496973640638376e-2,1.5510374513867596e-2,1.5523775387096816e-2,1.5537176260326037e-2,1.5550577133555257e-2,1.5563978006784477e-2,1.5577378880013697e-2,1.5590779753242917e-2,1.5604180626472137e-2,1.5617581499701357e-2,1.5630982372930577e-2,1.5644383246159795e-2,1.5657784119389017e-2,1.5671184992618235e-2,1.5684585865847457e-2,1.5697986739076675e-2,1.5711387612305897e-2,1.5724788485535116e-2,1.5738189358764337e-2,1.5751590231993556e-2,1.5764991105222777e-2,1.5778391978451996e-2,1.5791792851681218e-2,1.5805193724910436e-2,1.5818594598139658e-2,1.5831995471368876e-2,1.5845396344598098e-2,1.5858797217827316e-2,1.5872198091056538e-2,1.5885598964285756e-2,1.5898999837514978e-2,1.5912400710744196e-2,1.5925801583973418e-2,1.5939202457202636e-2,1.5952603330431858e-2,1.5966004203661077e-2,1.59794050768903e-2,1.5992805950119517e-2,1.600620682334874e-2,1.6019607696577957e-2,1.603300856980718e-2,1.6046409443036397e-2,1.605981031626562e-2,1.6073211189494837e-2,1.608661206272406e-2,1.6100012935953277e-2,1.61134138091825e-2,1.612681468241172e-2,1.614021555564094e-2,1.6153616428870157e-2,1.616701730209938e-2,1.61804181753286e-2,1.619381904855782e-2],"kdeType":"time","kdePDF":[339.3394652798866,339.3398040126309,339.3376431288003,339.32739669237077,339.3009102922482,339.247723764681,339.1554106367999,339.00998549878693,338.79636892038155,338.49889829347273,338.1018721352799,337.5901149363349,336.94954957576823,336.16776462767433,335.2345645060762,334.14249128978645,332.8873081718342,331.4684357265141,329.8893335161033,328.15782090850354,326.28633229362185,324.29210312771494,322.19728437090976,320.02898389675147,317.8192343401486,315.60488762010215,313.42743704500253,311.3327685078397,309.3708428377909,307.5953119260009,306.063071817416,304.83375658235536,303.9691774679016,303.5327125867404,303.58865322460764,304.2015137198996,305.4353127616136,307.35283482599084,310.0148812816948,313.47952138699367,317.80135392797513,323.03079055437377,329.2133719156,336.3891274498759,344.59198911288667,353.84926844237333,364.18120515195346,375.600593957622,388.11249460737326,401.7140281656252,416.39426057011894,432.1341724082433,448.9067118368043,466.67692567837355,485.4021620501326,505.0323364901117,525.5102525026635,546.771966795203,568.7471892504013,591.3597078800761,614.5278296281449,638.1648288983123,662.1793970288159,686.4760875553643,710.9557539166747,735.5159781763992,760.0514912686873,784.4545871277792,808.6155347452408,832.4229936279593,855.7644392343634,878.5266056863712,900.595953348804,921.8591687111609,942.2037033933608,961.518358039165,979.6939153894958,996.6238249891242,1012.2049398364882,1026.338302911342,1038.929978992983,1049.8919246034288,1059.1428863703215,1066.6093156988043,1072.2262854638248,1075.9383925720354,1077.7006287758888,1077.4792011204433,1075.2522829217874,1071.0106762550165,1064.7583675925548,1056.5129594848056,1046.3059629998363,1034.1829380025176,1020.2034712023833,1004.4409851613746,986.9823750386817,967.9274736572588,947.3883493909525,925.4884452710058,902.361571470757,878.1507668237224,853.0070481445114,827.0880687462661,800.5567095891997,773.5796278778657,746.3257885974294,718.965004413615,691.6665085553291,664.5975837782671,637.9222683231118,611.8001570089538,586.3853123385799,561.8252968530317,538.260334087611,515.8226014887058,494.6356546921212,474.81397877906545,456.46265864814916,439.67715759127947,424.5431906418146,411.13667735818353,399.523757475057,389.7608523315806,381.89475517986835,375.9627343682566,371.9926349382536,370.00296630346537]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":6,"reportName":"project/project 10x1000 to 5x1000","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":0,"samplesSeen":21,"lowSevere":0},"reportMeasured":[[1.507493200188037e-2,1.506444999999701e-2,28631577,1,null,null,null,null,null,null,null],[3.0044839993934147e-2,3.0011522999998874e-2,57076332,2,null,null,null,null,null,null,null],[4.602774199884152e-2,4.5973276000005114e-2,87445137,3,null,null,null,null,null,null,null],[5.9625961002893746e-2,5.957763600000021e-2,113280994,4,null,null,null,null,null,null,null],[7.525645900022937e-2,7.519037400000173e-2,142976086,5,null,null,null,null,null,null,null],[8.905667799990624e-2,8.897487000000126e-2,169198952,6,null,null,null,null,null,null,null],[0.11078702899976633,0.11069898400000255,210485926,7,null,null,null,null,null,null,null],[0.12581275300181005,0.12570637000000318,239036957,8,null,null,null,null,null,null,null],[0.14042515800247202,0.14030637199999774,266800371,9,null,null,null,null,null,null,null],[0.15486334200249985,0.15474121999999824,294230327,10,null,null,null,null,null,null,null],[0.16949182599637425,0.16934615400000297,322026203,11,null,null,null,null,null,null,null],[0.18458782800007612,0.1844472820000007,350709797,12,null,null,null,null,null,null,null],[0.2069304859978729,0.20675212399999765,393162950,13,null,null,null,null,null,null,null],[0.22282338000513846,0.22255065099999882,423354484,14,null,null,null,null,null,null,null],[0.237528261000989,0.23732342799999628,451294459,15,null,null,null,null,null,null,null],[0.25102039399644127,0.2507945950000021,476930577,16,null,null,null,null,null,null,null],[0.26663147199724335,0.2664183879999982,506590187,17,null,null,null,null,null,null,null],[0.28122573099972215,0.280993083999995,534320598,18,null,null,null,null,null,null,null],[0.295340610005951,0.2950916140000004,561138070,19,null,null,null,null,null,null,null],[0.31776399700174807,0.3175341020000033,603742588,20,null,null,null,null,null,null,null],[0.3324330129980808,0.3321678370000001,631612507,21,null,null,null,null,null,null,null],[0.34725084000092465,0.3469759039999971,659767266,22,null,null,null,null,null,null,null],[0.37028686700068647,0.3699242579999975,703537082,23,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":1.4849515604026947e-4,"confIntUDX":2.2302267966680528e-4,"confIntCL":5.0e-2},"estPoint":4.923173514046889e-2},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":1.0446290147780868e-4,"confIntUDX":9.674844257745452e-5,"confIntCL":5.0e-2},"estPoint":0.9998833768007424},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":2.259559006627959e-3,"confIntUDX":1.93476793690426e-3,"confIntCL":5.0e-2},"estPoint":8.529011135507786e-4},"iters":{"estError":{"confIntLDX":3.400703549832976e-4,"confIntUDX":3.762902771172333e-4,"confIntCL":5.0e-2},"estPoint":4.922073172017738e-2}}}],"anStdDev":{"estError":{"confIntLDX":1.1789626053074169e-4,"confIntUDX":1.7027737094845103e-4,"confIntCL":5.0e-2},"estPoint":3.275115670368287e-4},"anOutlierVar":{"ovFraction":7.100591715976319e-2,"ovDesc":"slight","ovEffect":"Slight"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[4.8763763595693385e-2,4.877421973183179e-2,4.8784675867970195e-2,4.87951320041086e-2,4.8805588140247005e-2,4.881604427638541e-2,4.8826500412523816e-2,4.883695654866222e-2,4.884741268480062e-2,4.8857868820939024e-2,4.886832495707743e-2,4.8878781093215834e-2,4.888923722935424e-2,4.8899693365492644e-2,4.891014950163105e-2,4.8920605637769454e-2,4.893106177390786e-2,4.8941517910046264e-2,4.895197404618467e-2,4.8962430182323075e-2,4.897288631846148e-2,4.8983342454599885e-2,4.899379859073828e-2,4.900425472687669e-2,4.901471086301509e-2,4.90251669991535e-2,4.90356231352919e-2,4.904607927143031e-2,4.905653540756871e-2,4.906699154370712e-2,4.907744767984552e-2,4.908790381598393e-2,4.9098359952122334e-2,4.910881608826074e-2,4.9119272224399144e-2,4.912972836053755e-2,4.914018449667595e-2,4.915064063281435e-2,4.916109676895276e-2,4.917155290509116e-2,4.918200904122957e-2,4.919246517736797e-2,4.920292131350638e-2,4.921337744964478e-2,4.922383358578319e-2,4.923428972192159e-2,4.924474585806e-2,4.92552019941984e-2,4.926565813033681e-2,4.927611426647521e-2,4.928657040261361e-2,4.9297026538752016e-2,4.930748267489042e-2,4.9317938811028826e-2,4.932839494716723e-2,4.9338851083305636e-2,4.934930721944404e-2,4.9359763355582446e-2,4.937021949172085e-2,4.9380675627859257e-2,4.939113176399766e-2,4.940158790013607e-2,4.941204403627447e-2,4.942250017241288e-2,4.9432956308551275e-2,4.944341244468968e-2,4.9453868580828085e-2,4.946432471696649e-2,4.9474780853104895e-2,4.94852369892433e-2,4.9495693125381705e-2,4.950614926152011e-2,4.9516605397658515e-2,4.952706153379692e-2,4.9537517669935326e-2,4.954797380607373e-2,4.9558429942212136e-2,4.956888607835054e-2,4.957934221448894e-2,4.9589798350627344e-2,4.960025448676575e-2,4.9610710622904154e-2,4.962116675904256e-2,4.9631622895180964e-2,4.964207903131937e-2,4.9652535167457774e-2,4.966299130359618e-2,4.9673447439734585e-2,4.968390357587299e-2,4.9694359712011395e-2,4.97048158481498e-2,4.9715271984288205e-2,4.97257281204266e-2,4.973618425656501e-2,4.974664039270341e-2,4.975709652884182e-2,4.976755266498022e-2,4.977800880111863e-2,4.978846493725703e-2,4.979892107339544e-2,4.9809377209533844e-2,4.981983334567225e-2,4.9830289481810654e-2,4.984074561794906e-2,4.9851201754087464e-2,4.986165789022587e-2,4.987211402636427e-2,4.988257016250267e-2,4.989302629864108e-2,4.990348243477948e-2,4.991393857091789e-2,4.992439470705629e-2,4.99348508431947e-2,4.99453069793331e-2,4.995576311547151e-2,4.996621925160991e-2,4.997667538774832e-2,4.998713152388672e-2,4.999758766002513e-2,5.000804379616353e-2,5.001849993230194e-2,5.0028956068440336e-2,5.003941220457874e-2,5.0049868340717146e-2,5.006032447685555e-2,5.0070780612993956e-2,5.008123674913236e-2,5.009169288527077e-2],"kdeType":"time","kdePDF":[1098.1507885487008,1097.9619233817857,1097.5842312136772,1097.0177886927365,1096.2627115819625,1095.3191557024065,1094.1873181825406,1092.867439006317,1091.3598028509393,1089.6647412036432,1087.7826347451623,1085.7139159859626,1083.459072139828,1081.018648217944,1078.3932503252845,1075.5835491398614,1072.590283554232,1069.4142644576223,1066.0563786360883,1062.5175927672994,1058.7989574858525,1054.9016114944125,1050.8267856955515,1046.5758073188047,1042.150104017285,1037.551207908116,1032.780759531016,1027.8405116995527,1022.732333219919,1017.4582124525269,1012.0202606922909,1006.4207153441816,1000.6619428714358,994.746441494759,988.6768436218823,982.4559179880054,976.0865714888894,969.5718506897206,962.9149429942818,956.1191774604987,949.1880252499767,942.1250997008403,934.9341560148293,927.6190905514208,920.1839397234736,912.6328784907797,904.9702184496759,897.2004055188036,889.3280172228839,881.3577595783024,873.2944635860681,865.1430813395881,856.9086817564133,848.596445944922,840.2116622185147,831.7597207716074,823.2461080331823,814.6764007152273,806.0562595747128,797.3914229091496,788.687699806899,779.9509631746153,771.1871425650936,762.4022168298012,753.6022066210252,744.7931667693202,735.9811785623662,727.1723419518214,718.3727677149313,709.5885695978602,700.8258564676222,692.0907244994243,683.38924942587,674.7274788741564,666.1114248167496,657.5470561604609,649.0402914979433,640.5969920448158,632.2229547844832,623.9239058416803,615.7054941044108,607.5732851127132,599.5327552311303,591.5892861203489,583.7481595217655,576.0145523671652,568.3935322238881,560.8900530841606,553.5089515053812,546.254943106383,539.1326194227606,532.1464451225471,525.3007555816087,518.5997548163084,512.0475137691359,505.6479689412247,499.4049213639129,493.32203589982515,487.4028408623033,481.6507279404777,476.0689524157841,470.6606336543614,465.42875585847673,460.3761690589644,455.50559032959774,450.8196052033888,446.3206692699979,442.01110993275995,437.89312830330215,433.96880121131943,430.2400833068271,426.7088092320881,423.37669584045085,420.245344439502,417.31624303626484,414.59076856262493,412.07018905977213,409.75566580116725,407.6482553344219,405.74891142344734,404.0584868733492,402.5777352217515,401.30731228155986,400.2477775215805,399.3995952729278,398.7631357507153,398.33867588218374,398.1263999341119]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":7,"reportName":"union/union identical 10x1000","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":0,"samplesSeen":12,"lowSevere":0},"reportMeasured":[[5.00213889972656e-2,4.998460699999896e-2,95031185,1,null,null,null,null,null,null,null],[0.10105308899801457,0.10095891699999981,191990889,2,null,null,null,null,null,null,null],[0.14932909200433642,0.1491997110000014,283717109,3,null,null,null,null,null,null,null],[0.19788539900036994,0.19771486700000196,375970752,4,null,null,null,null,null,null,null],[0.245552549000422,0.24537460400000555,466539415,5,null,null,null,null,null,null,null],[0.29433757099468494,0.2941104770000038,559233974,6,null,null,null,null,null,null,null],[0.3468570469995029,0.34655869999999567,659019788,7,null,null,null,null,null,null,null],[0.39563732800161233,0.3953240969999996,751698269,8,null,null,null,null,null,null,null],[0.4421533890053979,0.4418359009999975,840083885,9,null,null,null,null,null,null,null],[0.4914517830038676,0.49105002900000017,933750741,10,null,null,null,null,null,null,null],[0.5395605520025128,0.5391937190000036,1025155452,11,null,null,null,null,null,null,null],[0.5905701550000231,0.590161234,1122074516,12,null,null,null,null,null,null,null],[0.6457649580042926,0.645225259,1226945092,13,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":1.3616114131957957e-3,"confIntUDX":6.192009813513755e-4,"confIntCL":5.0e-2},"estPoint":0.5157808375258943},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":5.2562411323342495e-5,"confIntUDX":2.078751864043049e-5,"confIntCL":5.0e-2},"estPoint":0.9999792124813596},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":1.5438998001626996e-2,"confIntUDX":9.506022004642714e-3,"confIntCL":5.0e-2},"estPoint":3.1666350041647164e-3},"iters":{"estError":{"confIntLDX":6.950864203099427e-3,"confIntUDX":5.521645800035779e-3,"confIntCL":5.0e-2},"estPoint":0.5155792741992622}}}],"anStdDev":{"estError":{"confIntLDX":1.1935851498586624e-3,"confIntUDX":9.230743816508865e-5,"confIntCL":5.0e-2},"estPoint":1.1935851498586624e-3},"anOutlierVar":{"ovFraction":0.18749999999999997,"ovDesc":"moderate","ovEffect":"Moderate"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[0.5141965029831452,0.5142175476882999,0.5142385923934545,0.5142596370986091,0.5142806818037639,0.5143017265089185,0.5143227712140731,0.5143438159192277,0.5143648606243824,0.514385905329537,0.5144069500346917,0.5144279947398464,0.514449039445001,0.5144700841501556,0.5144911288553102,0.5145121735604649,0.5145332182656196,0.5145542629707742,0.5145753076759289,0.5145963523810835,0.5146173970862381,0.5146384417913927,0.5146594864965475,0.5146805312017021,0.5147015759068567,0.5147226206120114,0.514743665317166,0.5147647100223206,0.5147857547274753,0.51480679943263,0.5148278441377846,0.5148488888429392,0.5148699335480938,0.5148909782532485,0.5149120229584032,0.5149330676635578,0.5149541123687125,0.5149751570738671,0.5149962017790217,0.5150172464841763,0.5150382911893311,0.5150593358944857,0.5150803805996403,0.515101425304795,0.5151224700099496,0.5151435147151042,0.515164559420259,0.5151856041254136,0.5152066488305682,0.5152276935357228,0.5152487382408775,0.5152697829460321,0.5152908276511868,0.5153118723563415,0.5153329170614961,0.5153539617666507,0.5153750064718053,0.51539605117696,0.5154170958821147,0.5154381405872693,0.515459185292424,0.5154802299975786,0.5155012747027332,0.5155223194078878,0.5155433641130426,0.5155644088181972,0.5155854535233518,0.5156064982285065,0.5156275429336611,0.5156485876388157,0.5156696323439705,0.5156906770491251,0.5157117217542797,0.5157327664594343,0.515753811164589,0.5157748558697436,0.5157959005748983,0.515816945280053,0.5158379899852076,0.5158590346903622,0.5158800793955168,0.5159011241006715,0.5159221688058262,0.5159432135109808,0.5159642582161355,0.5159853029212901,0.5160063476264447,0.5160273923315993,0.5160484370367541,0.5160694817419087,0.5160905264470633,0.516111571152218,0.5161326158573726,0.5161536605625272,0.5161747052676819,0.5161957499728366,0.5162167946779912,0.5162378393831458,0.5162588840883005,0.5162799287934551,0.5163009734986098,0.5163220182037644,0.5163430629089191,0.5163641076140737,0.5163851523192283,0.516406197024383,0.5164272417295377,0.5164482864346923,0.5164693311398469,0.5164903758450016,0.5165114205501562,0.5165324652553108,0.5165535099604656,0.5165745546656202,0.5165955993707748,0.5166166440759294,0.5166376887810841,0.5166587334862387,0.5166797781913934,0.5167008228965481,0.5167218676017027,0.5167429123068573,0.5167639570120119,0.5167850017171666,0.5168060464223213,0.5168270911274759,0.5168481358326306,0.5168691805377852],"kdeType":"time","kdePDF":[309.38802057513465,309.4023860102444,309.4311682114648,309.4744696620986,309.53244364083116,309.60529368755556,309.69327289338037,309.7966830167308,309.9158734279286,310.0512398850909,310.2032231446485,310.372307410227,310.5590186240712,310.7639226056174,310.98762304223067,311.2307593375253,311.49400432306555,311.7780618396215,312.08366419450016,312.411569501812,312.7625589128479,313.1374337440434,313.5370125102792,313.96212787153473,314.4136235011376,314.89235088407736,315.39916605403647,315.9349262779685,316.50048669719547,317.0966969341247,317.72439767378035,318.38441722942645,319.0775681016053,319.80464353994586,320.5664141170984,321.3636243241323,322.1969891966887,323.0671909811095,323.97487584967564,324.92065067396595,325.9050798652177,326.9286822903981,327.9919282725238,329.09523668354973,330.2389721379345,331.42344229472934,332.6488952757878,333.91551720739204,335.2234298923045,336.57268861891947,337.9632801138653,339.39512064404335,340.8680542737363,342.3818512820254,343.9362067453748,345.53073928982553,347.16499001684133,348.8384216064042,350.5504176005491,352.3002818700631,354.0872382666488,355.9104304623841,357.7689219778728,359.66169640000106,361.5876577897826,363.5456312802869,365.5343638642128,367.5525253701911,369.59870962646096,371.6714358101026,373.76914997957715,375.890226787867,378.0329713731015,380.1956214231029,382.3763494098983,384.57326498981644,386.78441756441356,389.00779899707237,391.24134647977047,393.4829455441344,395.7304332105799,397.98160126899035,400.23419968409394,402.48594011838867,404.734499565207,406.977524084232,409.2126326315558,411.4374209761309,413.6494656942786,415.8463282337186,418.025559038435,420.18470172553765,422.3212973051635,424.43288843435346,426.5170236957626,428.5712618919959,430.5931763463266,432.5803592005279,434.5304257005582,436.44101846085346,438.3098116980315,440.13451542486933,441.91287959550385,443.64269819290615,445.3218132498055,446.9481187943808,448.51956471220046,450.034160516072,451.48997901566054,452.8851598789545,454.2179130778891,455.48652221068966,456.6893476937622,457.82482981624395,458.89149165062054,459.88794181312977,460.8128770679966,461.66508476988133,462.44344513927086,463.1469333659088,463.7746215357259,464.32568037711644,464.7993808227955,465.19509538387194,465.5122993331701,465.7505716952569,465.9095960410329,465.9891610851808]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":8,"reportName":"union/union identical 10x10000","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":0,"samplesSeen":3,"lowSevere":0},"reportMeasured":[[0.5213010670049698,0.5209129200000007,990462359,1,null,null,null,null,null,null,null],[1.029929477001133,1.0291960659999972,1956856394,2,null,null,null,null,null,null,null],[1.5510303970004315,1.5498950729999947,2946947849,3,null,null,null,null,null,null,null],[2.066198341002746,2.064697297000002,3925769673,4,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":1.9136268846312587e-3,"confIntUDX":1.0778112309037247e-3,"confIntCL":5.0e-2},"estPoint":0.3374978199984254},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":7.048604004911141e-7,"confIntUDX":9.653846087087636e-6,"confIntCL":5.0e-2},"estPoint":0.9999903461539129},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":3.7081885020606234e-3,"confIntUDX":7.930082494565614e-3,"confIntCL":5.0e-2},"estPoint":-1.5550898497166503e-2},"iters":{"estError":{"confIntLDX":2.273477398556878e-3,"confIntUDX":2.4901846016293083e-3,"confIntCL":5.0e-2},"estPoint":0.3432690643996462}}}],"anStdDev":{"estError":{"confIntLDX":1.6965376723717264e-3,"confIntUDX":1.702861405217474e-4,"confIntCL":5.0e-2},"estPoint":1.6965376723717264e-3},"anOutlierVar":{"ovFraction":0.1875,"ovDesc":"moderate","ovEffect":"Moderate"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[0.335260849744523,0.335291401873903,0.3353219540032829,0.3353525061326629,0.3353830582620428,0.33541361039142276,0.3354441625208027,0.33547471465018264,0.3355052667795626,0.3355358189089425,0.3355663710383225,0.33559692316770245,0.33562747529708237,0.33565802742646234,0.33568857955584225,0.3357191316852222,0.3357496838146022,0.3357802359439821,0.33581078807336207,0.335841340202742,0.33587189233212195,0.3359024444615019,0.3359329965908818,0.3359635487202618,0.3359941008496417,0.3360246529790217,0.33605520510840164,0.33608575723778156,0.3361163093671615,0.33614686149654144,0.3361774136259214,0.3362079657553014,0.3362385178846813,0.33626907001406126,0.33629962214344117,0.33633017427282114,0.3363607264022011,0.336391278531581,0.336421830660961,0.3364523827903409,0.33648293491972087,0.33651348704910083,0.33654403917848075,0.3365745913078607,0.33660514343724063,0.3366356955666206,0.33666624769600056,0.3366967998253805,0.33672735195476045,0.33675790408414036,0.3367884562135203,0.3368190083429003,0.3368495604722802,0.3368801126016602,0.3369106647310401,0.33694121686042006,0.3369717689898,0.33700232111917994,0.3370328732485599,0.3370634253779398,0.3370939775073198,0.3371245296366997,0.33715508176607967,0.33718563389545964,0.33721618602483955,0.3372467381542195,0.33727729028359943,0.3373078424129794,0.33733839454235937,0.3373689466717393,0.33739949880111925,0.33743005093049916,0.3374606030598791,0.3374911551892591,0.337521707318639,0.337552259448019,0.3375828115773989,0.33761336370677886,0.3376439158361588,0.33767446796553874,0.3377050200949187,0.3377355722242986,0.3377661243536786,0.33779667648305856,0.33782722861243847,0.33785778074181844,0.33788833287119835,0.3379188850005783,0.3379494371299583,0.3379799892593382,0.33801054138871817,0.3380410935180981,0.33807164564747805,0.338102197776858,0.33813274990623793,0.3381633020356179,0.3381938541649978,0.3382244062943778,0.33825495842375775,0.33828551055313766,0.3383160626825176,0.33834661481189754,0.3383771669412775,0.3384077190706575,0.3384382712000374,0.33846882332941736,0.33849937545879727,0.33852992758817724,0.3385604797175572,0.3385910318469371,0.3386215839763171,0.338652136105697,0.33868268823507697,0.33871324036445694,0.33874379249383685,0.3387743446232168,0.33880489675259673,0.3388354488819767,0.33886600101135667,0.3388965531407366,0.33892710527011655,0.33895765739949646,0.3389882095288764,0.3390187616582564,0.3390493137876363,0.3390798659170163,0.3391104180463962,0.33914097017577616],"kdeType":"time","kdePDF":[218.94440967899624,218.95328792946546,218.97107464851806,218.99783016481234,219.03364470271197,219.07863806077597,219.13295918447588,219.19678563433106,219.27032295094506,219.35380391871573,219.4474877302688,219.55165905394765,219.6666270069562,219.79272403701768,219.9303047156654,220.07974444652592,220.241438092194,220.415798523521,220.60325509535545,220.80425205297948,221.01924687367185,221.24870854801384,221.49311580571535,221.75295529089485,222.02871969188413,222.32090583075617,222.63001271788212,222.95653957692352,223.30098384574237,223.66383915878296,224.04559331652538,224.4467262476503,224.867707969572,225.30899655300368,225.77103609620795,226.25425471455912,226.75906255100557,227.28584981296243,227.83498484109774,228.40681221538733,229.0016509037195,229.61979245821323,230.2614992642938,230.92700284742511,231.6165022422535,232.33016242874683,233.0681128397482,233.8304459441655,234.61721590983643,235.42843734988787,236.26408415620688,237.12408842340642,238.00833946644545,238.91668293481632,239.84892002597644,240.80480680043843,241.78405360068845,242.78632457582972,243.8112373135947,244.85836258108932,245.92722417537553,247.01729888471294,248.12801656102025,249.25876030383247,250.40886675576718,251.5776265092326,252.76428462384968,253.96804125378225,255.18805238391855,256.4234306735713,257.67324640612435,258.93652854278633,260.21226587838197,261.4994082968573,262.79686812395653,264.1035215742887,265.41821028979865,266.73974296643223,268.0668970655977,269.3984206068207,270.73303403781875,272.0694321780345,273.4062862315169,274.7422458648741,276.0759413458871,277.4059857382356,278.7309771476714,280.0495010148576,281.3601324500009,282.6614386043089,283.9519810732365,285.23031832641135,286.49500815908596,287.7446101599129,288.97768818981825,290.19281286672356,291.3885640508648,292.5635333254589,293.7163264674862,294.84556590338235,295.9498931444749,297.02797119704576,298.0784869419626,299.100153478892,300.09171243018943,301.05193619964774,301.97963018139274,302.87363491431853,303.73282817757786,304.5561270227706,305.3424897386085,306.09091774398223,306.80045740550736,307.47020177578815,308.09929224880443,308.686920129005,309.23232811086694,309.7348116658736,310.19372033405386,310.6084589174242,310.97848857288096,311.30332780229577,311.5825533377822,311.81580092031595,312.00276597011117,312.1432041473806,312.2369318023264,312.2838263134446]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":9,"reportName":"join/join identical 10x100","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":0,"samplesSeen":3,"lowSevere":0},"reportMeasured":[[0.32650016200204846,0.32622583200000577,620340770,1,null,null,null,null,null,null,null],[0.6722594110033242,0.6717048900000009,1277284362,2,null,null,null,null,null,null,null],[1.0153659450006671,1.014700420000004,1929185516,3,null,null,null,null,null,null,null],[1.3563615320017561,1.3553818119999974,2577077214,4,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":3.73601811220009e-4,"confIntUDX":4.425636919137138e-4,"confIntCL":5.0e-2},"estPoint":4.70336206675725e-2},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":2.663144455224975e-4,"confIntUDX":1.9416582717446396e-4,"confIntCL":5.0e-2},"estPoint":0.9997071105510539},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":3.720208282599045e-3,"confIntUDX":4.150284022617402e-3,"confIntCL":5.0e-2},"estPoint":1.1118184998988514e-3},"iters":{"estError":{"confIntLDX":6.232093546506001e-4,"confIntUDX":4.343548663097649e-4,"confIntCL":5.0e-2},"estPoint":4.700242177468782e-2}}}],"anStdDev":{"estError":{"confIntLDX":2.210909475749965e-4,"confIntUDX":4.015261754837878e-4,"confIntCL":5.0e-2},"estPoint":7.389605929837668e-4},"anOutlierVar":{"ovFraction":7.100591715976322e-2,"ovDesc":"slight","ovEffect":"Slight"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[4.5342716617225436e-2,4.537034085307174e-2,4.5397965088918045e-2,4.542558932476435e-2,4.5453213560610654e-2,4.548083779645696e-2,4.5508462032303264e-2,4.553608626814957e-2,4.556371050399587e-2,4.559133473984218e-2,4.561895897568848e-2,4.564658321153479e-2,4.567420744738109e-2,4.57018316832274e-2,4.57294559190737e-2,4.5757080154920006e-2,4.578470439076631e-2,4.5812328626612615e-2,4.583995286245892e-2,4.5867577098305225e-2,4.589520133415153e-2,4.592282556999783e-2,4.595044980584413e-2,4.597807404169044e-2,4.600569827753674e-2,4.6033322513383046e-2,4.606094674922935e-2,4.6088570985075655e-2,4.611619522092196e-2,4.6143819456768265e-2,4.617144369261457e-2,4.6199067928460874e-2,4.622669216430718e-2,4.625431640015348e-2,4.628194063599979e-2,4.630956487184609e-2,4.63371891076924e-2,4.63648133435387e-2,4.639243757938501e-2,4.642006181523131e-2,4.6447686051077616e-2,4.647531028692392e-2,4.6502934522770226e-2,4.653055875861653e-2,4.6558182994462835e-2,4.658580723030914e-2,4.6613431466155444e-2,4.664105570200175e-2,4.6668679937848054e-2,4.669630417369436e-2,4.672392840954066e-2,4.675155264538697e-2,4.677917688123327e-2,4.680680111707958e-2,4.683442535292588e-2,4.686204958877219e-2,4.688967382461849e-2,4.6917298060464796e-2,4.69449222963111e-2,4.6972546532157405e-2,4.700017076800371e-2,4.7027795003850015e-2,4.705541923969632e-2,4.7083043475542624e-2,4.711066771138893e-2,4.713829194723523e-2,4.716591618308153e-2,4.7193540418927836e-2,4.722116465477414e-2,4.7248788890620445e-2,4.727641312646675e-2,4.7304037362313055e-2,4.733166159815936e-2,4.7359285834005664e-2,4.738691006985197e-2,4.7414534305698273e-2,4.744215854154458e-2,4.746978277739088e-2,4.749740701323719e-2,4.752503124908349e-2,4.75526554849298e-2,4.75802797207761e-2,4.7607903956622406e-2,4.763552819246871e-2,4.7663152428315016e-2,4.769077666416132e-2,4.7718400900007625e-2,4.774602513585393e-2,4.7773649371700234e-2,4.780127360754654e-2,4.7828897843392844e-2,4.785652207923915e-2,4.788414631508545e-2,4.791177055093176e-2,4.793939478677806e-2,4.796701902262437e-2,4.799464325847067e-2,4.802226749431698e-2,4.804989173016328e-2,4.8077515966009586e-2,4.810514020185589e-2,4.8132764437702195e-2,4.81603886735485e-2,4.8188012909394805e-2,4.821563714524111e-2,4.8243261381087414e-2,4.827088561693371e-2,4.829850985278002e-2,4.832613408862632e-2,4.8353758324472626e-2,4.838138256031893e-2,4.8409006796165235e-2,4.843663103201154e-2,4.8464255267857845e-2,4.849187950370415e-2,4.8519503739550454e-2,4.854712797539676e-2,4.8574752211243064e-2,4.860237644708937e-2,4.863000068293567e-2,4.865762491878198e-2,4.868524915462828e-2,4.871287339047459e-2,4.874049762632089e-2,4.8768121862167196e-2,4.87957460980135e-2,4.8823370333859806e-2,4.885099456970611e-2],"kdeType":"time","kdePDF":[180.7066702348903,180.9719240045234,181.50219832628855,182.29702211669093,183.35567720041018,184.67718464857958,186.26028689121557,188.10342587989197,190.20471763947612,192.5619236063687,195.17241920452054,198.0331601588513,201.14064708801422,204.49088895417466,208.0793659761974,211.9009926339555,215.95008140516987,220.22030788200254,224.70467791254836,229.39549740231462,234.28434539291874,239.3620510096893,244.6186748369565,250.04349523988074,255.6250001051848,261.35088442059885,267.20805405484504,273.18263603718617,279.25999556869925,285.4247599272309,291.66084935528124,297.95151494563567,304.27938346429937,310.6265089750045,316.97443105513565,323.30423932015566,329.59664390336394,335.83205147081725,341.9906462882729,348.05247579871656,353.99754011608786,359.8058847937328,365.45769618542874,370.93339868292287,376.213753087167,381.2799553510425,386.1137349195468,390.6974518891999,395.01419221187126,399.0478601791835,402.7832674419933,406.2062178449142,409.30358738811253,412.0633986673012,414.47488918751793,416.5285729963998,418.21629513772353,419.5312784853462,420.4681625807675,421.02303416366624,421.1934491532794,420.97844590873973,420.3785496677486,419.39576813460917,418.0335782599829,416.2969043251439,414.1920875123588,411.7268472097373,408.91023436290783,405.7525772466858,402.265420087001,398.46145501635357,394.35444789452725,389.9591585699285,385.29125619537956,380.3672302453001,375.204297908688,369.8203085541007,364.23364597874206,358.4631291638203,352.5279122624661,346.4473845447892,340.24107101713133,333.9285344194105,327.52927928574854,321.06265872959966,314.5477845854907,308.0034415056188,301.44800557111483,294.89936793520053,288.37486396902364,281.8912083310832,275.46443632822775,269.1098518806838,262.84198234586427,256.67454039631576,250.62039308653493,244.69153818204202,238.8990877624984,233.25325904934462,227.76337234786595,222.437855934309,217.28425766112548,212.3092629981241,207.51871917469725,202.91766503883875,198.51036620276332,194.30035500301904,190.29047476536158,186.4829278317167,182.87932677853706,179.4807482330505,176.28778867646864,173.30062161137337,170.51905546429037,167.9425915940039,165.5704817814179,163.4017845877428,161.43541998432605,159.67022167946666,158.10498659480345,156.73852097614758,155.56968266061475,154.597419063293,153.82080049205896,153.2390484481336,152.85155862208785,152.6579183497972]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":10,"reportName":"group/group 10x100","reportOutliers":{"highSevere":0,"highMild":1,"lowMild":1,"samplesSeen":12,"lowSevere":0},"reportMeasured":[[4.733783099800348e-2,4.729594499999479e-2,89933067,1,null,null,null,null,null,null,null],[9.236117100226693e-2,9.229272000000321e-2,175476934,2,null,null,null,null,null,null,null],[0.1467669389967341,0.14663487400000008,278850352,3,null,null,null,null,null,null,null],[0.19217661800212227,0.19201940499999637,365128697,4,null,null,null,null,null,null,null],[0.23845176000031643,0.23822424000000098,453048611,5,null,null,null,null,null,null,null],[0.2795953179956996,0.27936914700000415,531223200,6,null,null,null,null,null,null,null],[0.32963063600618625,0.32937225999999953,626288132,7,null,null,null,null,null,null,null],[0.37576673999865307,0.37543541600000196,713946679,8,null,null,null,null,null,null,null],[0.41889376099425135,0.4185946119999997,795888891,9,null,null,null,null,null,null,null],[0.47289522900246084,0.47253408000000263,898494306,10,null,null,null,null,null,null,null],[0.5178376870026113,0.5173864999999935,983884057,11,null,null,null,null,null,null,null],[0.5629826369986404,0.5625096440000021,1069660598,12,null,null,null,null,null,null,null],[0.6169776949973311,0.6164689009999975,1172250821,13,null,null,null,null,null,null,null]]},{"reportAnalysis":{"anMean":{"estError":{"confIntLDX":2.003231136058002e-5,"confIntUDX":2.1716394519442038e-5,"confIntCL":5.0e-2},"estPoint":1.5673276303702817e-3},"anRegress":[{"regRSquare":{"estError":{"confIntLDX":2.287732357285077e-3,"confIntUDX":2.8044257401604877e-3,"confIntCL":5.0e-2},"estPoint":0.9947378540776748},"regResponder":"time","regCoeffs":{"y":{"estError":{"confIntLDX":1.695555392863235e-3,"confIntUDX":1.4411773046691034e-3,"confIntCL":5.0e-2},"estPoint":1.3698047924828793e-3},"iters":{"estError":{"confIntLDX":4.561650805884527e-5,"confIntUDX":5.800165002655105e-5,"confIntCL":5.0e-2},"estPoint":1.559488558699208e-3}}}],"anStdDev":{"estError":{"confIntLDX":8.596322276843379e-6,"confIntUDX":9.843940796524229e-6,"confIntCL":5.0e-2},"estPoint":6.970009193368111e-5},"anOutlierVar":{"ovFraction":0.30346203307926556,"ovDesc":"moderate","ovEffect":"Moderate"},"anOverhead":2.1820495514718956e-3},"reportKDEs":[{"kdeValues":[1.411207944848685e-3,1.413266956772664e-3,1.4153259686966431e-3,1.417384980620622e-3,1.419443992544601e-3,1.42150300446858e-3,1.4235620163925591e-3,1.425621028316538e-3,1.427680040240517e-3,1.429739052164496e-3,1.4317980640884752e-3,1.4338570760124541e-3,1.435916087936433e-3,1.437975099860412e-3,1.4400341117843912e-3,1.4420931237083701e-3,1.444152135632349e-3,1.446211147556328e-3,1.4482701594803072e-3,1.4503291714042861e-3,1.452388183328265e-3,1.454447195252244e-3,1.4565062071762232e-3,1.4585652191002022e-3,1.4606242310241811e-3,1.46268324294816e-3,1.4647422548721392e-3,1.4668012667961182e-3,1.4688602787200971e-3,1.4709192906440763e-3,1.4729783025680553e-3,1.4750373144920342e-3,1.4770963264160132e-3,1.4791553383399923e-3,1.4812143502639713e-3,1.4832733621879502e-3,1.4853323741119292e-3,1.4873913860359083e-3,1.4894503979598873e-3,1.4915094098838662e-3,1.4935684218078452e-3,1.4956274337318244e-3,1.4976864456558033e-3,1.4997454575797823e-3,1.5018044695037612e-3,1.5038634814277404e-3,1.5059224933517193e-3,1.5079815052756983e-3,1.5100405171996774e-3,1.5120995291236564e-3,1.5141585410476353e-3,1.5162175529716143e-3,1.5182765648955932e-3,1.5203355768195724e-3,1.5223945887435514e-3,1.5244536006675303e-3,1.5265126125915095e-3,1.5285716245154884e-3,1.5306306364394674e-3,1.5326896483634463e-3,1.5347486602874255e-3,1.5368076722114044e-3,1.5388666841353834e-3,1.5409256960593623e-3,1.5429847079833415e-3,1.5450437199073205e-3,1.5471027318312994e-3,1.5491617437552784e-3,1.5512207556792575e-3,1.5532797676032365e-3,1.5553387795272154e-3,1.5573977914511944e-3,1.5594568033751735e-3,1.5615158152991525e-3,1.5635748272231314e-3,1.5656338391471106e-3,1.5676928510710896e-3,1.5697518629950685e-3,1.5718108749190475e-3,1.5738698868430264e-3,1.5759288987670056e-3,1.5779879106909845e-3,1.5800469226149635e-3,1.5821059345389426e-3,1.5841649464629216e-3,1.5862239583869005e-3,1.5882829703108795e-3,1.5903419822348587e-3,1.5924009941588376e-3,1.5944600060828166e-3,1.5965190180067955e-3,1.5985780299307747e-3,1.6006370418547536e-3,1.6026960537787326e-3,1.6047550657027115e-3,1.6068140776266907e-3,1.6088730895506696e-3,1.6109321014746486e-3,1.6129911133986275e-3,1.6150501253226067e-3,1.6171091372465857e-3,1.6191681491705646e-3,1.6212271610945438e-3,1.6232861730185227e-3,1.6253451849425017e-3,1.6274041968664806e-3,1.6294632087904596e-3,1.6315222207144387e-3,1.6335812326384177e-3,1.6356402445623966e-3,1.6376992564863758e-3,1.6397582684103548e-3,1.6418172803343337e-3,1.6438762922583127e-3,1.6459353041822918e-3,1.6479943161062708e-3,1.6500533280302497e-3,1.6521123399542287e-3,1.6541713518782078e-3,1.6562303638021868e-3,1.6582893757261657e-3,1.660348387650145e-3,1.6624073995741239e-3,1.6644664114981028e-3,1.6665254234220818e-3,1.6685844353460607e-3,1.6706434472700399e-3,1.6727024591940188e-3],"kdeType":"time","kdePDF":[2506.6285948748873,2507.5132282578,2509.280798079016,2511.92792163584,2515.4495527478293,2519.8390149463667,2525.088045298574,2531.1868485029063,2538.1241608090195,2545.887323233859,2554.4623634697314,2563.834085809405,2573.9861683482545,2584.9012666650774,2596.561123131605,2608.946680956582,2622.03820203378,2635.815387634873,2650.2575009677985,2665.3434906093603,2681.0521138172426,2697.3620587315713,2714.252064489267,2731.70103829578,2749.6881685280428,2768.193032979295,2787.195701400504,2806.6768315440595,2826.6177579726027,2847.0005729589725,2867.80819887155,2889.0244515121776,2910.634093950855,2932.622880481539,2954.977590406378,2977.68605144037,3000.7371526145403,3024.1208466421117,3047.8281417984563,3071.851083450867,3096.1827254579407,3120.817091739638,3145.749128397688,3170.974646840721,3196.490258439435,3222.293301303016,3248.3817598290984,3274.754177734588,3301.409565324172,3328.347301795797,3355.5670334188594,3383.068568449643,3410.851769670828,3438.91644545628,3467.262240269921,3495.888525507051,3524.7942915793733,3553.9780421298,3583.4376912416087,3613.1704644772994,3643.1728045472933,3673.4402823663845,3703.9675142082447,3734.7480856143784,3765.774482655577,3797.038031080142,3828.528843816015,3860.2357772224623,3892.146396413261,3924.2469498965584,3956.5223536988397,3988.956185060931,4021.530685714876,4054.2267746710186,4087.0240703669224,4119.9009219530635,4152.834449416572,4185.800592173178,4218.774165690617,4251.728925643593,4284.637639042842,4317.4721617279265,4350.203521567257,4382.80200666823,4415.237257867336,4447.478364743365,4479.493964378187,4511.252342077685,4542.721533261936,4573.869425737178,4604.6638615737675,4635.072737833035,4665.064105412297,4694.606265310368,4723.667861655906,4752.217970886897,4780.226186521543,4807.662699017694,4834.498370279555,4860.704802435734,4886.254400581195,4911.120429246513,4935.27706243021,4958.699427103074,4981.363640166318,5003.246838917533,5024.327205148598,5044.583983067409,5063.997491299518,5082.549129285964,5100.221378448797,5116.997798545679,5132.86301967862,5147.802730459079,5161.803662861807,5174.853574322603,5186.941227650244,5198.05636933041,5208.189706798808,5217.332885252613,5225.478464553367,5232.619896751204,5238.751504729787,5243.868462434318,5247.966777101571,5251.043273862134,5253.095583031122,5254.122130345616]}],"reportKeys":["time","cpuTime","cycles","iters","allocated","numGcs","bytesCopied","mutatorWallSeconds","mutatorCpuSeconds","gcWallSeconds","gcCpuSeconds"],"reportNumber":11,"reportName":"write/write 10x1000","reportOutliers":{"highSevere":0,"highMild":0,"lowMild":0,"samplesSeen":42,"lowSevere":0},"reportMeasured":[[1.8466379988240078e-3,7.274569999964342e-4,3507547,1,null,null,null,null,null,null,null],[3.749734998564236e-3,1.2929680000013377e-3,7124480,2,null,null,null,null,null,null,null],[4.955500997311901e-3,1.607750000005126e-3,9415768,3,null,null,null,null,null,null,null],[6.903895002324134e-3,2.134022999996432e-3,13116844,4,null,null,null,null,null,null,null],[7.662063995667268e-3,2.6392199999918375e-3,14557279,5,null,null,null,null,null,null,null],[9.14627699967241e-3,3.1539210000062212e-3,17377777,6,null,null,null,null,null,null,null],[1.0610110002744477e-2,3.6542269999984e-3,20159943,7,null,null,null,null,null,null,null],[1.342409599601524e-2,4.194209999994314e-3,25506664,8,null,null,null,null,null,null,null],[1.5978417002770584e-2,4.999694999995086e-3,30365722,9,null,null,null,null,null,null,null],[1.627196399931563e-2,5.0767970000009655e-3,30906348,10,null,null,null,null,null,null,null],[1.8321754003409296e-2,6.067248999997332e-3,34814408,11,null,null,null,null,null,null,null],[1.8981221997819375e-2,6.094036999996888e-3,36053167,12,null,null,null,null,null,null,null],[1.9602098000177648e-2,6.6276209999927005e-3,37243869,13,null,null,null,null,null,null,null],[2.327671800594544e-2,7.2572819999976446e-3,44224234,14,null,null,null,null,null,null,null],[2.4468238996632863e-2,7.5967469999937975e-3,46488668,15,null,null,null,null,null,null,null],[2.6962415999150835e-2,8.19859499999609e-3,51228227,16,null,null,null,null,null,null,null],[2.748465700278757e-2,8.59233600000664e-3,52221056,17,null,null,null,null,null,null,null],[2.8489768999861553e-2,9.275811999998496e-3,54130289,18,null,null,null,null,null,null,null],[3.1534058005490806e-2,9.509088000001498e-3,59914520,19,null,null,null,null,null,null,null],[3.3379975000570994e-2,1.0019051000000445e-2,63421768,20,null,null,null,null,null,null,null],[3.21486390021164e-2,1.0772243000005233e-2,61082639,21,null,null,null,null,null,null,null],[3.4810391000064556e-2,1.1085932000000298e-2,66140774,22,null,null,null,null,null,null,null],[3.674557199701667e-2,1.138365399999941e-2,69816213,23,null,null,null,null,null,null,null],[4.020284400030505e-2,1.2410384999995472e-2,76374480,25,null,null,null,null,null,null,null],[4.22221479966538e-2,1.307710599999723e-2,80222608,26,null,null,null,null,null,null,null],[4.329287900327472e-2,1.3273174999994808e-2,82256995,27,null,null,null,null,null,null,null],[4.476459800207522e-2,1.390862699999218e-2,85052355,28,null,null,null,null,null,null,null],[4.4805204997828696e-2,1.4815548999990824e-2,85129419,30,null,null,null,null,null,null,null],[4.578064000088489e-2,1.531027100000415e-2,86983684,31,null,null,null,null,null,null,null],[5.494126000121469e-2,1.6736143000002812e-2,104386904,33,null,null,null,null,null,null,null],[5.856170300103258e-2,1.7582637999993267e-2,111266691,35,null,null,null,null,null,null,null],[5.556844300008379e-2,1.8157706000010876e-2,105579654,36,null,null,null,null,null,null,null],[5.72225259966217e-2,1.899279000001286e-2,108722481,38,null,null,null,null,null,null,null],[5.996240700187627e-2,2.0061890999997445e-2,113928361,40,null,null,null,null,null,null,null],[6.269381900347071e-2,2.0921506999997064e-2,119117391,42,null,null,null,null,null,null,null],[6.556441300199367e-2,2.1952963000003933e-2,124571593,44,null,null,null,null,null,null,null],[7.594630800304003e-2,2.3481523999990372e-2,144278413,47,null,null,null,null,null,null,null],[8.108867700502742e-2,2.4290333999999802e-2,154067861,49,null,null,null,null,null,null,null],[8.529218500189018e-2,2.583146699998906e-2,162048520,52,null,null,null,null,null,null,null],[8.946721100073773e-2,2.7083283999999708e-2,169988974,54,null,null,null,null,null,null,null],[9.48865440004738e-2,2.821290299999646e-2,180284176,57,null,null,null,null,null,null,null],[9.93107329995837e-2,2.9940874999994094e-2,188691292,60,null,null,null,null,null,null,null],[0.10492485300346743,3.141047500000127e-2,199358070,63,null,null,null,null,null,null,null],[0.10985853100282839,3.322559500000466e-2,208730998,66,null,null,null,null,null,null,null],[0.11500390100263758,3.45653819999967e-2,218507729,69,null,null,null,null,null,null,null],[0.12155503199755913,3.6797472000003495e-2,230955873,73,null,null,null,null,null,null,null],[0.11707255199871724,3.8233618000006686e-2,222432487,76,null,null,null,null,null,null,null],[0.12409541200031526,4.020329300000469e-2,235780319,80,null,null,null,null,null,null,null],[0.1282499109947821,4.197388699999749e-2,243674964,84,null,null,null,null,null,null,null],[0.1427478890036582,4.436167599999408e-2,271221846,89,null,null,null,null,null,null,null],[0.15047681400028523,4.6265106000006995e-2,285906018,93,null,null,null,null,null,null,null],[0.1592981859939755,4.917918000001009e-2,302666382,98,null,null,null,null,null,null,null],[0.16632080000272254,5.1931293999999184e-2,316009119,103,null,null,null,null,null,null,null],[0.1761690359999193,5.399041799999793e-2,334720023,108,null,null,null,null,null,null,null],[0.18700433299818542,5.68943619999942e-2,355308629,113,null,null,null,null,null,null,null],[0.19666026499908185,5.982605599999147e-2,373655007,119,null,null,null,null,null,null,null],[0.19374608200450893,6.273283400000196e-2,368117847,125,null,null,null,null,null,null,null],[0.18881391399918357,6.604477399999098e-2,358746101,131,null,null,null,null,null,null,null],[0.20665175699832616,6.900736000000052e-2,392637938,138,null,null,null,null,null,null,null],[0.2148972130016773,7.214676499999939e-2,408311504,144,null,null,null,null,null,null,null]]}];

1156+ reports.map(mangulate);

1157+

1158+ var benches = ["create/relation 10x100","create/relation 10x1000","create/relation 10x10000","restrict/restrict relation 10x10000 to 10x1","restrict/restrict relation 10x10000 to 10x5000","project/project 10x1000 to 1x1000","project/project 10x1000 to 5x1000","union/union identical 10x1000","union/union identical 10x10000","join/join identical 10x100","group/group 10x100","write/write 10x1000",];

1159+ var ylabels = [[-0,'<a href="#b0">create/relation 10x100</a>'],[-1,'<a href="#b1">create/relation 10x1000</a>'],[-2,'<a href="#b2">create/relation 10x10000</a>'],[-3,'<a href="#b3">restrict/restrict relation 10x10000 to 10x1</a>'],[-4,'<a href="#b4">restrict/restrict relation 10x10000 to 10x5000</a>'],[-5,'<a href="#b5">project/project 10x1000 to 1x1000</a>'],[-6,'<a href="#b6">project/project 10x1000 to 5x1000</a>'],[-7,'<a href="#b7">union/union identical 10x1000</a>'],[-8,'<a href="#b8">union/union identical 10x10000</a>'],[-9,'<a href="#b9">join/join identical 10x100</a>'],[-10,'<a href="#b10">group/group 10x100</a>'],[-11,'<a href="#b11">write/write 10x1000</a>'],];

1160+ var means = $.scaleTimes([5.906283388143756e-4,5.770838309782314e-3,5.784195729887314e-2,1.448797309139284e-2,8.447258684075218e-2,1.243577405705988e-2,1.547382196820991e-2,4.923173514046889e-2,0.5157808375258943,0.3374978199984254,4.70336206675725e-2,1.5673276303702817e-3,]);

1161+ var stddevs = [4.502571301832575e-6,2.8815215559732134e-5,1.7121491767487851e-4,4.774249175945004e-4,1.4013810341920257e-3,4.600204612133745e-4,3.978143402171812e-4,3.275115670368287e-4,1.1935851498586624e-3,1.6965376723717264e-3,7.389605929837668e-4,6.970009193368111e-5,];

1162+ stddevs = $.scaleBy(means[1], stddevs);

1163+ var xs = [];

1164+ var prev = null;

1165+ var colors = ["#edc240","#afd8f8","#cb4b4b","#4da74d","#9440ed"];

1166+ var max_time = 0;

1167+ for (var i = 0; i < means[0].length; i++) {

1168+ var name = benches[i].split(/\//);

1169+ name.pop();

1170+ name = name.join('/');

1171+ if (name != prev) {

1172+ var color = colors[xs.length / 2 % colors.length];

1173+ xs.push({ data: [[means[0][i], -i]], label: name, color: color,

1174+ bars: { show: true, horizontal: true, barWidth: 0.75,

1175+ align: "center" } });

1176+ xs.push({ data: [[means[0][i], -i, stddevs[i]]], color: color,

1177+ lines: { show: false },

1178+ points: { radius: 0, errorbars: "x",

1179+ xerr: { show: true, radius: 5,

1180+ lowerCap: "-", upperCap: "-" } } });

1181+ prev = name;

1182+ } else {

1183+ xs[xs.length - 2].data.push([means[0][i], -i]);

1184+ xs[xs.length - 1].data.push([means[0][i], -i, stddevs[i]]);

1185+ }

1186+ max_time = Math.max(max_time, means[0][i] + stddevs[i]);

1187+ }

1188+ var oq = $("#overview");

1189+ o = $.plot(oq, xs, { grid: { borderColor: "#777", hoverable: true },

1190+ legend: { show: xs.length > 1 },

1191+ xaxis: { max: max_time * 1.02 },

1192+ yaxis: { ticks: ylabels, tickColor: '#ffffff' },

1193+ zoom: { interactive: true, amount: 1.05 },

1194+ pan: { interactive: true } });

1195+ if (benches.length > 3)

1196+ o.getPlaceholder().height(28*benches.length);

1197+ o.resize();

1198+ o.setupGrid();

1199+ o.draw();

1200+ $.addTooltip("#overview", function(x,y) { return $.renderTime(x / means[1]); });

1201+});

1202+$(document).ready(function () {

1203+ $(".time").text(function(_, text) {

1204+ return $.renderTime(text);

1205+ });

1206+ $(".citime").text(function(_, text) {

1207+ return $.renderTime(text);

1208+ });

1209+ $(".percent").text(function(_, text) {

1210+ return (text*100).toFixed(1);

1211+ });

1212+ });

1213+</script>

1214+

1215+ </div>

1216+ </div>

1217+ <div id="footer">

1218+ <div class="body">

1219+ <div class="footfirst">

1220+ <h2>colophon</h2>

1221+ <p>This report was created using the

1222+ <a href="http://hackage.haskell.org/package/criterion">criterion</a>

1223+ benchmark execution and performance analysis tool.</p>

1224+ <p>Criterion is developed and maintained

1225+ by <a href="http://www.serpentine.com/blog/">Bryan O'Sullivan</a>.</p>

1226+ </div>

1227+ </div>

1228+ </div>

1229+ </body>

1230+</html>

docs/commits_in_constant_time.markdownnew file+134

@@ -0,0 +1,134 @@

1+# Transactional Database Commits in O(1)

3+A.M.

5+[Project:M36](https://github.com/agentm/project-m36)

7+## Synopsis

9+Common relational database management systems operate in an imperative manner by executing statements immediately. This naive strategy quickly becomes an IO-bound bottleneck. By applying Haskell's laziness-in-evaluation to database updates, new doors for optimizations based on what is queried make themselves apparent. Furthermore, by serializing thunks representing idempotent database updates, the database can commit transactions in constant time with regards to the tuple count since the tuples themselves need not be serialized. This optimization, combined with *fsync*-coalescing, can allow databases to commit to disk faster than tuples updates can be processed.

10+

11+Using this deferred execution technique, database updates can be processed in the background or, in the case when the tuples are never requested, never.

12+

13+These database update thunks and other interesting optimizations are implemented in [Project:M36](https://github.com/agentm/project-m36): an experimental, clean-room, purely Haskell implementation of an RDBMS engine based on the mathematical principles of the relational algebra.

14+

15+## Rationale

16+

17+A typical SQL RDBMS such as PostgreSQL executes a list of commands serially against a serializable representation of the database state without concern to whether or not the commands are effectively necessary to service subsequent requests. A database update which affects *n* tuples will necessitate disk writes of *O(n)* plus *O(n\*log(n))* writes for each affected index.

18+

19+By validating and serializing thunks of validated commands, Project:M36 commits can be independent of the tuple write cost. The thunks, which are flushed to non-volatile storage to complete the transaction commit, allow the DBMS to defer execution in preference to commit time.

20+

21+The deferral is, however, not required, and could be left as a option to the user or application.

22+

23+The final cost of committing in Project:M36 relates to the size of the update expression. If the update expression is, for example, a insertion of a large number of rows, then the commit cost will be *O(t)* where *t* is the number of tuples expressed in the update, but still independent of the cost of the existing tuples in the database.

24+

25+## Example and Comparison to PostgreSQL

26+

27+Let us walk through a specific example using SQL. While Project:M36 does not support SQL (and for [good reasons](https://github.com/agentm/project-m36/blob/master/docs/on_null.markdown)), comparing both databases with a common language is useful for illustrative purposes.

28+

29+Let us consider an existing database with a table/relation named "BigTable" which has 10 billion rows/tuples (an arbitrarily large number) of which one column is named "x" and represents a randomly-assigned integer. Next, assume that the user of the database will execute an update which will update every row/tuple, commit the changes, then query a subset of the resultant updated rows/tuples.

30+

31+

32+### The Update Expression

33+

34+Consider the following database update:

35+

36+```

37+UPDATE "BigTable" SET x = x + 1;

38+```

39+In PostgreSQL, the cost of executing this expression is incurred immediately upon execution. New tuples are laid down to disk (if the dataset is larger than *shared_buffers*), duplicating the entirety of the existing table/relation in storage (due to MVCC) for a cost of *O(n)* where *n* is the number of existing rows/tuples in "BigTable". If *x* is indexed, then the index writes incur an additional cost of *O(n\*log(n))* writes. Furthermore, PostgreSQL will write all changes to its write-ahead log, so the cost is multiplied by some factor.

40+

41+In Project:M36, the same expression can first be statically validated to adhere to the database constraints. The only constraint affected here is for the column/attribute *x* which requires an integer. Since adding one to any integer retains the integer type, the constraint can be determined to be unviolated without evaluating the expression, thus at a cost of *O(1)*. Project:M36 uses a novel WORM (write-once, read-many) strategy over journaled filesystems to avoid the need for a separate journal.

42+

43+*For the purpose of this example, assume that integer overflow is not a concern.*

44+

45+### The Commit

46+

47+```

48+COMMIT;

49+```

50+

51+In PostgreSQL, the write-ahead log mentioned above containing all tuples changes must now be flushed to non-volatile storage, creating a bottleneck to the slowest form of storage. A necessary checkpoint (which is configurable) could incur further writes as the tuples are flushed to disk as well.

52+

53+In Project:M36, the update expression must also be flushed to disk, but the expression is a mere few bytes appended to the transaction graph.

54+

55+### The Subsequent Query

56+

57+Finally, the user queries a subset of the updated table/relation.

58+

59+```

60+SELECT a, b, c, x FROM "BigTable" WHERE x > 10000;

61+```

62+

63+In PostgreSQL, considering that the column/attribute has an index, *O(log(n))* reads are needed to identify on which pages in the table's on-disk storage the proper values can be found. Considering that the value *x* was previously described as random, despite the restriction, in the worst case, every page of the on-disk table may need to be read because each page could contain one value matching the restriction. This would necessitate reading *O(n)* tuples previously written to disk. After reading the tuples, the tuples must be filtered by the restriction to service the query.

64+

65+In Project:M36, the state of the database is determined to be the difference of the previous state *S* (before the *x+1* update above) and *S'* (after the update). The serialized update expression can be deserialized and merged into the rewritten query:

66+

67+```

68+SELECT orig.a, orig.b, orig.c, x_orig + 1 AS x FROM (SELECT a, b, c, x AS x_orig FROM "BigTable"@S) AS orig WHERE x > 10000;

69+```

70+

71+where the *@* symbol references the state of "BigTable" at transaction state *S* in the past. The rewrite process can occur in constant time regarding the tuple count, but the execution does require reading the previous state *S* of "BigTable", filtering it as expected. The tuple read cost is equivalent to that of the same statement at *S'*: *O(log(n))* utilizing a b-tree index.

72+

73+### Summary

74+

75+| | PostgreSQL | Project:M36 |

76+|-|------------|-------------|

77+| UPDATE x+1 | *O(nlog(n))* | *O(1)* |

78+| COMMIT | flush *n* tuples to disk | flush expression to disk |

79+| SELECT x>10000 | *Ω(log(n))*, *O(n)* worst case | *O(log(n))* |

80+

81+Even if the user were to query all the tuples back, the actual IO cost in Project:M36 would be lower since the updates are only "executed" on the fly and not necessarily written to disk. However, a clever cacheing strategy could note that state *S* is queried often enough to warrant a cached version. The table's data on disk, however, is not required to answer the query.

82+

83+## Constraint Oracles

84+

85+To be able to perform an update and commit in constant or less than *O(n)* time does have some preconditions:

86+

87+ * constraints must be able to be statically validated in linear or logarithmic time

88+

89+However, even if constraints lack a proper oracle such as an index or a static means of validation and, thus, cannot be validated in constant time, the user may still benefit from serialization of the database update expression since writing the validated tuples to disk can be deferred beyond commit time and could go directly into an on-disk cache.

90+

91+## Worst Case Behavior

92+

93+Every database constraint can be represented as an inclusion dependency whereby the evaluation of a relational expression `sub` must be a subset of the evaluation of relational expression `super` (`sub ⊆ super`) for the constraint to validate. Therefore, the worst case time to validate any constraint, assuming that the constraint has an ideal oracle, is O(n) in the tuple count. However, as mentioned above, there are many constraints that can be validated in constant or less-than-linear time. Furthermore, the validated tuples need not be written to disk once the constraint is found to hold.

94+

95+Since there is great variation in constraint validation cost, the RDBMS could pre-analyze and report on associated constraints costs or make use of data independence to guide storage to optimize queries needed to service the constraint checker.

96+

97+## Caveats

98+

99+Certain types of updates still take a similar amount of time to commit in Project:M36 in comparison to PostgreSQL. Specifically, any update which relies on data outside the database's purview will necessitate flushing the tuple data since the update expression contains new tuple data not based on existing tuples. For example, the equivalent of:

100+

101+```

102+INSERT INTO "BigTable"(a, b, c, x) VALUES (1,5,10,10),(20,20,21,30),.... #many tuples

103+```

104+will still necessitate a *O(n)* tuple writes to disk in both databases. Though the asymptotic costs are equivalent, the number of writes are cut in half in Project:M36 since it does not require a write-ahead log.

105+

106+While PostgreSQL makes use of MVCC (multi-version concurrency control) which marks which tuples belong to a linear progression of transaction states, Project:M36 stores a full history of database state using a transaction graph (a directed acyclic graph similar to the commit-based graph of `git`). The graph allows named branches to be created and merged which also reduce contention around a singular graph head.

107+

108+## Applying Laziness to SQL RDBMSes

109+

110+Would it be possible to apply transaction-based laziness to an SQL-based RDBMS? Certainly, with sufficient shoe-horning, it could work, but SQL includes a few malfeatures which would make it difficult, if not impossible:

111+

112+ * Non-idempotent server-side functions prevent laziness because of side effects. PostgreSQL can mark functions as idempotent, but does not validate or enforce the idempotence, Project:M36, via Safe Haskell, can validate pure functions.

113+ * The lack of "time travel", the ability to query database state in the past prevents reliance on previous states, prevents direct referencing of previous database states on which the state differences can be built.

114+ * Tightly-coupled table-to-storage management prevents alternative data models. Indexing and constraint checking need to be statically verifiable and deferrable.

115+

116+These hurdles are not insurmountable, just perhaps not a good fit for SQL databases with a lot of historical and implementation baggage.

117+

118+## Benchmarks

119+

120+Forthcoming.

121+

122+## Conclusion

123+

124+Transactional time-to-commit is critical in ensuring that business decisions can make it to non-volatile storage as quickly as possible. By introducing Haskell-like, lazy evaluation to update expressions and serializing the resultant thunk, commits can be serialized in constant time, disregarding the number of tuples modified in the expression.

125+

126+This serialization strategy turns modern RDBMS architecture on its head since the table/relation-to-file mapping is broken, resulting in true data independence. Any on-disk representation of a relation at a specific transaction state therefore merely becomes a cached and purgeable entity, drastically shrinking on-disk cacheing requirements while expanding the scope in which said strategies can operate. Hopefully, a truly data independent architecture will result in new optimization discoveries.

127+

128+Project:M36 implements a transaction graph which can represent the entirety of database state, leaving room for any number of alternative representations, even for a single relation or relation across transaction states. A simple example could include storing two different orderings of tuples of the same relation in order to optimally serve different join queries. Common RDBMSes offer only two on-disk representations: the set of fully-evaluated tuples and indexes to those tuples, preventing data independence. Data independence paves the way towards the elimination of implementation-specific, gatekeeper roles such as database administrators.

129+

130+The promise of the relational algebra has always been the liberation of data from its data structure representation in order to be able to answer arbitrary queries. Modern DBMSes which typically map tables directly to one or more files on disk fail to live up to this promise. Project:M36 sets out to rectify this failure.

131+

132+In a greater context, applying laziness to an architecture to make use of more interesting optimizations is hardly new. The OpenGL API views its "immediate" mode as effectively deprecated. Filesystems take advantage of laziness using copy-on-write semantics. High-level programming languages can make greater, more interesting inferences about how a computation must be execute. A computer can always consider many more possible solution paths than a human can.

133+

134+The adherence to mathematical priniciples in Project:M36 results in features and optimization opportunities which have not yet been discovered. In contrast to RDBMSes designed around specific optimizations (such as indexes, specific disk layouts, or key-value lookups), Project:M36 sets out to demonstrate practically that future optimizations can only be discovered when operating within a mathematically-coherent architecture.

docs/data_independence.markdownnew file+109

@@ -0,0 +1,109 @@

1+# Project:M36: Towards an Architecture for Data Independence

3+## Introduction

5+The Project:M36 relational algebra architecture sets itself apart from typical DBMSes by ensuring strict transactional isolation, a branchable/mergeable (rather than linear) transaction graph, and storage of relational expressions (rather than storage of tuples). Let's look at how these architectural features work together to make Project:M36 the first relational algebra engine to implement true data independence.

7+## What is Data Independence?

9+C.J. Date writes:

10+

11+`Certainly most SQL products have failed to live up to the [relational] model's full potential...in those products, what the user sees and what is physically stored are essentially the same thing... In particular, it accounts for the argument, so often heard, to the effect that we have to "denormalize for performance."`

12+

13+`In principle, logical design has absolutely nothing to do with performance at all.`

14+

15+(Date, C.J. "Database In Depth: Relational Theory for Practitioners". O'Reilly Media. 2005. pages 156-157.)

16+

17+Data independence is therefore defined as the separation of the database user's experience from the database's means of in-memory or on-disk representation. As Date points out, virtually all database products implement a one-to-one mapping of relations to files in storage.

18+

19+One advantage of high-level abstractions in programming languages is to leverage advanced algorithms which can choose optimization paths on behalf of the user which a human may never be able to discover. While the promise of ever higher-level abstractions is realized by progamming languages such as Haskell, DBMS implementors have been resistant to data independence. This is due to several legacy factors such as companies pushing one-trick-pony database technologies and middlemen such as DBAs required to play gatekeeper against "bad" schema changes. The result is customers forced to run multiple disparate databases such as one for realtime transaction processing and another for analytics and another for audit logging. This recalcitrance has also led to the rise of databases such as "document" JSON databases with weak mathematical underpinnings in the name of performance as users become frustrated when hitting performance walls and dealing with arbitrary database limitations.

20+

21+Implementations which closely tie the user interface to backend representation close the door on interesting alternative representations and optimizations. For example, SQL databases typically store a single relation as a list of tuples on disk with supplementary indexes stored in separate files. There is no reason that the same relation couldn't be on disk or in memory in any number of formats. Such a table might be useful in various formats ideal for servicing different types of queries. Data independence grants the DBMS the permission to create any number of representations- including none at all- as long as the correct answer is provided to the user. "Column-store" databases may try to slice the tuples in a different axis, but those databases simply shift the performance problems elsewhere. Only implementation details prevent a database from offering both column-oriented *and* tuple-oriented representation while allowing the database to choose.

22+

23+That is why it is critical for the user's interface to the database *not* to include features such as "query hints" which would force a specific implementation in the backend. The user's interface must be declarative (describing the state change or query rather than *how* to execute it) and sufficiently high level. Any implementation detail leakage to the user's interface is a lost potential algorithmic optimization. While the topic of providing high-level interfaces is not specific to database design, we will continue to explore the ramifications of data independence in databases.

24+

25+

26+## Transactional Isolation

27+

28+While other databases offer various transaction isolation levels with differing levels of implementation-specific surprises, Project:M36 solely suppports the maximum transaction isolation level. Instead of relying on details of [MVCC](https://www.postgresql.org/docs/current/mvcc-intro.html) which marks each tuple in a relation with a monotonically-increasing number identifying from which transaction the tuple was added or deleted, Project:M36 includes no singular backing store for tuples, instead storing a stream of state change requests. Because the transaction graph supports branching and merging (similar to version control such as git), transactions can be committed without contention at a singular head of the graph. Committing to disk can be implemented as writing a file to represent the transaction's state and

29+

30+## The Transaction Graph

31+

32+These state changes are, in fact, the idempotent relational update expressions that the user has submitted. For example, given a transaction which includes a single relation `s`:

33+

34+```

35+┌──────────┬────────┬───────────┬───────────┐

36+│city::Text│s#::Text│sname::Text│status::Int│

37+├──────────┼────────┼───────────┼───────────┤

38+│"Paris" │"S2" │"Jones" │10 │

39+└──────────┴────────┴───────────┴───────────┘

40+```

41+

42+if the user commits a transaction with an insert such as:

43+

44+```

45+insert x relation{tuple{city "Boston", s# "S3", sname "Smith", status 400}}

46+```

47+

48+then a typical database will find the file representing the relation, find some free space in it and save the new tuple along with the MVCC transaction identifier. Subsequent transactions will find the tuple and compare it to their own transaction id in order to determine its "visibility". Project:M36, on the other hand, after validating that all relational constraints (such as primary and foreign keys) still hold, will simply serialize and append the expression to the transaction graph log. By default, there is no file representing the relation.

49+

50+For those familiar with Haskell, note how serializing the update expression is similar to being able to serialize a thunk or deferred execution.

51+

52+The transaction graph also allows users to travel back to previously-committed transactions. This may be useful for audit logging or alternative schemas.

53+

54+## Storage Representations

55+

56+Given the ever-growing transaction graph based on state changes, let's examine how Project:M36 services subsequent queries.

57+

58+## Benefits

59+

60+The primary goal of a database should be to ensure data integrity. Project:M36 takes no shortcuts in achieving this goal, but choosing a backend architecture which minimizes the time which it takes to get the transaction to non-volatile storage (disk) by storing update expressions rather than attempting to shuffle tuples on disk. This architecture open the door to many optimization techniques, many of which are new to databases.

61+

62+### Multiple On-Disk Representations

63+

64+The promise of data independence allows database backends to store relations as they see fit. That can include any number of on-disk representations including none at all. For example, for a table accessed by multiple projections, the database may choose to materialize the relation in those projections. The representations are therefore created in service to the queries submitted or anticipated instead of being based on past update expressions. Because on-disk storage is obviously limited, the database must decide what is valuable to keep around for future queries. This could open a new area of research into the appropriate machine learning algorithms, but, fundamentally, this set of materialized query responses is effectively a cache which can always be refreshed.

65+

66+The alternative representations need not be a direct answer to queries- for example, a materialized relation from a transaction could be used to service a query from a later transaction if the updates since that transaction are applied.

67+

68+The database could also anticipate, for example, scheduled queries and actually materialize relations before the query is executed. On-disk cache could represent "denormalized" tuple sets while the user-facing interface shows a properly normalized schema, thereby supporting data independence.

69+

70+More research in determining just what should be in the cache is needed.

71+

72+### Transactional Commits in O(1) Time

73+

74+Because the Project:M36 backend need not save tuples into a specific file representing a relation, the backend can drastically reduce the amount of time needed to commit a transaction to disk. Specifically, following constraint validation (which can often be done in constant or logarithmic time relative to the tuple count), the fastest means of committing the transaction is to save the update expression itself. Since the previous state has already been presumably committed, any idempotent operation can be saved for deferred execution. This means that transactions can be committed to disk relative to the size of the update expression rather than the number of the tuples affected- committing can occur at a rate relative to that of update expression size (typically a few kilobytes) rather than relative to the number of tuples that the update expression happened to alter.

75+

76+This technique gets transactions to disk faster, thus drastically increasing the rate transactions can be committed overall. Note that the execution of the update expression may be deferred by this process, so the cost to evaluate it may occur later, but this processing may be performed in the background after the transaction is committed. When the data is never requested, for example, for a defunct transaction graph branch, the actual execution could be deferred indefinitely, incurring zero cost to calculate the consquence of the update.

77+

78+### Less Disk Usage

79+

80+Because Project:M36 stores a stream of update expressions rather than tuples themselves, the minimum storage requirements for a given database may be reduced. For example, if a relation with an attribute `x` of type `Integer` has 1,000,000 tuples, a subsequent update to increment all 1,000,000 values by one may be cheaper to evaluate on-demand rather than immediately generating 1,000,000 new tuples and saving them to disk. If the new tuples are requested, the database can determine that the tuples are not materialized, calculate them, and return them, all without ever having the tuples on disk. Furthermore, if only a subset of the tuples are ever requested, for example, due to a query restriction, then some of the tuples may never need to be calculated or materialized.

81+

82+### Audit Logging

83+

84+Typical databases implement various strategies for audit logging, including:

85+

86+* exposing MVCC-like values such as tuple "created at" and "created by" to the user and forcing all tables to be insert-only

87+* shuttling audit logs to a secondary database

88+

89+Project:M36, through its inherent ability to travel the append-only transaction graph, enables audit-logging by allowing users to checkout previous transaction states. Committed transaction states are immutable, so no relation pollution or secondary database is necessary.

90+

91+### Selective Caching

92+

93+Typical databases materialize entire tuple sets representing each named relation (relation variable), but there is nothing special about relations that happen to be named. Data independence allows us to cache answers to common or even anticipated queries- this allows the schema to be normalized and unmaterialized while the *denormalized* query results are materialized cached. This flexibility saves disk space and allows the cache to be much more dynamic than in a typical DBMS.

94+

95+### Never-Materialized Tuples Replace Partitions

96+

97+Queries on very large relations often very often restricted (filtered by tuple) to generate subsets which are often partitioned, for example, by an event's date. Instead of requiring DBMS users to manually partition and slice their data in one, fixed, particular way, Project:M36's cacheing system will only cache those tuples that serve the interests of the queries. With something like an LRU cache, a data independent architecture will naturally cache "partitions" of the full relation without manual intervention.

98+

99+### Elimination of DBA role

100+

101+Databases essential to a business function are often guarded by a human database administrator (DBA) whose role it is to monitor database performance and to play gatekeeper to database schema changes as the database grows. This role is necessary because database tuning can be an arcane skill, rife with pitfalls for those who don't know the database software inside-and-out. This is a direct cause of data dependence, forcing DBAs to manually enforce data partitioning and shuffling data to different servers, configuring database replicas, and making Faustian bargains to "denormalize" tables for analytical workloads.

102+

103+A data independent architecture eliminates this role by allowing the database to make the optimal choices itself. This means that the database can respond to schema changes immediately, without manual repartitioning or denormalization steps.

104+

105+## Conclusion

106+

107+Project:M36's backend architecture enables new optimizations and features that are sorely lacking in existing DBMSes. By leveraging its novel transaction graph and deferred evaluation, Project:M36 handles more DBMS use-cases.

108+

109+Project:M36's novel architecture opens the door for further database and algorithmic research.

docs/database_context_functions.markdown+51−1

@@ -6,7 +6,7 @@ While "atom functions" operate on individual values and return new values (atoms

7Other DBMS software may include a similar feature called "stored procedures". However, "stored procedures" are stored outside the transaction stream and are not versioned by the database as in Project:M36.

9−In order to use this feature in Project:M36, be sure to build your own Project:M36 library so that the optional scripting is enabled.

9+In order to use compile functions at runtime in Project:M36, be sure to build your own Project:M36 library so that the optional scripting is enabled. Alternatively, precompiled database context functions can be loaded from object files.

11## Database Context Function Types

@@ -112,6 +112,56 @@ executeDatabaseContextExpr sessionId dbconn (ExecuteDatabaseContextFunction func

112```

113from the same module.

114

115+## Loading Precompiled Modules

116+

117+Database context functions compiled with GHC to object files can be loaded at runtime. Let's walk through an example:

118+

119+```haskell

120+module DynamicDatabaseContextFunctions where

121+import ProjectM36.Base

122+import ProjectM36.Relation

123+import ProjectM36.DatabaseContextFunctionError

124+import qualified ProjectM36.Attribute as A

125+

126+import qualified Data.Map as M

127+

128+

129+someDBCFunctions :: [DatabaseContextFunction]

130+someDBCFunctions = [DatabaseContextFunction {

131+ dbcFuncName = "addtestrel",

132+ dbcFuncType = [],

133+ dbcFuncBody = DatabaseContextFunctionBody Nothing addTestRel

134+ }]

135+ where

136+ addTestRel _ ctx = do

137+ let attrs = A.attributesFromList [Attribute "word" TextAtomType]

138+ eRel = mkRelationFromList attrs [[TextAtom "nice"]]

139+ case eRel of

140+ Left err -> Left (DatabaseContextFunctionUserError (show err))

141+ Right testRel ->

142+ pure $ ctx { relationVariables = M.insert "testRel" testRel (relationVariables ctx) }

143+```

144+

145+The function returns a list of `DatabaseContextFunction`s (just one in this case). The function adds a relation variable to the current database context.

146+

147+Compile it with GHC:

148+

149+```

150+cabal exec ghc -- examples/DynamicDatabaseContextFunctions.hs -package project-m36

151+```

152+

153+or invoked GHC via stack.

154+

155+Finally, connect to your database with `tutd` and load the module:

156+

157+```

158+TutorialD (master/main): loaddatabasecontextfunctions "DynamicDatabaseContextFunctions" "someDBCFunctions" "examples/DynamicDatabaseContextFunctions.o"

159+```

160+

161+If the load reports an "unknown symbol" error, double check that the installed "project-m36" package is identical to one used to link the Haskell module.

162+

163+Note that such functions do not survive a server restart; this will likely be improved in a future release.

164+

115## Future Improvements

165## Future Improvements

116

166

117There are likely a variety of convenience functions which would make sense in the context of the scripted function. If you have ideas for such functions, please open a GitHub issue.

167There are likely a variety of convenience functions which would make sense in the context of the scripted function. If you have ideas for such functions, please open a GitHub issue.

docs/dataframes.markdownnew file+53

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

1+# Project:M36 DataFrames

3+Users of typical relational algebra engines have come to expect sorting and limiting of query results despite the fact that relations do not support ordering. To that end, Project:M36 supports converting relations to "data frames" to support sorting on attributes and limiting the maximum tuple count in the result set.

5+The equivalent feature in SQL is invoked by the `ORDER BY`, `LIMIT`, and `OFFSET` clauses.

7+## Usage

9+From within the `tutd` console, converting a relation to be sorted as a data frame is invoked using the `:showdataframe` command.

10+

11+```

12+:showdataframe <relational expression> orderby {<attribute {ascending,descending}>} {offset <num>} {limit <num>}

13+```

14+

15+The default sort order is `ascending`.

16+

17+## Examples

18+

19+```

20+TutorialD (master/main): :showdataframe s orderby {status}

21+┌──┬───────────┬─────────┬────────────┬────────────────┐

22+│DF│city::Text↕│s#::Text↕│sname::Text↕│status::Integer⬆│

23+├──┼───────────┼─────────┼────────────┼────────────────┤

24+│1 │"Paris" │"S2" │"Jones" │10 │

25+│2 │"London" │"S1" │"Smith" │20 │

26+│3 │"London" │"S4" │"Clark" │20 │

27+│4 │"Athens" │"S5" │"Adams" │30 │

28+│5 │"Paris" │"S3" │"Blake" │30 │

29+└──┴───────────┴─────────┴────────────┴────────────────┘

30+TutorialD (master/main): :showdataframe s{status} orderby {status}

31+┌──┬────────────────┐

32+│DF│status::Integer⬆│

33+├──┼────────────────┤

34+│1 │10 │

35+│2 │20 │

36+│3 │30 │

37+└──┴────────────────┘

38+TutorialD (master/main): :showdataframe s{status} orderby {status descending} limit 1

39+┌──┬────────────────┐

40+│DF│status::Integer⬇│

41+├──┼────────────────┤

42+│1 │30 │

43+└──┴────────────────┘

44+TutorialD (master/main): :showdataframe s{status} orderby {status descending} offset 1 limit 3

45+┌──┬────────────────┐

46+│DF│status::Integer⬇│

47+├──┼────────────────┤

48+│1 │20 │

49+│2 │10 │

50+└──┴────────────────┘

51+

52+```

53+The arrow in the attributes indicates the sort order while the DF column indicates the row number based on the sort order. Column ordering can also be arbitrary.

docs/filesystem-persistence.markdownnew file+128

@@ -0,0 +1,128 @@

1+# Project-M36 Filesystem Persistence (Change Proposal)

3+## Introduction

5+Existing database persistent storage is not suitable for Project:M36 storage for several reasons:

7+* typical SQL storage doesn't support relation-valued attributes

8+ * Project:M36 supports nested relations, relations as values- a useful feature of the relational algebra

9+* typical SQL storage relies on writing and rewriting files to save space

10+ * Project:M36 uses a write-one-read-many strategy to support database branching, concurrency, and compression

11+* typical SQL storage maps each table to one or more files

12+ * Project:M36 obviates the one-to-one mapping between relation variables and files and allows for multiple representations of a single relation variable and evaluated expressions on disk

13+* typical SQL storage maintains only the latest state of the database

14+ * Project:M36 stores a graph of transactions and supports multiple heads of contention

15+* typical key-value storage is poorly typed or even schemaless

16+ * Project:M36 is strongly-typed which enforces correctness and can benefit compression schemes and performance

17+

18+## Requirements

19+

20+* storage of an append-at-leaves (transaction) graph with highly concurrent read access

21+* database [durability](https://en.wikipedia.org/wiki/ACID#Durability)

22+* extensibility

23+ * examples include future compression types, dynamic atom (value) types, database context extensions, new relation types (such as recurrence relations), backwards-compatibility for atom values

24+* platform-agnosticism

25+ * postgresql's C-struct-to-disk design means that switching platforms requires a dump-and-restore, even if the database directory can be physically moved to the new machine- it's not always clear what constitutes a platform changes (float/int timestamps)

26+* upgradeability

27+ * postgresql software upgrades require painful database dump-and-restores or pg_upgrade, causing downtime

28+ * be able to read older formats to prevent costly data-rewrites

29+* backwards-compatibility

30+ * no one wants to rewrite their database files during upgrades, even if it is on-the-fly like with pg_upgrade

31+* multiple remote readers and writers to the storage

32+ * mutliple servers can read/write the same storage over networked filesystems as long as there are some basic locking guarantees

33+ * multiple servers can read the same storage without locking guarantees

34+ * we can protect WORM storage with fine-grained locking and still maintain high-concurrency

35+* singular format for data export/import (dump/restore)

36+ * we won't need a pseudo-cross-platform dump format (like pg_dump's output) because the file format is already cross-platform

37+ * sharing the format for internal and external usage means we can share the same tools

38+ * the dump format can be a subset of the internal format

39+* existence of a Haskell-based serialization library

40+* POSIX filesystem semantics and atomicity guarantees

41+

42+## Current, Insufficient Design

43+

44+### Filesystem Requirements

45+

46+* POSIX, journaled filesystem

47+ * ext3/4, xfs, etc.

48+ * simulate POSIX semantics on Windows possibly with locking

49+

50+The first pass of the on-disk storage for Project:M36 was implemented with a focus on correctness, but not performance or intelligent disk storage usage. As such, it is valuable as a baseline for the new implementation.

51+

52+* uses Data.Binary to serialize entire Haskell data structures to disk

53+* includes lots of redundancy

54+ * for example, each new transaction writes all current relation variables to disk- instead, we should be able to reference unchanged relvars from previous transactions (they are already safely on disk)

55+* loses the in-memory data structure sharing that was present when writing the data (one of the benefits of immutable data structures)

56+* writes a platform-specific format

57+* is not extensible, backwards-, or forwards-compatible

58+* cannot be used as a portable, exportable format

59+* compression is all-or-nothing

60+

61+### Directory Layout

62+

63+* /m36v*x* - includes a human-readable transaction graph listing. The *x* references the version of persistence format.

64+* /lockFile - an empty file used for synchronizing multiple project-m36 server contending for the transaction graph

65+* /heads - a human-readable mapping of head names to transaction ids

66+* /<transaction id> - a directory containing all data needed to reconstruct a transaction

67+ * /atomfuncs - a Binary-serialized listing of `AtomFunction`s

68+ * /dbcfuncs - a Binary-serialized listing of `DatabaseContextFunction`s

69+ * /incdeps - a Binary-serialized listing of `InclusionDependency`s

70+ * /info - a Binary-serialized listing of `TransactionInfo` (current and parent transaction ids)

71+ * /relvars - a directory containing files named after the relvars with each file's contents being a serialized `Relation`

72+ * dynamic names should not appear in the filesystem as the filesystem naming requirements will be different from Project:M36 naming requirements

73+ * /schemas - a Binary-serialized listing of alternative isomorphic schemas

74+ * /typecons - a Binary-serialized listing of `TypeConstructor`s (data types)

75+

76+## New, Shiny, Proposed Design

77+

78+### Directory Layout

79+

80+Most of the existing directory layout remains useful. The one-transaction-per-directory layout maximizes read performance using a WORM strategy. Later transactions can refer to past transactions to cut down on immediate IO. Due to the idempotence of the `DatabaseContextExpr`, we can optionally serialize the expression itself to further reduce and defer IO. Deferred updates can be resolved on-demand or in the background by replacing transaction directories, individual files, or by adding supplementary relation representations (more on these below).

81+

82+Improvements:

83+

84+* wrap up small objects together

85+ * We experienced unnecessarily high disk usage when saving atom functions in individual files. Wrap up smaller data structures (especially when less than 4KB) into one file.

86+* use [cbor](https://github.com/well-typed/cborg) binary format to allow external tools to be able to read the on-disk format

87+ * the cbor format allows for forwards and backwards compatibility for atom types and includes relevant built-in types

88+

89+### Relation representations

90+

91+One area where almost every DBMS has fallen flat is in *data independece*, the separation between the logical database state representation and the on-disk format. Project:M36 aims to remedy this with "relation representations" which acknowledges that every relation (including the results of relational expresssions) can have multiple on-disk or in-memory representations. The purpose of a query planner is to choose the optimal representation for the given request.

92+

93+Most DBMSes do make an inadvertent attempt to support multiple relation representations via indexes. An index can be viewed as an independent representation of a relation in a different format (optimized for certain queries), but these same DBMSes fail to hide this abstraction in the logical layer, instead forcing users to create and maintain indexes as a separate entity.

94+

95+Relational representations, however, are never presented to the user of the logical layer of the database. Such representations can be created automatically. For example, if a certain query result (always a relation) is requested often, the DBMS may choose to cache the result as a relation representation mapped to the query itself. Thereafter, if the query is requested again (within an unchanged database state, of course), the planner can choose to send the pre-computed result back. This is known as a "query cache", but we can extend this same model to any other possible representation.

96+

97+Another representation type includes alternative representations of a relation variable's value designed for specific projections or restrictions. For example, a relation may be stored on disk as a btree with the nodes representing a relation's key. This is obviously equivalent to an index (either populated with the remainder of the tuple attributes or not, if the query is merely checking for existence).

98+

99+Note that if two relation representations are isomorphic, as in the example of a btree containing the key and remaining tuple values, then all other representations of the same relation are redundant. Under storage pressure, we can delete all but one representation. Which one the DBMS chooses to delete is arbitrary. When we have adequate space, we can create additional representations in the background without affecting correctness.

100+

101+The on-disk representation need not correspond to the logical relation variables at all. Besides query caches, the DBMS can freely store multiple relations in the same file as long as there is a relational expression to distinguish between the logical relation variables. Conversely, a single relation variable's value could span multiple files, simulating what other DBMSes call sharding but without exposing the implementation details to the users.

102+

103+Considering that user involvement in the creation of relation representations is the norm, how can the DBMS create such representations and maintain them automatically? This will likely be an area of research, but we can start simply with a query cache and automatic cost-based indexing based on actual queries executed.

104+

105+When broken free from user control, the DBMS is free to create arbitrary representations with the only consideration being available IO and memory resources.

106+

107+### Deferred updates

108+

109+Virtually all DBMSes execute database updates against existing files which store tuples. However, because Project:M36 updates are idempotent, we can save expressions to disk for *deferred updates*. Database update expressions saved to disk can drastically increase the rate at which we can execute updates because the expression is likely far smaller than the number of tuples which the expression will change. Because Project:M36 uses per-transaction directories, once a deferred update is actually evaluated, the directory can be atomically replaced with the evaluated result. Of course, to save disk storage and IO, the DBMS can also choose to discard the evaluated result and continue to store the update. This is nothing novel- git does this by storing code diffs between commits. The only novelty is in recognizing the value of idempotent updates.

110+

111+### Linked relations

112+

113+Every database update creates a new state based on an old state and an update expression. In the previous section, we demonstrated how the expression along with the previous state is sufficient to create the new state. Alternatively, the DBMS can also store a "diff" (difference) in the form of a relational expr with a link to the previous state.

114+

115+For example, if we have a relation variable of employees' names and we insert another employee name, the new state is the union of the previous state of the relation variable and a relation containing the new employee's name. The evaluated expression which requests the new state is merely replaced with the union- similar to a macro.

116+

117+This strategy can also be viewed as a form of compression. In the general case where a relation variable has not changed from one transaction to the next transaction, we can merely store what amounts to a symbolic link to the relation variable in the previous state.

118+

119+### Risks of Redesign

120+

121+* cborg module has had only one release, is probably less than ready for production use, but the initial results are promising and is developed and backed by well-known Haskellers and a Haskell shop

122+ * are there alternatives we should consider?

123+* increased code complexity

124+ * executor needs to be separated from current relational EDSL to support scanning various types of relation representations

125+ * the new EDSL may not leak its representations to the user-level EDSL

126+ * query executor will need access to the full transaction graph to cover relation links and deferred updates; currently, all state is wrapped up into the `DatabaseContext`

127+* how and when to create new relation representations and when to defer updates will be an active area of research

128+* requires more consideration in reducing IO and storage requirements; this was not a major driver of the initial design

docs/import_export_csv.markdownnew file+65

@@ -0,0 +1,65 @@

1+# Project:M36 CSV Import/Export

3+Project:M36's `tutd` console supports the import and export of CSV files as a lowest-common denominator format for moving data. Because the CSV file format does not support all the features of Project:M36- most notably, nested relations- not all relation variables can be marshalled to-and-from CSV files.

5+## CSV Export

7+If a relation variable cannot be exported due to data types which are not supported by the CSV format- such as with a nested relation- then Project:M36 throws an error rather than export a partial file.

9+### Example Export

10+

11+```

12+TutorialD (master/main): :importexample cjdate

13+TutorialD (master/main): :exportcsv s "/tmp/csv"

14+```

15+```

16+$ cat /tmp/csv

17+s#,sname,status,city

18+S2,Jones,10,Paris

19+S1,Smith,20,London

20+S4,Clark,20,London

21+S5,Adams,30,Athens

22+S3,Blake,30,Paris

23+```

24+

25+## CSV Import

26+

27+An import is equivalent to an insert and does not replace the target relation variable.

28+

29+Because relations do not have a natural ordering for their attributes, the CSV file to import must contain a header row which matches the names of attributes.

30+

31+If a value in the CSV file cannot be converted to the expected type (determined by the existing relation attributes), then the entire import is aborted rather than perform a partial import.

32+

33+### Example Import

34+```

35+$ cat /tmp/csv

36+s#,sname,status,city

37+S6,Samson,100,New York

38+```

39+```

40+TutorialD (master/main): :importexample cjdate

41+TutorialD (master/main): :showexpr s

42+┌──────────┬────────┬───────────┬───────────────┐

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

44+├──────────┼────────┼───────────┼───────────────┤

45+│"Paris" │"S2" │"Jones" │10 │

46+│"Paris" │"S3" │"Blake" │30 │

47+│"London" │"S4" │"Clark" │20 │

48+│"London" │"S1" │"Smith" │20 │

49+│"Athens" │"S5" │"Adams" │30 │

50+└──────────┴────────┴───────────┴───────────────┘

51+TutorialD (master/main): :importcsv "/tmp/csv" s

52+TutorialD (master/main): :showexpr s

53+┌──────────┬────────┬───────────┬───────────────┐

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

55+├──────────┼────────┼───────────┼───────────────┤

56+│"Paris" │"S3" │"Blake" │30 │

57+│"London" │"S4" │"Clark" │20 │

58+│"New York"│"S6" │"Samson" │100 │

59+│"Athens" │"S5" │"Adams" │30 │

60+│"London" │"S1" │"Smith" │20 │

61+│"Paris" │"S2" │"Jones" │10 │

62+└──────────┴────────┴───────────┴───────────────┘

63+```

64+

65+Note that relations do not have ordering, thus, no ordering from the CSV file is preserved.

docs/introduction_to_projectm36.markdown+35−14

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

1# Introduction to Project:M36

3## What is Project:M36?

4−Project:M36 is a relational-algebra-based database management system. It can be used a production-level database backend or for learning more about the relational algebra.

4+Project:M36 is a relational-algebra-based database management system. It can be used as a production-level database backend or for learning more about the relational algebra.

6The principled mathematical approach to Project:M36's design sets it apart from competing DBMSs. Specifically, Project:M36 adheres strongly to the mathematics of the relational algebra and makes no compromises nor apologies in doing so. To that end, Project:M36 is implemented in the programming language "Haskell" which is itself based on the lambda calculus.

@@ -15,38 +15,59 @@ The relational algebra is the mathematical model underpinning Project:M36. When

16## Binary Releases

18−### Windows

18+The quickest and preferred method of installation is via docker, which works on Linux, macOS, and Windows. Docker downloads and runs preconfigured software in secure, sandboxed containers, preventing third-party software from altering the host system without your permission.

19−Project:M36 now provides binary installations for Windows. Check the (releases page)[https://github.com/agentm/project-m36/releases] for downloads.

21−### MacOS X

20+### Install Docker:

23−Binary releases are not yet available for MacOS X, but compiling from source is easy.

22+* [Windows 10 Docker Installation](https://docs.docker.com/docker-for-windows/wsl/)

23+* [MacOS Docker Installation](https://docs.docker.com/docker-for-mac/install/)

24+* [Linux Docker Installation](https://docs.docker.com/engine/install/#server)

25−### Linux

26+### Run TutorialD from Docker Image

27−The currently-preferred method of installation is from source. A future enhancement would be installation from deb or rpm.

28+This downloads the docker image tagged "latest" and runs `tutd`, the TutorialD command line interface. Try the [15-Minute TutorialD Tutorial](15_minute_tutorial.markdown) and try some expressions.

29+

30+```bash

31+docker run -it projectm36/project-m36 tutd

32+```

33+

34+### Run Project:M36 Server

35+

36+The default port for the project-m36 server is 6543.

37+

38+```bash

39+docker run --network host projectm36/project-m36 project-m36-server -n <database_name>

40+```

41+

42+### Connect to Project:M36 Server

43+

44+```bash

45+docker run --network host projectm36/project-m36

46+```

29## Source Installation

48## Source Installation

31Requirements:

50Requirements:

52+To build with stack:

53+

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

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

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

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

35−* Linux, MacOS X, or Windows OS

56+* Linux, macOS, or Microsoft Windows

37Compilation steps:

58Compilation steps:

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

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

40* ```cd project-m36```

61* ```cd project-m36```

41−* ```stack build```

62+* ```stack --stack-yaml stack.ghc8.6.yaml build```

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

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

45−Alternative building with GHC 8.0.x:

66+Alternative building with GHC 8.6.5 or greater:

47* ```cabal new-build```

68* ```cabal new-build```

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

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

51## Accessing Project:M36 Databases

72## Accessing Project:M36 Databases

@@ -65,7 +86,7 @@ In addition to being a relational algebra engine, Project:M36 supports features

66Most DBMSs provide a way to allow the user to specify atomic database state changes. These changes are often wrapped up as "transactions" which, when applied to the database state, offer the illusion of sequential and grouped, atomic changes applied to the databases. Often the only state which can be queried is the snapshot at the time the transaction is opened.

87Most DBMSs provide a way to allow the user to specify atomic database state changes. These changes are often wrapped up as "transactions" which, when applied to the database state, offer the illusion of sequential and grouped, atomic changes applied to the databases. Often the only state which can be queried is the snapshot at the time the transaction is opened.

68−Project:M36 extends this transaction model with the "transaction graph". This feture can be adequately described as version control for transactions. In the legacy DBMS model, the transactions are added to a linear transaction stream where each client is contending over the "head" of the stream- the latest transactions. In the transaction graph model, clients can add named branches and add transactions to the branches, then merge changes back, if necessary.

89+Project:M36 extends this transaction model with the "transaction graph". This feature can be adequately described as version control for transactions. In the legacy DBMS model, the transactions are added to a linear transaction stream where each client is contending over the "head" of the stream- the latest transactions. In the transaction graph model, clients can add named branches and add transactions to the branches, then merge changes back, if necessary.

70This feature is useful, for example:

91This feature is useful, for example:

71* during testing- create a testing branch which production will never see. This obviates the need for a separate production data set.

92* during testing- create a testing branch which production will never see. This obviates the need for a separate production data set.

@@ -87,7 +108,7 @@ Decreasing a transaction's durability can reduce IO contention at the cost of re

108

88### Native Haskell Compatibility

109### Native Haskell Compatibility

110

90−Any Haskell data type which implements the ```Atom``` typeclass can be manipulated as a value in the database.

111+Any Haskell data type which implements the ```Atomable``` typeclass can be manipulated as a value in the database.

112

92Haskell functions which operate on those values can also be added to the database.

113Haskell functions which operate on those values can also be added to the database.

114

docs/introduction_to_the_relational_algebra.markdown+2−2

@@ -202,7 +202,7 @@ Join (Instructor relation)

202

203(Course Relation)

204

205−|(Course Name, Course Name Type)|(Instructor, Instructor Name Type)|(Course Room Number, Room Number Type)|

205+|(Course Name, Course Name Type)|(Instructor Name, Instructor Name Type)|(Course Room Number, Room Number Type)|

206|-------------------------------|----------------------------------|--------------------------------------|

207|English 1|Steve|Room 104|

208|French 2|Bob|Room 103|

@@ -378,7 +378,7 @@ Since a value can store any (immutable) type, it can certainly hold a relation.

378

379For example, in SQL, if one wants to collect some aggregate data over some tuples while still returning the individual tuples, in the best case, the aggregate information must be repeated for every individual tuple. In the worst case, two separate queries are required since nested tables are not supported.

380

381−In the relational algebra, The aggregate value can be placed alongside the relation value from whic the aggregate was derived.

381+In the relational algebra, The aggregate value can be placed alongside the relation value from which the aggregate was derived.

382

383Example:

384

docs/jupyter_kernel.markdownnew file+49

@@ -0,0 +1,49 @@

1+# TutorialD Jupyter Kernel for Project:M36

3+## Introduction

5+[The Jupyter Notebook](https://jupyter-notebook.readthedocs.io/en/stable/notebook.html) is web-based tool for experimenting with various languages. Project:M36 offers a Jupyter kernel for the TutorialD interpreter.

7+The kernel automatically starts and stops its own websocket-server-based database and offers no filesystem persistence, which is similar to other jupyter kernels.

9+## Installation

10+

11+To install the `tutd` kernel:

12+

13+* install the `itutd` module into your jupyter virtual environment:

14+```

15+$ cd project-m36/jupyter/itutd

16+$ pip install .

17+```

18+

19+* install `kernel.json`:

20+

21+ ```$ mkdir ~/Library/Jupyter/kernels/itutd && cp project-m36/jupyter/kernel.json ~/Library/Jupyter/kernels/itutd``` (macOS)

22+

23+ ```$ mkdir ~/.local/share/jupyter/kernels/tutd && cp project-m36/jupyter/kernel.json ~/.local/share/jupyter/kernels/tutd``` (Linux)

24+

25+ ```$ mkdir %APPDATA%\jupyter\kernels\tutd && copy project-m36\jupyter\kernel.json %APPDATA%\jupyter\kernels\tutd``` (Windows)

26+

27+* check that the kernel is detected:

28+```

29+$ jupyter kernelspec list

30+Available kernels:

31+ python2 ...

32+ tutd ...

33+```

34+

35+* add `project-m36-server` to `PATH` environment variable

36+

37+```

38+$ export PATH=$PATH:<path/to/project-m36-websocket-server>

39+$ which project-m36-websocket-server

40+/path/to/project-m36-websocket-server

41+```

42+

43+From within this python virtual environment, you can now start jupyter with TutorialD support.

44+

45+## Usage

46+

47+With the kernel installed, run `jupyter notebook` for the web-based interface and click "New" at the top right of the page. The TutorialD kernel should be in the list.

48+

49+Once a new TutorialD notebook is opened, the interpreter is identical to the `tutd` command line interpreter and accepts the same commands. If you are new to Project:M36-flavored TutorialD, please [read the tutorial](/docs/tutd_tutorial.markdown).

docs/merkle_transaction_graph.markdownnew file+33

@@ -0,0 +1,33 @@

1+# Project:M36: Merkle Hashing for Transaction Graph

3+## Introduction

5+Project:M36 supports an append-only transaction graph model (similar to git) whereby new transactions can be added to the graph but not removed. As with any graph, each node can contain a Merkle hash which ensures not only that it's state since being added to the graph has not changed but also that none of its parent nodes all the way to the root node (initial state) have not been modified. This validation has a number of use cases.

7+## Usage

9+Project:M36 automatically adds Merkle hashes to every transaction. All data which represents the database state at that transaction is included in the hash including (but not limited to) relation variable definitions, atom and database context functions, constraints, and types.

10+

11+Project:M36 validates all merkle hashes at database startup. For users who need validation after the database is started, the user can issue `:validatemerklehashes` at the `tutd` command line.

12+

13+### Audit Logging

14+

15+Project:M36 supports audit logging by allowing users to travel to transactions in the past and recreate the database state at that past point-in-time. To ensure that those past states cannot be modified either by malicious on-disk or in-memory changes, each transaction is protected by its own Merkle hash. If the calculated hash does not match the stored hash, Project:M36 can immediately report which transaction triggered the tamper-proof log.

16+

17+### Reproducibility

18+

19+Since a Merkle tree is effectively immutable except to add more nodes, it can be used to save and restore a whole database with very high confidence in the results. This feature could also be used to restore a database partially; for example, to duplicate just the latest database state on a second machine for OLAP analysis.

20+

21+### High-Availability

22+

23+Merkle tree hashes can be used to assert database integrity across high-availibility or database replication. Since the hash covers all database state, it can be used to validate log-shipping-based replication. Corrupted cache tuple data can be easily detected and flushed.

24+

25+## Merkle Hashes in Other DBMSes

26+

27+While Merkle hashes have become prevalent in blockchain-style databases, they have not made many appearances in typical SQL databases. This is likely due to the fact that such databases consider any additional operations against the large tuple stores as prohibitively expensive. Project:M36 is able to skirt this cost by only hashing database update expressions rather than the result of these executed expressions. This also means that the Merkle hash can be computed against transactions which have been created but never executed.

28+

29+## Conclusion

30+

31+Merkle hashes are an obvious improvement to any graph-based transaction log and are a low-cost method of ensuring data integrity.

32+

33+A further improvement could allow users to specify an initial key provided by an admin user to salt the hash used to create the database. Additionally, a multi-user system could allow individual users to sign their committed transactions. The signature would then be included in the Merkle hash.

docs/new_datatypes.markdown+1−1

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

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

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

108

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.

110

111To 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/reaching_out_of_the_tarpit.markdown+7−7

@@ -2,11 +2,11 @@

3## Introduction

5−[Project:M36](https://github.com/agentm/project-m36) is a relational algebra database management system (RDBMS) written in the Haskell programming language whose purpose is to implement the foundation for functional relational programming as described in the excellent paper ["Out of the Tarpit"](http://shaffner.us/cs/papers/tarpit.pdf). This document describes how Project:M36 meets the design goals laid out in the paper.

5+[Project:M36](https://github.com/agentm/project-m36) is a relational algebra database management system (RDBMS) written in the Haskell programming language whose purpose is to implement the foundation for functional relational programming as described in the excellent paper ["Out of the Tarpit"](https://github.com/papers-we-love/papers-we-love/blob/2eb8d21/design/out-of-the-tar-pit.pdf). This document describes how Project:M36 meets the design goals laid out in the paper.

7## Why is "Out of the Tarpit" Important?

9−The "Out of the Tarpit" paper, written in 2006, consolidates decades of software development research and experience to explain why software written today is chock-full of software bugs. The paper categorizes sources of complexity and then proceeds to propose a software architecture which promises to reduce unnecessary software complexity so that the resultant software is maximally focused on actual business rules. It is recommended to read [the paper](http://shaffner.us/cs/papers/tarpit.pdf) before reading the remainder of this document.

9+The "Out of the Tarpit" paper, written in 2006, consolidates decades of software development research and experience to explain why software written today is chock-full of software bugs. The paper categorizes sources of complexity and then proceeds to propose a software architecture which promises to reduce unnecessary software complexity so that the resultant software is maximally focused on actual business rules. It is recommended to read [the paper](https://github.com/papers-we-love/papers-we-love/blob/2eb8d21/design/out-of-the-tar-pit.pdf) before reading the remainder of this document.

11## Laying the Foundations for Reduced Complexity

@@ -21,14 +21,14 @@ The central software component of functional-relational programming is a relatio

21* **declarative**: thus removing accidental complexity (such as accidental ordering)

22* **restricted**: removing mistaken features; if a programming language allows a programmer to do something less-than-savory, then that misfeature will be used

24−and provides ([p.37](http://shaffner.us/cs/papers/tarpit.pdf)):

24+and provides ([p.37](https://github.com/papers-we-love/papers-we-love/blob/2eb8d21/design/out-of-the-tar-pit.pdf)):

26* **structure**: a closed world system whereby all data is represented by relations

27* **manipulation**: a means to simulate mutation of the application state over time

28* **data integrity**: constraints which prevent illogical data constructions

29* **data independence**: logical and physical representations of state which are clearly separated

31−The relational model is a mathematical model for storing and manipulating "essential state" ([p.25](http://shaffner.us/cs/papers/tarpit.pdf)). As a mathematical model, it not beholden to any specific implementation or quirks.

31+The relational model is a mathematical model for storing and manipulating "essential state" ([p.25](https://github.com/papers-we-love/papers-we-love/blob/2eb8d21/design/out-of-the-tar-pit.pdf)). As a mathematical model, it not beholden to any specific implementation or quirks.

33Unfortunately, due to the quirks of legacy implementations, much of what developers learn about the relational model is [wrong](/docs/on_null.markdown). Project:M36 aims to rectify this situation by providing a mathematically coherent implementation of the relational model. Contrast the mathematical approach to existing databases which sacrifice or elide a mathematical model in lieu of "performance". Refer to [Knuth on premature optimization](https://en.wikiquote.org/wiki/Donald_Knuth) for additional details.

@@ -57,7 +57,7 @@ Project:M36 implements multiple interfaces:

57To understand how Project:M36 stacks up against the fictional programming language shown in the paper, we have implemented the [example from the paper](/examples/out_of_the_tarpit.tutd). The language used in the script is a dialect of Chris Date's TutorialD language. It can be loaded into an interactive ```tutd``` session like so:

59```

60−TutorialD (master/main): :importexample date

60+TutorialD (master/main): :importexample cjdate

61TutorialD (master/main): :showexpr p

62┌───────────────────┬────────────┬───────────────────┬────────────┬────────────┐

63│address::Address │agent::Agent│dateRegistered::Day│photo::Text │price::Price│

@@ -70,7 +70,7 @@ TutorialD (master/main): :showexpr p

71### Infrastructure Requirements

73−Project:M36 meets or exceeds the enumerated "Infrastructure" ([p.47](http://shaffner.us/cs/papers/tarpit.pdf)) requirements (except one):

73+Project:M36 meets or exceeds the enumerated "Infrastructure" ([p.47](https://github.com/papers-we-love/papers-we-love/blob/2eb8d21/design/out-of-the-tar-pit.pdf)) requirements (except one):

75* **Infrastructure for Essential State**: relation variable manipulation, storage, and data types

76* **Infrastructure for Essential Logic**: relational expression evaluation, functions to operate on values, a language (TutorialD or Haskell), type inference, and constraints

@@ -82,7 +82,7 @@ Derived relations, as described in the paper, are not supported in Project:M36 b

83### Feeders and Observers

85−The "Out of the Tarpit" paper distinguishes between pushing data to the database and pulling data out of the database ([p.46](http://shaffner.us/cs/papers/tarpit.pdf)): "feeders" continually update the state of the database to best reflect reality and "observers" request notifications on relational state changes and take action on them.

85+The "Out of the Tarpit" paper distinguishes between pushing data to the database and pulling data out of the database ([p.46](https://github.com/papers-we-love/papers-we-love/blob/2eb8d21/design/out-of-the-tar-pit.pdf)): "feeders" continually update the state of the database to best reflect reality and "observers" request notifications on relational state changes and take action on them.

87SQL developers are already intimately familiar with "feeders"- these are merely INSERT and UPDATE statements issued to the database via some middleware.

docs/server_mode.markdown+1−1

@@ -8,7 +8,7 @@ While Project:M36 is easy-to-use as an interactive, in-process database manageme

9To start the Project:M36 server to serve the local host with a database named "mydbname", run ```cabal run project-m36-server -- --database mydbname --hostname 127.0.0.1``` in the project-m36 source directory. The double-dash indicates that the arguments should be passed to ```project-m36-server``` instead of ```cabal```. Under normal conditions, this command will print nothing and block indefinitely to serve incoming requests on the default port 6543.

11−Note that the above invocation will serve and in-memory, transient "mydbname" database. The database is deleted when the server exits. To serve a database with filesystem persistence, invoke ```cabal run project-m36-server -- --database mydbname --hostname 127.0.0.1 --database-directory /path/to/dbdirectory --fsync```.

11+Note that the above invocation will serve an in-memory, transient "mydbname" database. The database is deleted when the server exits. To serve a database with filesystem persistence, invoke ```cabal run project-m36-server -- --database mydbname --hostname 127.0.0.1 --database-directory /path/to/dbdirectory --fsync```.

13## Connecting an Interactive Client

docs/transaction_graph_operators.markdown+8−18

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

11As 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.

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

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})

14−digraph G {

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

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

17− new -> base;

18−})

20Once 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.

15Once 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.

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

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})

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−})

31It 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.

19It 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.

@@ -55,15 +43,17 @@ TutorialD (master/main): :rollback

55In order to navigate the transaction graph, one must specify transaction UUIDs. Viewing the entirety of the transaction graph as a relation is a single command.

43In order to navigate the transaction graph, one must specify transaction UUIDs. Viewing the entirety of the transaction graph as a relation is a single command.

57```

45```

58−TutorialD (master/main): :showgraph

59−┌─────────────┬──────────┬──────────────────────────────────────┬────────────────────────────┬──────────────────────────────┐

46+┌─────────────┬────────────────────────────────────────────┬──────────┬──────────────────────────────────────┬────────────────────────────────────────┬─────────────────────────────────┐

60−│current::Bool│head::Text│id::Text │parents::relation {id::Text}│stamp::DateTime │

47+│current::Bool│hash::ByteString │head::Text│id::Text │parents::relation {id::Text} │stamp::DateTime │

61−├─────────────┼──────────┼──────────────────────────────────────┼────────────────────────────┼──────────────────────────────┤

48+├─────────────┼────────────────────────────────────────────┼──────────┼──────────────────────────────────────┼────────────────────────────────────────┼─────────────────────────────────┤

49+

63<big result elided>

51<big result elided>

64```

52```

65The "current" attribute is a boolean value. If true, the transaction is the parent of the current database context. Commits will be children of this transaction.

53The "current" attribute is a boolean value. If true, the transaction is the parent of the current database context. Commits will be children of this transaction.

55+The "hash" attribute contains the merkle tree hash for the given transaction. This can be used to ensure that the transaction graph has been used in an append-only fashion, ensuring historical state and audit log integrity.

56+

67The "head" attribute is a boolean value indicating whether or not the transaction is a "head" node of its graph. Head nodes are nodes which have no children.

57The "head" attribute is a boolean value indicating whether or not the transaction is a "head" node of its graph. Head nodes are nodes which have no children.

69The "id" attribute is the UUID needed in order to navigate the graph.

59The "id" attribute is the UUID needed in order to navigate the graph.

docs/tupleable.markdown+23

@@ -23,12 +23,35 @@ instance Tupleable Person

24Now, ```Person``` values can be marshaled between the database and the client. The attribute names appearing in the Haskell data type will appear identically in the server with the same types.

26+### Changing Options

27+

28+If our field names don't exactly match attribute names, but follow a common pattern, we can derive Tupleable with custom options. Let's say each field on person has a prefix "person", but we still want to use the attribute names without the prefix. We can make use of the ProjectM36.Tupleable module to accomplish our goal like so:

29+

30+```haskell

31+import ProjectM36.Tupleable.Deriving

32+

33+data Person = Person {

34+ personName :: Text,

35+ personEmployeeNumber :: Int,

36+ personLikesHorses :: Bool

37+ }

38+ deriving stock Generic

39+ deriving Tupleable

40+ via Codec (Field (DropPrefix "person" >>> CamelCase)) Person

41+```

42+

43+The extensions DerivingGeneric, DerivingVia, TypeOperators, and DataKinds must be enabled for this code to compile. See the documentation on Hackage for all available options.

44+

26## Usage

45## Usage

28The ```Tupleable``` module includes the following functions:

47The ```Tupleable``` module includes the following functions:

30 * ```toInsertExpr :: forall a t. (Tupleable a, Traversable t) => t a -> RelVarName -> Either RelationalError DatabaseContextExpr```

49 * ```toInsertExpr :: forall a t. (Tupleable a, Traversable t) => t a -> RelVarName -> Either RelationalError DatabaseContextExpr```

31 * creates an ```Insert``` expression which can be used to insert a set of ```Tupleable``` values into the relation variable named by the ```RelVarName```

50 * creates an ```Insert``` expression which can be used to insert a set of ```Tupleable``` values into the relation variable named by the ```RelVarName```

51+ * ```toUpdateExpr :: forall a. Tupleable a => RelVarName -> [AttributeName] -> a -> Either RelationalError DatabaseContextExpr```

52+ * create an `Update` expression which updates the tuples with the attribute values of the argument `Tupleable` using the list of attribute names as the key to the underlying relation variable

53+ * ```toDeleteExpr :: forall a. Tupleable a => RelVarName -> [AttributeName] -> a -> Either RelationalError DatabaseContextExpr```

54+ * create a `Delete` expression which will remove the tuples from the relation variable matching the values of the argument `Tupleable` using the attribute name list as the matching key

32 * ```toAttributes :: proxy a -> Attributes```

55 * ```toAttributes :: proxy a -> Attributes```

33 * generates ```Attributes``` from a ```Tupleable``` value- can be used with ```undefined```, so an actual value is not necessary

56 * generates ```Attributes``` from a ```Tupleable``` value- can be used with ```undefined```, so an actual value is not necessary

34 * ```toTuple :: a -> RelationTuple```

57 * ```toTuple :: a -> RelationTuple```

docs/tutd_cheatsheet.markdownnew file+99

@@ -0,0 +1,99 @@

1+# Tutorial D Cheatsheet

3+The following tables list examples of expressions for `tutd`, Project:M36's "Tutorial D" implementation.

5+## Relational Expressions

7+Relational expressions query database state without being able to change it.

9+|Relational Expression |Description |

10+|------------------------------------------------------|---------------------------------------|

11+|`:showexpr p`|Display the relation variable `p`|

12+|`:showexpr s rename {city as town}`|Display the result after renaming a relational attribute|

13+|`:showexpr p{color,city}`|Display the result of the projection on the `color` and `city` attributes|

14+|`:showexpr p{all but city}`|Display the result of the projection of all attribute of `p` except `city`|

15+|`:showexpr p join sp`|Display the result of the relational expression `p` joined against `sp` (equivalent to `NATURAL JOIN` in SQL)|

16+|`:showexpr (s join sp){all from s}`|Display the result of a join but only include attributes from `s`|

17+|`:showexpr s semijoin sp`|Equivalent to `(s join sp){all from s}`|

18+|`:showexpr s antijoin sp`|Display the result of all tuples in `s` which do not match appear in the result of `s semijoin sp`|

19+|`:showexpr s union s`| Display the result of `s` unioned with itself (which is equivalent to `s`)|

20+|`:showexpr s:{status2:=add(10,@status)}`| Display the result of extending the `s` relation variable with a new attribute which adds 10 to each `status` attribute|

21+|`:showexpr s group ({sname,status,s#} as subrel)`| Display the result of grouping the `sname`, `status`, and `s#` into a subrel for each tuple in the `s` relation where the `city` attribute (not mentioned) is the grouping criteria|

22+|`:showexpr (s group ({sname,status,s#} as subrel)) ungroup subrel`| Display the result of unwrapping a subrelation to create one new tuple for each subrelation tuple in the result|

23+|`:showexpr s minus s`|Display the result after removing all tuples that match the second argument. `x minus x` is equivalent to `x where false`|

24+|`:showexpr relation{tuple{name "Mike",age 6},tuple{name "Sam",age 10}}`|Display an unnamed relation using manually constructed tuples|

25+|`:showexpr relation{a Integer, b Text}`|Display an empty-tupled relation of a specified type|

26+|`:showexpr relation{a Integer, b Text}{tuple{a 4, b "four"}}`|Display a relation bound by the specified types and containing one or more tuples|

27+|`:showexpr s group ({s#,sname,status} as subrel):{citycount:=count(@subrel)}`|Display a result which groups `s` by `city` and extends the relation by a count for each city.|

28+|`:showrelvars`|Display a list of relation variables in the current context along with their types (attributes)|

29+

30+## Built-In Types

31+

32+|Example Value Expression |Type |Explanation|

33+|------------------------------------------------------|---------------------------------------|-----------|

34+|`"abc"`|Text|UTF-8 string|

35+|`123`|Integer|an integer of limitless size (using gmp)|

36+|`int(456)`|Int|machine-word-based integer|

37+|`12.56`|Double|64-bit IEEE 754 floating point number|

38+|`dateTimeFromEpochSeconds(1502304846)`|DateTime||

39+|`fromGregorian(2017,05,30)`|Date||

40+|`t`|Bool|`t` or `f`|

41+|`bytestring("dGVzdGRhdGE=")`|Bytestring|base-64-encoded string of bytes|

42+|`interval(3,5,f,f)`|Interval(Integer)|the constructor function includes two bounds and two boolean flags for inclusiveness|

43+

44+## Database Context Expressions

45+

46+Database context expressions take the current database context as input and alter it to create a new

47+

48+|Database Context Expression |Description |

49+|------------------------------------------------------|---------------------------------------|

50+|`:importexample cjdate`|Imports a precooked schema from Chris Date's books resulting in relvars `s`, `sp`, and `p`|

51+|`:importtutd "file:///home/agentm/project-m36/scripts/emp.tutd"`|Imports TutorialD from file URI|

52+|`:importtutd "https://raw.githubusercontent.com/agentm/project-m36/master/scripts/emp.tutd" "effe32b247586dc3ac0079fc241b9618d41d189afcaeb7907edbe5a8b45992a4"`| Imports TutorialD from HTTP or HTTPS URI|

53+|`newrelvar:=relation{tuple{age 3}}`|Assign a new relation variable named `newrelvar`|

54+|`undefine s`|Remove a relation variable|

55+|`insert s relation{tuple{city "Boston",s# "S10",sname "Gonzalez",status 10}}`| Append to an existing relation variable with another relational expression|

56+|`update s where status=20 (sname:="Mr. Twenty")`|Replace one or more values in matching tuples with a new value|

57+|`delete sp where s#="S4"`|Remove tuples matching the criteria|

58+|`key s_key_constraint {s#} s`|Add a constraint named `s_key_constraint` on relation variable `s` ensuring that `s#` is unique|

59+|`foreign key s#_in_sp sp{s#} in s{s#}`|Add a foreign key constraint that ensures that `sp`'s `s#` attribute always references a `s#` value in `s`|

60+|`constraint s_status_less_than_50 (s where ^lt(50,@status)){} in false`|Add a constraint that stipulates that the `status` values in `s` are less than 50|

61+|`createarbitraryrelation employee {name Text, empid Int, hired DateTime} 3-100`|Create a relation variable with random values with between 3-100 tuples- useful for testing|

62+|`notify steve_change person where name="Steve" true (person where name="Steve"){address}`|Notify the current connection with an asynchronous event if any committed tuples matching `person where name="Steve"` with `true` for the pre-change state and `person where name="Steve"){address}` for the post-change state- these states will be sent along with the notification|

64+|`undata Hair`|Delete the `Hair` custom type|

65+

66+

67+## Transaction Graph Expressions

68+

69+Transaction graph expressions alter the state of the transaction graph by append new states.

70+

71+|Transaction Graph Expression |Description |

72+|------------------------------------------------------|---------------------------------------|

73+|`:commit`|Save the current database context to a new transaction and add it to the transaction graph|

74+|`:rollback`|Return the database context to the state before any alterations were made|

75+|`:branch experimental`|Create a new branch from the existing branch and switch the current context to be able to commit to the new branch|

76+|`:jumphead master`|Discard any changes in the current context and jump to the head of a different branch|

77+|`:jump 11b601c9-f46b-42b0-a2ce-cf18ced31b7f`|Jump to the specific transaction by UUID- useful for introspecting past states|

78+|`:showgraph`|Display a representation of the transaction graph|

79+|`:walkbacktotime "2017-08-10 16:44:00"`|Walk back in time from the current branch until a transaction less than or equal to the time is found and switch the current context to that past transaction- useful for auditing|

80+

81+## Data Frame Expressions

82+

83+In contrast to relational expressions, data frame expressions generate ordered tuples.

84+

85+|Data Frame Expression |Description |

86+|------------------------------------------------------|---------------------------------------|

87+|`:showdataframe s orderby {status}`|Display a data frame result for the relational expression `s` and sort the tuples by `status`|

88+|`:showdataframe s{status} orderby {status descending} offset 1 limit 3`|Display a data frame result for `s{status}` but ordered by `status` values descending, skip the first tuple, and return no more than 3 tuples|

89+

90+## Trans-Graph Relational Expressions

91+

92+Trans-graph relational expressions allow queries spanning multiple transactions.

93+

94+|Trans-Graph Relational Expressions |Description |

95+|------------------------------------------------------|---------------------------------------|

96+|`:showtransgraphexpr s@master join sp@master`|Display a result for joining `s` and `sp` on the branch `master`|

97+|`:showtransgraphexpr s@master~ join sp@master`|Display a result for joining `s` on the parent transaction of `master`'s current head and `sp` on master|

98+|`:showtransgraphexpr s@master~^2`|Display a result for `s` two parents previous to the parent of the current `master`'s head|

99+

docs/tutd_tutorial.markdown+306−187

@@ -14,20 +14,55 @@ TutorialD (master/main):

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

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 cjdate

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+

33+### Importing TutorialD from Other Sources

34+

35+The `tutd` console can also run TutorialD from a local file or from a web server.

36+

37+To import TutorialD from a file:

38+

39+```

40+:importtutd "file:///home/agentm/project-m36/scripts/emp.tutd"

41+```

42+

43+or from a web server:

44+

45+```

46+:importtutd "https://raw.githubusercontent.com/agentm/project-m36/master/scripts/DateExamples.tutd" "db9f3d9fe06d0a29b8355e045b89ec94d6428e3a3de93def7ca77bf0298b7010"

47+```

48+

49+The second argument is an optional SHA256 hash in hexadecimal form. This can be used to validate that the script has not changed since the last import. Importing TutorialD from the web is in general safe because it is effectively sandboxed with "Safe Haskell" for functions, so the script is contained security-wise, however, nothing prevents the script from running forever. Downloading a schema from the web is a great way to share schemas and to kick start your project without starting from scratch.

50+

17### Types

51### Types

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

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

21|Type Name|Explanation|Example|

55|Type Name|Explanation|Example|

22|---------|-----------|-------|

56|---------|-----------|-------|

23−|text|arbitrary text|"The Old Man and the Sea"|

57+|Text|arbitrary text|"The Old Man and the Sea"|

24−|int|any integer|-4|

58+|Integer|arbitarily-sized integer|-4|

59+|Int|machine word integer|int(10)|

25−|datetime|timestamp UTC|dateTimeFromEpochSeconds(1502304846)|

60+|DateTime|timestamp UTC|dateTimeFromEpochSeconds(1502304846)|

26−|date|calendar date|fromGregorian(2017,05,30)|

61+|Date|calendar date|fromGregorian(2017,05,30)|

27−|double|floating point number|3.1459|

62+|Double|floating point number|3.1459|

28−|bool|boolean value|t|

63+|Bool|boolean value|t|

29−|bytestring|arbitrary-length string of bytes- input is base64-encoded|bytestring("dGVzdGRhdGE=")|

64+|Bytestring|arbitrary-length string of bytes- input is base64-encoded|bytestring("dGVzdGRhdGE=")|

30−|interval x|interval/range type for ints, doubles, datetimes, and dates|interval(3,5,f,f)|

65+|Interval x|interval/range type for ints, doubles, datetimes, and dates|interval(3,5,f,f)|

32With regards to boolean values, be sure not to conflate ```t``` or ```f``` as a boolean value with ```true``` and ```false``` which are relation variables.

67With regards to boolean values, be sure not to conflate ```t``` or ```f``` as a boolean value with ```true``` and ```false``` which are relation variables.

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

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

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

38```

73```

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

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

40ERR: AtomFunctionTypeError "add" 2 IntAtomType StringAtomType

75ERR: AtomFunctionTypeError "add" 2 IntAtomType StringAtomType

41```

76```

@@ -48,7 +83,7 @@ Relation Variables are named cells which reference relations within a transactio

49Definition of a relation variable:

84Definition of a relation variable:

50```

85```

51−products :: {name char, age int}

86+products :: {name Text, age Integer}

52```

87```

53This expression creates a new relation variable in the current context which can refer to any relation with the header of "name" of type "char" and "age" of type int.

88This expression creates a new relation variable in the current context which can refer to any relation with the header of "name" of type "char" and "age" of type int.

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

67products{}

102products{}

68```

103```

104

70−### Date's Sample Relations

71−

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

73−

74−```

75−:importexample date

76−```

77−

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

79−

80−|Relation Variable Name|Description|

81−|----------------------|-----------|

82−|s|suppliers|

83−|p|parts|

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

85−

86### Relational Expressions

105### Relational Expressions

106

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

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

@@ -151,15 +170,15 @@ The unary rename operator outputs a new relation with chosen attributes renamed.

151

170

152```

171```

153TutorialD (master/main): :showexpr s rename {city as town}

172TutorialD (master/main): :showexpr s rename {city as town}

154−┌──┬─────┬──────┬──────┐

173+┌────────┬───────────┬───────────────┬──────────┐

155−│s#│sname│status│town │

174+│s#::Text│sname::Text│status::Integer│town::Text│

156−├──┼─────┼──────┼──────┤

175+├────────┼───────────┼───────────────┼──────────┤

157−│S3│Blake│30 │Paris │

176+│"S3" │"Blake" │30 │"Paris" │

158−│S4│Clark│20 │London│

177+│"S4" │"Clark" │20 │"London" │

159−│S5│Adams│30 │Athens│

178+│"S5" │"Adams" │30 │"Athens" │

160−│S1│Smith│20 │London│

179+│"S1" │"Smith" │20 │"London" │

161−│S2│Jones│10 │Paris │

180+│"S2" │"Jones" │10 │"Paris" │

162−└──┴─────┴──────┴──────┘

181+└────────┴───────────┴───────────────┴──────────┘

163```

182```

164

183

165#### Projection

184#### Projection

@@ -170,78 +189,153 @@ For example:

170

189

171```

190```

172TutorialD (master/main): :showexpr p{color,city}

191TutorialD (master/main): :showexpr p{color,city}

173−┌──────┬─────┐

192+┌──────────┬───────────┐

174−│city │color│

193+│city::Text│color::Text│

175−├──────┼─────┤

194+├──────────┼───────────┤

176−│London│Red │

195+│"London" │"Red" │

177−│Paris │Blue │

196+│"Paris" │"Green" │

178−│Oslo │Blue │

197+│"Oslo" │"Blue" │

179−│Paris │Green│

198+│"Paris" │"Blue" │

199+└──────────┴───────────┘

200+

201+```

202+

203+Projection attributes can also be inverted using `all but`:

204+

205+```

206+TutorialD (master/main): :showexpr s{all but city}

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

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

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

210+│"S2" │"Jones" │10 │

211+│"S3" │"Blake" │30 │

212+│"S1" │"Smith" │20 │

213+│"S5" │"Adams" │30 │

214+│"S4" │"Clark" │20 │

180−└──────┴─────┘

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

216+```

217+

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

219+

220+```

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

222+┌──────────┬────────┬───────────┬───────────────┐

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

224+├──────────┼────────┼───────────┼───────────────┤

225+│"London" │"S1" │"Smith" │20 │

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

227+│"Paris" │"S2" │"Jones" │10 │

228+│"Paris" │"S3" │"Blake" │30 │

229+└──────────┴────────┴───────────┴───────────────┘

181```

230```

182

231

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

233+

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

235+

236+```

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

238+┌──────────┬────────────┬────────┬───────────┬───────────────┐

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

240+├──────────┼────────────┼────────┼───────────┼───────────────┤

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

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

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

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

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

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

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

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

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

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

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

252+```

253+

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

255+

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

257+

258+```

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

260+┌──────────┐

261+│city::Text│

262+├──────────┤

263+│"London" │

264+│"Paris" │

265+└──────────┘

266+```

267+

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

269+

183#### Restriction

270#### Restriction

184

271

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

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

186

273

187```

274```

188TutorialD (master/main): :showexpr p where color="Blue" and city="Paris"

275TutorialD (master/main): :showexpr p where color="Blue" and city="Paris"

189−┌─────┬─────┬──┬─────┬──────┐

276+┌──────────┬───────────┬────────┬───────────┬───────────────┐

190−│city │color│p#│pname│weight│

277+│city::Text│color::Text│p#::Text│pname::Text│weight::Integer│

191−├─────┼─────┼──┼─────┼──────┤

278+├──────────┼───────────┼────────┼───────────┼───────────────┤

192−│Paris│Blue │P5│Cam │12 │

279+│"Paris" │"Blue" │"P5" │"Cam" │12 │

193−└─────┴─────┴──┴─────┴──────┘

280+└──────────┴───────────┴────────┴───────────┴───────────────┘

194```

281```

195

282

196The restriction predicate can be built from "and", "not", and "or". Boolean atom functions can also appear in a restriction as long as they are preceded by "^". For example:

283The restriction predicate can be built from "and", "not", and "or". Boolean atom functions can also appear in a restriction as long as they are preceded by "^". For example:

197

284

198```

285```

199TutorialD (master/main): :showexpr s where ^lt(@status,20)

286TutorialD (master/main): :showexpr s where ^lt(@status,20)

200−┌─────┬──┬─────┬──────┐

287+┌──────────┬────────┬───────────┬───────────────┐

201−│city │s#│sname│status│

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

202−├─────┼──┼─────┼──────┤

289+├──────────┼────────┼───────────┼───────────────┤

203−│Paris│S2│Jones│10 │

290+│"Paris" │"S2" │"Jones" │10 │

204−└─────┴──┴─────┴──────┘

291+└──────────┴────────┴───────────┴───────────────┘

205```

292```

206

293

207#### Join

294#### Join

208

295

209−Joins are binary operators and are applied with the "join" keyword. The equivalent in SQL would be a "NATURAL JOIN". To join attributes which are not identically-named, use the rename operator

296+Joins are binary operators and are applied with the "join" keyword. The equivalent in SQL would be a "NATURAL JOIN". To join attributes which are not identically-named, use the `rename` operator.

210

297

211```

298```

212TutorialD (master/main): :showexpr s join sp

299TutorialD (master/main): :showexpr s join sp

213−┌──────┬──┬───┬──┬─────┬──────┐

300+┌──────────┬────────┬────────────┬────────┬───────────┬───────────────┐

214−│city │p#│QTY│s#│sname│status│

301+│city::Text│p#::Text│qty::Integer│s#::Text│sname::Text│status::Integer│

215−├──────┼──┼───┼──┼─────┼──────┤

302+├──────────┼────────┼────────────┼────────┼───────────┼───────────────┤

303+│"London" │"P2" │200 │"S1" │"Smith" │20 │

216−│London│P6│100│S1│Smith│20 │

304+│"London" │"P6" │100 │"S1" │"Smith" │20 │

217−│London│P3│400│S1│Smith│20 │

305+│"London" │"P3" │400 │"S1" │"Smith" │20 │

306+│"Paris" │"P2" │400 │"S2" │"Jones" │10 │

218−│London│P5│400│S4│Clark│20 │

307+│"London" │"P5" │400 │"S4" │"Clark" │20 │

308+│"Paris" │"P1" │300 │"S2" │"Jones" │10 │

219−│London│P1│300│S1│Smith│20 │

309+│"London" │"P1" │300 │"S1" │"Smith" │20 │

220−│Paris │P2│200│S3│Blake│30 │

310+│"Paris" │"P2" │200 │"S3" │"Blake" │30 │

221−│Paris │P1│300│S2│Jones│10 │

311+│"London" │"P4" │300 │"S4" │"Clark" │20 │

222−│London│P5│100│S1│Smith│20 │

223−│London│P4│300│S4│Clark│20 │

312+│"London" │"P2" │200 │"S4" │"Clark" │20 │

224−│Paris │P2│400│S2│Jones│10 │

225−│London│P2│200│S1│Smith│20 │

313+│"London" │"P4" │200 │"S1" │"Smith" │20 │

226−│London│P4│200│S1│Smith│20 │

314+│"London" │"P5" │100 │"S1" │"Smith" │20 │

227−└──────┴──┴───┴──┴─────┴──────┘

315+└──────────┴────────┴────────────┴────────┴───────────┴───────────────┘

228−```

316+```

317+

318+As a convenience, `tutd` also supports semijoin (`matching`) and antijoin (`not matching`) syntax.

319+

320+`s matching sp` or `s semijoin sp` is equivalent to `(s join sp){all from s}` which returns all tuples in `s` which appear in the join of `s` and `sp`.

321+

322+`s not matching sp` or `s antijoin sp` is equivalent to `s minus (s matching sp)` which returns all tuples in `s` which do not appear in the join of `s` and `sp`. Thus, semjoin and antijoin are inverses of each other.

229

323

230#### Union

324#### Union

231

325

232The binary union operator merges tuples from both relations if-and-only-if the attributes of both relations are identical. The SQL equivalent is the "UNION" operator. Unlike SQL, however, duplicate tuples are not tolerated, so there is no "UNION ALL" equivalent in the relational algebra.

326The binary union operator merges tuples from both relations if-and-only-if the attributes of both relations are identical. The SQL equivalent is the "UNION" operator. Unlike SQL, however, duplicate tuples are not tolerated, so there is no "UNION ALL" equivalent in the relational algebra.

233

327

234```

328```

235−TutorialD (master/main): :showexpr S union S

329+TutorialD (master/main): :showexpr s union s

236−┌──────┬──┬─────┬──────┐

330+┌──────────┬────────┬───────────┬───────────────┐

237−│city │s#│sname│status│

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

238−├──────┼──┼─────┼──────┤

332+├──────────┼────────┼───────────┼───────────────┤

239−│Paris │S3│Blake│30 │

333+│"Paris" │"S3" │"Blake" │30 │

240−│London│S4│Clark│20 │

241−│Athens│S5│Adams│30 │

334+│"Athens" │"S5" │"Adams" │30 │

242−│London│S1│Smith│20 │

335+│"London" │"S1" │"Smith" │20 │

243−│Paris │S2│Jones│10 │

336+│"Paris" │"S2" │"Jones" │10 │

337+│"London" │"S4" │"Clark" │20 │

244−└──────┴──┴─────┴──────┘

338+└──────────┴────────┴───────────┴───────────────┘

245```

339```

246

340

247The union of any relation with itself is itself.

341The union of any relation with itself is itself.

@@ -252,15 +346,15 @@ The extend unary operator adds an attribute to a relation's header and body and

252

346

253```

347```

254TutorialD (master/main): :showexpr s:{status2:=add(10,@status)}

348TutorialD (master/main): :showexpr s:{status2:=add(10,@status)}

255−┌──────┬──┬─────┬──────┬───────┐

349+┌──────────┬────────┬───────────┬───────────────┬────────────────┐

256−│city │s#│sname│status│status2│

350+│city::Text│s#::Text│sname::Text│status::Integer│status2::Integer│

257−├──────┼──┼─────┼──────┼───────┤

351+├──────────┼────────┼───────────┼───────────────┼────────────────┤

258−│Paris │S2│Jones│10 │20 │

352+│"Paris" │"S2" │"Jones" │10 │20 │

259−│Athens│S5│Adams│30 │40 │

353+│"Athens" │"S5" │"Adams" │30 │40 │

354+│"London" │"S4" │"Clark" │20 │30 │

260−│Paris │S3│Blake│30 │40 │

355+│"Paris" │"S3" │"Blake" │30 │40 │

261−│London│S1│Smith│20 │30 │

356+│"London" │"S1" │"Smith" │20 │30 │

262−│London│S4│Clark│20 │30 │

263−└──────┴──┴─────┴──────┴───────┘

357+└──────────┴────────┴───────────┴───────────────┴────────────────┘

264```

358```

265

359

266The "@" is required in the above query in order to distinguish the attribute's name from a relation's name.

360The "@" is required in the above query in order to distinguish the attribute's name from a relation's name.

@@ -286,27 +380,27 @@ The group operator can also be used to emulate functionality similar to SQL's OU

286

380

287```

381```

288TutorialD (master/main): :showexpr s group ({sname,status,s#} as subrel)

382TutorialD (master/main): :showexpr s group ({sname,status,s#} as subrel)

289−┌──────┬─────────────────┐

383+┌──────────┬───────────────────────────────────────────────────────┐

290−│city │subrel │

384+│city::Text│subrel::relation {s#::Text,sname::Text,status::Integer}│

291−├──────┼─────────────────┤

385+├──────────┼───────────────────────────────────────────────────────┤

292−│Athens│┌──┬─────┬──────┐│

386+│"Athens" │┌────────┬───────────┬───────────────┐ │

293−│ ││s#│sname│status││

387+│ ││s#::Text│sname::Text│status::Integer│ │

294−│ │├──┼─────┼──────┤│

388+│ │├────────┼───────────┼───────────────┤ │

295−│ ││S5│Adams│30 ││

389+│ ││"S5" │"Adams" │30 │ │

296−│ │└──┴─────┴──────┘│

297−│London│┌──┬─────┬──────┐│

298−│ ││s#│sname│status││

299−│ │├──┼─────┼──────┤│

300−│ ││S1│Smith│20 ││

301−│ ││S4│Clark│20 ││

302−│ │└──┴─────┴──────┘│

390+│ │└────────┴───────────┴───────────────┘ │

303−│Paris │┌──┬─────┬──────┐│

391+│"Paris" │┌────────┬───────────┬───────────────┐ │

304−│ ││s#│sname│status││

392+│ ││s#::Text│sname::Text│status::Integer│ │

305−│ │├──┼─────┼──────┤│

393+│ │├────────┼───────────┼───────────────┤ │

306−│ ││S3│Blake│30 ││

307−│ ││S2│Jones│10 ││

394+│ ││"S2" │"Jones" │10 │ │

395+│ ││"S3" │"Blake" │30 │ │

396+│ │└────────┴───────────┴───────────────┘ │

397+│"London" │┌────────┬───────────┬───────────────┐ │

398+│ ││s#::Text│sname::Text│status::Integer│ │

399+│ │├────────┼───────────┼───────────────┤ │

400+│ ││"S4" │"Clark" │20 │ │

401+│ ││"S1" │"Smith" │20 │ │

308−│ │└──┴─────┴──────┘│

402+│ │└────────┴───────────┴───────────────┘ │

309−└──────┴─────────────────┘

403+└──────────┴───────────────────────────────────────────────────────┘

310```

404```

311

405

312#### Ungroup

406#### Ungroup

@@ -315,15 +409,15 @@ The unary ungroup operator "unwraps" subrelations in a relation-valued attribute

315

409

316```

410```

317TutorialD (master/main): :showexpr (s group ({sname,status,s#} as subrel)) ungroup subrel

411TutorialD (master/main): :showexpr (s group ({sname,status,s#} as subrel)) ungroup subrel

318−┌──────┬──┬─────┬──────┐

412+┌──────────┬────────┬───────────┬───────────────┐

319−│city │s#│sname│status│

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

320−├──────┼──┼─────┼──────┤

414+├──────────┼────────┼───────────┼───────────────┤

415+│"Paris" │"S2" │"Jones" │10 │

321−│Paris │S3│Blake│30 │

416+│"Paris" │"S3" │"Blake" │30 │

322−│London│S4│Clark│20 │

417+│"London" │"S4" │"Clark" │20 │

418+│"London" │"S1" │"Smith" │20 │

323−│Athens│S5│Adams│30 │

419+│"Athens" │"S5" │"Adams" │30 │

324−│London│S1│Smith│20 │

325−│Paris │S2│Jones│10 │

326−└──────┴──┴─────┴──────┘

420+└──────────┴────────┴───────────┴───────────────┘

327```

421```

328

422

329#### Minus

423#### Minus

@@ -356,11 +450,11 @@ The relation variable assignment mentioned above certainly changes the state of

356```

450```

357TutorialD (master/main): newrelvar:=relation{tuple{age 3}}

451TutorialD (master/main): newrelvar:=relation{tuple{age 3}}

358TutorialD (master/main): :showexpr newrelvar

452TutorialD (master/main): :showexpr newrelvar

359−┌───┐

453+┌────────────┐

360−│age│

454+│age::Integer│

361−├───┤

455+├────────────┤

362−│3 │

456+│3 │

363−└───┘

457+└────────────┘

364```

458```

365

459

366All further operators are convenience operators and could be implemented with simple assignment. SQL has no equivalent to relational assignment; instead, one must issue "CREATE TABLE" commands and insert rows into the resultant tables.

460All further operators are convenience operators and could be implemented with simple assignment. SQL has no equivalent to relational assignment; instead, one must issue "CREATE TABLE" commands and insert rows into the resultant tables.

@@ -382,16 +476,16 @@ The insert operators accepts a relation variable and a relation of the same type

382```

476```

383TutorialD (master/main): insert s relation{tuple{city "Boston",s# "S10",sname "Gonzalez",status 10}}

477TutorialD (master/main): insert s relation{tuple{city "Boston",s# "S10",sname "Gonzalez",status 10}}

384TutorialD (master/main): :showexpr s

478TutorialD (master/main): :showexpr s

385−┌──────┬───┬────────┬──────┐

479+┌──────────┬────────┬───────────┬───────────────┐

386−│city │s# │sname │status│

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

387−├──────┼───┼────────┼──────┤

481+├──────────┼────────┼───────────┼───────────────┤

388−│Paris │S3 │Blake │30 │

389−│London│S4 │Clark │20 │

390−│Athens│S5 │Adams │30 │

482+│"Athens" │"S5" │"Adams" │30 │

391−│London│S1 │Smith │20 │

392−│Paris │S2 │Jones │10 │

483+│"Paris" │"S2" │"Jones" │10 │

393−│Boston│S10│Gonzalez│10 │

484+│"Boston" │"S10" │"Gonzalez" │10 │

485+│"London" │"S4" │"Clark" │20 │

486+│"London" │"S1" │"Smith" │20 │

487+│"Paris" │"S3" │"Blake" │30 │

394−└──────┴───┴────────┴──────┘

488+└──────────┴────────┴───────────┴───────────────┘

395```

489```

396

490

397This insertion operation is equivalent to:

491This insertion operation is equivalent to:

@@ -406,15 +500,15 @@ The update operator accepts a relation argument and a predicate, optionally filt

406```

500```

407TutorialD (master/main): update s where status=20 (sname:="Mr. Twenty")

501TutorialD (master/main): update s where status=20 (sname:="Mr. Twenty")

408TutorialD (master/main): :showexpr s

502TutorialD (master/main): :showexpr s

409−┌──────┬──┬──────────┬──────┐

503+┌──────────┬────────┬────────────┬───────────────┐

410−│city │s#│sname │status│

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

411−├──────┼──┼──────────┼──────┤

505+├──────────┼────────┼────────────┼───────────────┤

506+│"Paris" │"S2" │"Jones" │10 │

507+│"London" │"S1" │"Mr. Twenty"│20 │

412−│Paris │S3│Blake │30 │

508+│"Paris" │"S3" │"Blake" │30 │

413−│London│S1│Mr. Twenty│20 │

509+│"London" │"S4" │"Mr. Twenty"│20 │

414−│Athens│S5│Adams │30 │

510+│"Athens" │"S5" │"Adams" │30 │

415−│Paris │S2│Jones │10 │

416−│London│S4│Mr. Twenty│20 │

417−└──────┴──┴──────────┴──────┘

511+└──────────┴────────┴────────────┴───────────────┘

418```

512```

419

513

420This is logically equivalent to:

514This is logically equivalent to:

@@ -422,15 +516,15 @@ This is logically equivalent to:

422```

516```

423TutorialD (master/main): s:=(((s where status=20){city,s#,status}):{sname:="Mr. Twenty"}) union (s where not status=20)

517TutorialD (master/main): s:=(((s where status=20){city,s#,status}):{sname:="Mr. Twenty"}) union (s where not status=20)

424TutorialD (master/main): :showexpr s

518TutorialD (master/main): :showexpr s

425−┌──────┬──┬──────────┬──────┐

519+┌──────────┬────────┬────────────┬───────────────┐

426−│city │s#│sname │status│

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

427−├──────┼──┼──────────┼──────┤

521+├──────────┼────────┼────────────┼───────────────┤

522+│"Paris" │"S2" │"Jones" │10 │

523+│"London" │"S1" │"Mr. Twenty"│20 │

428−│Paris │S3│Blake │30 │

524+│"Paris" │"S3" │"Blake" │30 │

429−│London│S1│Mr. Twenty│20 │

525+│"London" │"S4" │"Mr. Twenty"│20 │

430−│Athens│S5│Adams │30 │

526+│"Athens" │"S5" │"Adams" │30 │

431−│Paris │S2│Jones │10 │

432−│London│S4│Mr. Twenty│20 │

433−└──────┴──┴──────────┴──────┘

527+└──────────┴────────┴────────────┴───────────────┘

434```

528```

435

529

436This query means: "Drop the sname attribute from S filtered where status equals 20, extend the resultant relation by sname with value 'Mr. Twenty', then union the resultant relation with S filtered by status not equaling 20, and assign that to S."

530This query means: "Drop the sname attribute from S filtered where status equals 20, extend the resultant relation by sname with value 'Mr. Twenty', then union the resultant relation with S filtered by status not equaling 20, and assign that to S."

@@ -442,19 +536,19 @@ The delete operator accepts a relation argument and a filtering predicate, creat

442```

536```

443TutorialD (master/main): delete sp where s#="S4"

537TutorialD (master/main): delete sp where s#="S4"

444TutorialD (master/main): :showexpr sp

538TutorialD (master/main): :showexpr sp

445−┌──┬───┬──┐

539+┌────────┬────────────┬────────┐

446−│p#│QTY│s#│

540+│p#::Text│qty::Integer│s#::Text│

447−├──┼───┼──┤

541+├────────┼────────────┼────────┤

448−│P3│400│S1│

449−│P4│200│S1│

450−│P2│400│S2│

451−│P2│200│S1│

452−│P6│100│S1│

453−│P1│300│S1│

454−│P2│200│S3│

542+│"P2" │200 │"S3" │

543+│"P2" │400 │"S2" │

455−│P1│300│S2│

544+│"P1" │300 │"S1" │

456−│P5│100│S1│

545+│"P5" │100 │"S1" │

546+│"P4" │200 │"S1" │

547+│"P1" │300 │"S2" │

548+│"P3" │400 │"S1" │

549+│"P2" │200 │"S1" │

550+│"P6" │100 │"S1" │

457−└──┴───┴──┘

551+└────────┴────────────┴────────┘

458```

552```

459

553

460This is logically equivalent to:

554This is logically equivalent to:

@@ -489,7 +583,7 @@ Foreign keys are constraints which require that certain values appearing in one

489TutorialD (master/main): foreign key s#_in_sp sp{s#} in s{s#}

583TutorialD (master/main): foreign key s#_in_sp sp{s#} in s{s#}

490```

584```

491

585

492−This expression ensure that any sp{s#} must also appear as a value in s{s#}.

586+This expression ensure that any sp{s#} must also appear as a value in s{s#}. Note that the sub-expression (on the left of "in") and the super-expression (on the right) must be of the same relation type- the generated relation values' attribute names and types must be equal. Use `rename` to make attribute names identical.

493

587

494#### Functional dependencies

588#### Functional dependencies

495

589

@@ -523,27 +617,27 @@ SQL supports aggregate queries using aggregate functions (SUM(), COUNT(), AVERAG

523

617

524```

618```

525TutorialD (master/main): :showexpr s group ({s#,sname,status} as subrel):{citycount:=count(@subrel)}

619TutorialD (master/main): :showexpr s group ({s#,sname,status} as subrel):{citycount:=count(@subrel)}

526−┌──────┬─────────┬─────────────────┐

620+┌──────────┬──────────────────┬───────────────────────────────────────────────────────┐

527−│city │citycount│subrel │

621+│city::Text│citycount::Integer│subrel::relation {s#::Text,sname::Text,status::Integer}│

622+├──────────┼──────────────────┼───────────────────────────────────────────────────────┤

623+│"Athens" │1 │┌────────┬───────────┬───────────────┐ │

624+│ │ ││s#::Text│sname::Text│status::Integer│ │

528−├──────┼─────────┼─────────────────┤

625+│ │ │├────────┼───────────┼───────────────┤ │

626+│ │ ││"S5" │"Adams" │30 │ │

627+│ │ │└────────┴───────────┴───────────────┘ │

529−│Paris │2 │┌──┬─────┬──────┐│

628+│"Paris" │2 │┌────────┬───────────┬───────────────┐ │

530−│ │ ││s#│sname│status││

629+│ │ ││s#::Text│sname::Text│status::Integer│ │

531−│ │ │├──┼─────┼──────┤│

630+│ │ │├────────┼───────────┼───────────────┤ │

532−│ │ ││S3│Blake│30 ││

533−│ │ ││S2│Jones│10 ││

631+│ │ ││"S2" │"Jones" │10 │ │

632+│ │ ││"S3" │"Blake" │30 │ │

534−│ │ │└──┴─────┴──────┘│

633+│ │ │└────────┴───────────┴───────────────┘ │

535−│London│2 │┌──┬─────┬──────┐│

634+│"London" │2 │┌────────┬───────────┬───────────────┐ │

536−│ │ ││s#│sname│status││

635+│ │ ││s#::Text│sname::Text│status::Integer│ │

537−│ │ │├──┼─────┼──────┤│

636+│ │ │├────────┼───────────┼───────────────┤ │

637+│ │ ││"S4" │"Clark" │20 │ │

538−│ │ ││S1│Smith│20 ││

638+│ │ ││"S1" │"Smith" │20 │ │

539−│ │ ││S4│Clark│20 ││

540−│ │ │└──┴─────┴──────┘│

639+│ │ │└────────┴───────────┴───────────────┘ │

541−│Athens│1 │┌──┬─────┬──────┐│

542−│ │ ││s#│sname│status││

543−│ │ │├──┼─────┼──────┤│

544−│ │ ││S5│Adams│30 ││

545−│ │ │└──┴─────┴──────┘│

546−└──────┴─────────┴─────────────────┘

640+└──────────┴──────────────────┴───────────────────────────────────────────────────────┘

547```

641```

548

642

549In this query result, we can simultaneously answer how many suppliers are located in each city and which suppliers they are. The expression is constructed by first grouping to isolate the city, then extending the query to add a attribute containing the tuple count for each subrelation.

643In this query result, we can simultaneously answer how many suppliers are located in each city and which suppliers they are. The expression is constructed by first grouping to isolate the city, then extending the query to add a attribute containing the tuple count for each subrelation.

@@ -554,3 +648,28 @@ In this query result, we can simultaneously answer how many suppliers are locate

554|sum(relation{int})|return the int sum of the relation's values|

648|sum(relation{int})|return the int sum of the relation's values|

555|max(relation{int})|return the maximum int from all the relation's values|

649|max(relation{int})|return the maximum int from all the relation's values|

556|min(relation{int})|return the minimum int from all the relation's values|

650|min(relation{int})|return the minimum int from all the relation's values|

651+

652+#### Arbitrary Relation Variables

653+

654+For testing purposes, it can be useful to populate a database with randomly generated data. Project:M36 can automatically create such data based solely on the type of the relation.

655+

656+```

657+TutorialD (master/main): createarbitraryrelation employee {name Text, empid Int, hired DateTime} 3-100

658+TutorialD (master/main): :showexpr employee

659+┌──────────┬───────────────────────┬──────────┐

660+│empid::Int│hired::DateTime │name::Text│

661+├──────────┼───────────────────────┼──────────┤

662+│23 │1858-11-04 10:50:14 UTC│"LLL" │

663+│22 │1858-12-10 14:53:37 UTC│"LLL" │

664+│25 │1858-11-07 01:14:15 UTC│"SSS" │

665+│-12 │1858-11-06 06:20:57 UTC│"VVV" │

666+│-6 │1858-11-01 16:26:38 UTC│"SSS" │

667+│-1 │1858-10-31 14:41:26 UTC│"DDD" │

668+│-15 │1858-11-26 04:14:03 UTC│"VVV" │

669+│-18 │1858-12-17 00:01:09 UTC│"AAA" │

670+│-9 │1858-10-31 08:36:53 UTC│"XXX" │

671+│4 │1858-11-23 01:48:04 UTC│"VVV" │

672+└──────────┴───────────────────────┴──────────┘

673+```

674+

675+The `createarbitraryrelation` syntax specifies the name of the relation variable, the type for the relation, and then an acceptable range for the tuple count.

docs/websocket_server.markdown+3−3

@@ -6,7 +6,7 @@ The Project:M36 WebSocket server makes it easy to connect non-Haskell programs t

7## Setup

9−The websocket server is started with the same arguments as the normal [Project:M36 server](docs/server_mode.markdown):

9+The websocket server is started with the same arguments as the normal [Project:M36 server](server_mode.markdown):

11```

12cabal run project-m36-websocket-server -- --database mydbname --hostname 127.0.0.1

@@ -16,8 +16,8 @@ except that the websocket server is now listening for websocket connections on p

17## Client Connection

19−A [simple JavaScript library](/ProjectM36/Server/WebSocket/project-m36.js) to manage the WebSocket connection is available.

19+A [simple JavaScript library](/src/bin/ProjectM36/Server/WebSocket/project-m36.js) to manage the WebSocket connection is available.

21## Sample Application

23−The [WebSocket example application](/ProjectM36/Server/WebSocket/websocket-client.html) can be used to learn TutorialD and for remote database access from the web browser.

23+The [WebSocket example application](/src/bin/ProjectM36/Server/WebSocket/websocket-client.html) can be used to learn TutorialD and for remote database access from the web browser.

examples/CustomTupleable.hsnew file+67

@@ -0,0 +1,67 @@

1+{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}

2+--this example shows how to implement a non-generics-defined Tupleable instance which is required in scenarios where Haskell-side types are not supported server-side or where one wishes to represent a nested relation

3+import ProjectM36.Client

4+import ProjectM36.Tuple

5+import ProjectM36.Tupleable

6+import ProjectM36.Relation

7+import ProjectM36.Atom

8+import ProjectM36.Attribute as A

9+import qualified Data.Set as S

10+import qualified Data.Map as M

11+import Data.Text (Text)

12+import GHC.Generics

13+import Data.Proxy

14+

15+--in this contrived example, we wish to represent one relation with a nested relation of comments

16+data Blog = Blog {

17+ title :: Text,

18+ comments :: S.Set Comment

19+ } deriving (Show)

20+

21+data Comment = Comment {

22+ authorName :: Text,

23+ comment :: Text

24+ } deriving (Eq, Show, Generic, Ord)

25+

26+instance Tupleable Comment

27+

28+instance Tupleable Blog where

29+ toTuple blogentry =

30+ mkRelationTupleFromMap (M.fromList [("title", TextAtom (title blogentry)),

31+ ("comments", RelationAtom relFromComments)])

32+ where

33+ commentTuples = map toTuple (S.toList (comments blogentry))

34+ relFromComments = case mkRelationFromTuples (toAttributes (Proxy :: Proxy Comment)) commentTuples of

35+ Left err -> error (show err)

36+ Right rel -> rel

37+

38+ fromTuple tupIn = do

39+ titleAtom <- atomForAttributeName "title" tupIn

40+ commentsAtom <- atomForAttributeName "comments" tupIn

41+ commentsRel <- relationForAtom commentsAtom

42+ comments' <- mapM fromTuple (tuplesList commentsRel)

43+ pure Blog {

44+ title = atomToText titleAtom,

45+ comments = S.fromList comments'}

46+

47+ toAttributes _ = A.attributesFromList [Attribute "title" TextAtomType,

48+ Attribute "comments" $ RelationAtomType (toAttributes (Proxy :: Proxy Comment))]

49+

50+main :: IO ()

51+main = do

52+ let exampleBlog = Blog { title = "Cat Pics",

53+ comments = S.fromList [Comment {authorName = "Steve",

54+ comment = "great"},

55+ Comment {authorName = "Bob",

56+ comment = "enough"}

57+ ]}

58+ print (toTuple exampleBlog)

59+ print (fromTuple (toTuple exampleBlog) :: Either RelationalError Blog)

60+

61+

62+

63+

64+

65+

66+

67+

examples/DerivingCustomTupleable.hsnew file+54

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

1+{-# LANGUAGE DeriveGeneric, DerivingVia, GeneralizedNewtypeDeriving, TypeOperators, DataKinds, OverloadedStrings #-}

3+import ProjectM36.Tupleable.Deriving

4+import ProjectM36.Atomable (Atomable)

5+import Control.DeepSeq (NFData)

6+import Data.Text (Text)

7+import GHC.Generics (Generic)

8+import Codec.Winery

10+newtype BlogId = BlogId { getBlogId :: Int }

11+ deriving stock (Eq, Ord, Show, Generic)

12+ deriving newtype (Num)

13+ deriving Serialise via WineryRecord BlogId

14+

15+instance NFData BlogId

16+instance Atomable BlogId

17+

18+data Blog = Blog

19+ { blogId :: BlogId

20+ , blogTitle :: Text

21+ , blogAuthorName :: Text

22+ }

23+ deriving stock (Show, Generic)

24+ deriving (Tupleable)

25+ via Codec (Field (DropPrefix "blog" >>> CamelCase)) Blog

26+ deriving Serialise via WineryRecord Blog

27+

28+data Comment = Comment

29+ { commentAuthorName :: Text

30+ , commentComment :: Text

31+ , commentFor :: BlogId

32+ }

33+ deriving stock (Show, Generic)

34+ deriving (Tupleable)

35+ via Codec (Field (DropPrefix "comment" >>> CamelCase)) Comment

36+ deriving Serialise via WineryRecord Comment

37+

38+main :: IO ()

39+main = do

40+ let exampleBlog = Blog

41+ { blogId = 0

42+ , blogTitle = "Cat Pics"

43+ , blogAuthorName = "Alice"

44+ }

45+ exampleComment = Comment

46+ { commentAuthorName = "Bob"

47+ , commentComment = "great"

48+ , commentFor = 0

49+ }

50+ print exampleBlog

51+ print (toTuple exampleBlog)

52+ putStrLn ""

53+ print exampleComment

54+ print (toTuple exampleComment)

examples/DynamicAtomFunctions.hsnew file+12

@@ -0,0 +1,12 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+--compile with `cabal exec ghc -- examples/DynamicAtomFunctions.hs -package project-m36`

3+--load with `loadatomfunctions "DynamicAtomFunctions" "someAtomFunctions" "examples/DynamicAtomFunctions.o"`

5+module DynamicAtomFunctions where

6+import ProjectM36.Base

8+someAtomFunctions :: [AtomFunction]

9+someAtomFunctions = [AtomFunction{

10+ atomFuncName = "constTrue",

11+ atomFuncType = [TypeVariableType "a", BoolAtomType],

12+ atomFuncBody = AtomFunctionBody Nothing (\(x:_) -> pure (BoolAtom True))}]

examples/DynamicDatabaseContextFunctions.hsnew file+26

@@ -0,0 +1,26 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+--compile with `cabal exec ghc -- examples/DynamicDatabaseContextFunctions.hs -package project-m36`

3+--load with `loaddatabasecontextfunctions "DynamicDatabaseContextFunctions" "someDBCFunctions" "examples/DynamicDatabaseContextFunctions.o"`

4+module DynamicDatabaseContextFunctions where

5+import ProjectM36.Base

6+import ProjectM36.Relation

7+import ProjectM36.DatabaseContextFunctionError

8+import qualified ProjectM36.Attribute as A

10+import qualified Data.Map as M

11+

12+

13+someDBCFunctions :: [DatabaseContextFunction]

14+someDBCFunctions = [DatabaseContextFunction {

15+ dbcFuncName = "addtestrel",

16+ dbcFuncType = [],

17+ dbcFuncBody = DatabaseContextFunctionBody Nothing addTestRel

18+ }]

19+ where

20+ addTestRel _ ctx = do

21+ let attrs = A.attributesFromList [Attribute "word" TextAtomType]

22+ eRel = mkRelationFromList attrs [[TextAtom "nice"]]

23+ case eRel of

24+ Left err -> Left (DatabaseContextFunctionUserError (show err))

25+ Right testRel ->

26+ pure $ ctx { relationVariables = M.insert "testRel" testRel (relationVariables ctx) }

examples/Plantfarm.hsnew file+446

@@ -0,0 +1,446 @@

1+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE DeriveAnyClass #-}

7+{-# LANGUAGE DerivingVia #-}

10+import Codec.Winery (Serialise, WineryVariant(WineryVariant))

11+import Control.DeepSeq (NFData)

12+import Data.Aeson (FromJSON, ToJSON(toEncoding, toJSON))

13+import Data.Data (Proxy(Proxy))

14+import Data.Either (lefts, rights)

15+import Data.Functor (($>))

16+import Data.Text as T (Text)

17+import qualified Data.Text.Lazy as TL (pack)

18+import GHC.Generics (Generic)

19+import qualified ProjectM36.Base as Base

20+import ProjectM36.Client

21+ ( AtomExprBase(NakedAtomExpr)

22+ , Atomable(toAddTypeExpr, toAtom)

23+ , AttributeName

24+ , Connection

25+ , ConnectionInfo(InProcessConnectionInfo)

26+ , DatabaseContextExpr

27+ , DatabaseContextExprBase(Delete)

28+ , PersistenceStrategy(NoPersistence)

29+ , RelationalError

30+ , RelationalExprBase(RelationVariable, Restrict)

31+ , RestrictionPredicateExprBase(AttributeEqualityPredicate)

32+ , SessionId

33+ , close

34+ , commit

35+ , connectProjectM36

36+ , createSessionAtHead

37+ , databaseContextExprForUniqueKey

38+ , defaultHeadName

39+ , emptyNotificationCallback

40+ , executeDatabaseContextExpr

41+ , executeRelationalExpr

42+ , withTransaction

43+ )

44+import qualified ProjectM36.Relation as Relation

45+import ProjectM36.Tupleable

46+ ( Tupleable(fromTuple)

47+ , toDefineExpr

48+ , toDeleteExpr

49+ , toInsertExpr

50+ , toUpdateExpr

51+ )

52+import qualified System.Random as R

53+

54+

55+import Control.Monad.IO.Class (MonadIO(liftIO))

56+import qualified Web.Scotty as S

57+

58+-- | This is an example showcasing the updating of data

59+-- with the help of plants. \\

60+-- This is a very simple example and of course not how

61+-- plants grow in nature. \\

62+-- The main goal of this example is to showcase the updating

63+-- of data and the different options of persistence.

64+-- You can just pipe the output from curl into jq:

65+--

66+-- curl -X POST -H 'Accept: application/json' http://localhost:8001/plant/water/angu | jq -r '.stage'

67+

68+

69+data Stage = Seed | Sprout | Seedling | Adult | Dead

70+ deriving (Show, Eq, Ord, Generic, NFData, Atomable)

71+ deriving Serialise via WineryVariant Stage

72+

73+

74+instance ToJSON Stage where -- The where can be removed and the implementation commented out

75+ -- if the ascii values are not wanted

76+ toJSON s = toJSON $ show s <> "\nascii only provided for visualisation:\n" <> stagetoAscii s

77+

78+ toEncoding s = toEncoding $ show s <> "\nascii only provided for visualisation:\n" <> stagetoAscii s

79+

80+instance FromJSON Stage

81+

82+instance S.Parsable Stage where

83+ parseParam t

84+ | t == "seed" || t == "Seed" = Right Seed

85+ | t == "sprout" || t == "Sprout" = Right Sprout

86+ | t == "seedling" || t == "Seedling" = Right Seedling

87+ | t == "adult" || t == "Adult" = Right Adult

88+ | t == "dead" || t == "Dead" = Right Dead

89+ | otherwise = Left t

90+

91+

92+-- Just for ToJSON for ilustration of stage

93+type ASCIIStage = String

94+

95+seedStr :: ASCIIStage

96+seedStr = "<>\n\

97+ \'''\n"

98+sproutStr :: ASCIIStage

99+sproutStr = " ..\n\

100+ \<|>\n\

101+ \''''\n"

102+seedlingStr :: ASCIIStage

103+seedlingStr = " `\\⁄o \n\

104+ \ v|/\n\

105+ \'´;'''\n"

106+adultStr :: ASCIIStage

107+adultStr = "*~(#)~\n\

108+ \ \\,Y,e\n\

109+ \ \\|/\n\

110+ \''+'\\''\n"

111+deadStr :: ASCIIStage

112+deadStr = " ,__:<\n\

113+ \'/'''''\n"

114+

115+-- Just used for ToJSON illustration of stages

116+stagetoAscii :: Stage -> ASCIIStage

117+stagetoAscii Seed = seedStr

118+stagetoAscii Sprout = sproutStr

119+stagetoAscii Seedling = seedlingStr

120+stagetoAscii Adult = adultStr

121+stagetoAscii Dead = deadStr

122+

123+-- used for update stage

124+next :: Stage -> Stage

125+next Seed = Sprout

126+next Sprout = Seedling

127+next Seedling = Adult

128+next s = s

129+

130+data Plant = Plant { name :: Text, species :: Text, stage :: Stage, waterings:: Integer } deriving (Show, Generic)

131+instance Tupleable Plant

132+instance ToJSON Plant

133+instance FromJSON Plant

134+

135+

136+main :: IO ()

137+main = do

138+ putStrLn "Connecting to plant farm"

139+ c <- dbConnection

140+ _ <- createSchema c

141+ putStrLn "Planting some plants"

142+ _ <- insertSampleData c

143+ let port = 8001

144+ putStrLn $ "Started Plant farm at " <> show port

145+ S.scotty port $ do

146+

147+ -- retrieve a plant by name

148+ S.get "/plant/:name" $ do

149+ n <- S.param "name"

150+ e <- liftIO $ getPlant c n

151+ p <- handleWebError e

152+ S.json p

153+

154+

155+ -- save a plant providing it as json data

156+ S.post "/plant" $ do

157+ pl <- S.jsonData :: S.ActionM Plant

158+ e <- liftIO $ savePlant c [pl]

159+ p <- handleWebError e

160+ S.json p

161+

162+ -- updating a plant providing it as json data

163+ S.put "/plant" $ do

164+ pl <- S.jsonData :: S.ActionM Plant

165+ e <- liftIO $ updatePlantFst c pl

166+ p <- handleWebError e

167+ S.json p

168+

169+ -- watering the plant having the provided name.

170+ -- This will water the plant and might let it progress to the next stage. It might also die.

171+ S.post "/plant/water/:name" $ do

172+ n <- S.param "name"

173+ e <- liftIO $ waterPlant c n

174+ p <- handleWebError e

175+ S.json p

176+

177+ -- retriving all the plants as json data

178+ S.get "/plants" $ do

179+ e <- liftIO $ getAllPlants c

180+ ps <- handleWebErrors e

181+ S.json ps

182+

183+ -- saving many plants at the same time

184+ S.post "/plants" $ do

185+ pl <- S.jsonData :: S.ActionM [Plant]

186+ e <- liftIO $ savePlant c pl

187+ p <- handleWebError e

188+ S.json p

189+

190+ -- deleting all plants at a specific stage

191+ S.delete "/plants?stage=:stage" $ do

192+ s <- S.param "stage"

193+ e <- liftIO $ deletePlantsByStage c s

194+ p <- handleWebError e

195+ S.json p

196+

197+ -- deleting all plants at a specific stage

198+ S.delete "/plants" $ do

199+ s <- S.param "name"

200+ e <- liftIO $ deletePlantByName c s

201+ p <- handleWebError e

202+ S.json p

203+

204+ -- deleting all dead plants

205+ S.delete "/plants/clear" $ do

206+ e <- liftIO $ clearDeadPlants c

207+ ps <- handleWebErrors e

208+ S.json ps

209+

210+handleWebError :: Either Err b -> S.ActionM b

211+handleWebError (Left e) = S.raise (TL.pack $ "An error occurred:\n" <> show e)

212+handleWebError (Right v) = pure v

213+

214+handleWebErrors :: [Either Err b] -> S.ActionM [b]

215+handleWebErrors e = do

216+ case lefts e of

217+ [] -> pure (rights e)

218+ l -> S.raise (TL.pack $ "Errors occurred:\n" <> concatMap ((<>"\n") . show) l)

219+

220+

221+-- | watering a plant and thereby possibly updating its stage

222+waterPlant :: DBConnection -> Text -> IO (Either Err Plant)

223+waterPlant db n = do

224+ p <- getPlant db n

225+ case p of

226+ Left e -> pure $ Left e

227+ Right v -> updateStage db $ v { waterings = waterings v + 1 }

228+

229+-- | used by 'waterPlant' updates the stage depending on random numbers

230+updateStage :: DBConnection -> Plant -> IO (Either Err Plant)

231+updateStage db p@(Plant _ _ Dead _ ) = do

232+ tmp <- updatePlantFst db p

233+ case tmp of

234+ Left e -> pure $ Left e

235+ Right _ -> pure $ Right p

236+updateStage db p = do

237+ res <- calculateStage p

238+ tmp <- updatePlantFst db res

239+ case tmp of

240+ Left e -> pure $ Left e

241+ Right _ -> pure $ Right res

242+ where calculateStage p' = do

243+ r1 <- R.randomRIO (1, 10) :: IO Integer

244+ let np = if r1 < waterings p' then p' { stage = next $ stage p', waterings = 0 } else p'

245+ r2 <- R.randomRIO (1, 20)

246+ pure $ if r2 < waterings np then np { stage = Dead, waterings = 0 } else np

247+

248+-- | deletes all plants with Stage = Dead

249+clearDeadPlants :: DBConnection -> IO [Either Err Plant]

250+clearDeadPlants db = do

251+ _ <- deletePlantsByStage db Dead

252+ getAllPlants db

253+

254+

255+-- ****************************

256+-- | *Database functions* :

257+-- ****************************

258+

259+

260+-- | Error type for passing. It is not very specific.

261+-- Just minimal and non optimal for this example.

262+data Err = NotSpecified | NotFound deriving (Show ,Generic)

263+

264+instance ToJSON Err

265+

266+-- | Just for convinience for passing around the SessionId

267+-- and the Connection

268+data DBConnection = DB SessionId Connection

269+

270+

271+-- | Getting plants by their name.\

272+-- Because plant has name as primary key \

273+-- we can assume will get at most one result. \

274+-- Alternatively we could return a list.

275+getPlant :: DBConnection -> Text -> IO (Either Err Plant)

276+getPlant db n = defaultHead (Left NotFound) <$> (

277+ get db

278+ ( Restrict -- Restrict can be thought of as similar to "WITH" in SQL

279+ (AttributeEqualityPredicate "name" (NakedAtomExpr (toAtom n))) -- This is the Predicate we are "restricting" our RelationalExprBase with

280+ (RelationVariable "plants" ())

281+ )

282+ :: IO [Either Err Plant] -- this is needed because our 'get' function is

283+ )

284+

285+defaultHead :: a -> [a] -> a

286+defaultHead d [] = d

287+defaultHead _ (x:_) = x

288+

289+-- | Getting all the plants

290+getAllPlants :: DBConnection -> IO [Either Err Plant]

291+getAllPlants db = get db (RelationVariable "plants" ())

292+

293+-- | Getting all the plants that satisfy the restrictions

294+getAllPlantsWith :: DBConnection -> Base.RestrictionPredicateExpr -> IO [Either Err Plant]

295+getAllPlantsWith db ex = get db (Restrict ex (RelationVariable "plants" ()))

296+

297+

298+-- | Saving a plant

299+savePlant :: (Traversable t) => DBConnection -> t Plant -> IO (Either Err ())

300+savePlant db sps = insert db sps "plants"

301+

302+-- | An alternative to update alone because due to updates

303+-- not being cached yet \

304+-- they have to be calculated every update. \

305+-- This seems like an alternative until caching is implemented.

306+updatePlantFst :: DBConnection -> Plant -> IO (Either Err ())

307+updatePlantFst db pln = do

308+ _ <- delete db pln ["name"] "plants"

309+ savePlant db [pln]

310+

311+-- | Updating a plant. Due to the way project 36 works, \

312+-- updates have to be executed every time.\

313+-- This is slow but won't be an issue soon because they will

314+-- be cached.\

315+-- But because of this project 36 can provide O(1) commits.

316+updatePlant :: DBConnection -> Plant -> IO (Either Err ())

317+updatePlant db sps = update

318+ db -- db connection

319+ sps -- plant value

320+ ["name"] -- the attributes to be updated by (in case of unique key)

321+ "plants" -- the relation we want to update on

322+

323+

324+-- | deleting all plants that have given name.

325+deletePlantByName :: DBConnection -> Text -> IO (Either Err ())

326+deletePlantByName db s = executeWithTransaction db $ Right $ Delete "plants" $ AttributeEqualityPredicate "name" (NakedAtomExpr (toAtom s))

327+

328+-- | deleting all plants that have given stage.

329+deletePlantsByStage :: DBConnection -> Stage -> IO (Either Err ())

330+deletePlantsByStage db s = executeWithTransaction db $ Right $ Delete "plants" $ AttributeEqualityPredicate "stage" (NakedAtomExpr (toAtom s))

331+

332+

333+-- | Inserting the schema into the DB

334+createSchema :: DBConnection -> IO ()

335+createSchema (DB sessionId conn) = do

336+ _ <- handleIOErrorsAndQuit $ mapM (executeDatabaseContextExpr sessionId conn) [

337+ toAddTypeExpr (Proxy :: Proxy Stage) -- Adds the Type Stage as data to the DB

338+ , toDefineExpr (Proxy :: Proxy Plant) "plants" -- Creates the plants relation

339+ , databaseContextExprForUniqueKey "plants" ["name"] -- Makes name of the plants relation a uniqe Key,

340+ -- Foreign Key restrictions are available too

341+ ]

342+ pure ()

343+

344+

345+-- | inserting some sample data

346+insertSampleData :: DBConnection -> IO (Either Err ())

347+insertSampleData (DB sid conn) = do

348+ insert (DB sid conn) [

349+ Plant "angu" "Caladenia angustata" Seed 0

350+ , Plant "thely" "Thelymitra alcockiae" Seed 0

351+ , Plant "monstera" "Araceae" Seed 0

352+ ] "plants"

353+

354+dbConnection :: IO DBConnection

355+dbConnection = do

356+ -- connect to the database

357+ let connInfo = InProcessConnectionInfo NoPersistence emptyNotificationCallback []

358+ -- The code below persists the data in a DB with the name "base". \\

359+-- let connInfo = InProcessConnectionInfo (CrashSafePersistence "base") emptyNotificationCallback [] \\

360+ -- In addition minimal persistance is available. \\

361+-- let connInfo = InProcessConnectionInfo (MinimalPersistence "base") emptyNotificationCallback []

362+ conn <- handleIOErrorAndQuit $ connectProjectM36 connInfo

363+ --create a database session at the default branch of the database

364+ sessionId <- handleIOErrorAndQuit $ createSessionAtHead conn defaultHeadName

365+ pure (DB sessionId conn)

366+

367+

368+-- | A polymorphic function to insert data (a traversable of data) into the DB

369+insert :: (Tupleable a, Traversable t) => DBConnection -> t a -> Base.RelVarName -> IO (Either Err ())

370+insert db rlv rlvName = executeWithTransaction db $ toInsertExpr rlv rlvName

371+

372+-- | A polymorphic function to update data in the DB.

373+-- An update in one funtion would take:

374+--

375+-- - SessionId

376+-- - Connection

377+-- - Tuplable a -- the Tuplable you want to update

378+-- - [AttributeName] -- the Attributes of the Tuplable you want to update those are of StringType

379+-- - RelVarName -- the name of the relation

380+--

381+-- With that you can via 'toUpdateExpr' create a 'DatabaseContextExpr' to be executed. \\

382+-- For inserting its very similarly done with 'toInsertExpr'.

383+update :: (Tupleable a) => DBConnection -> a -> [AttributeName]-> Base.RelVarName -> IO (Either Err ())

384+update db rlv attr rlvName = executeWithTransaction db $ toUpdateExpr rlvName attr rlv

385+

386+-- | A polymorphic function to delete data in the DB

387+delete :: (Tupleable a) => DBConnection -> a -> [AttributeName]-> Base.RelVarName -> IO (Either Err ())

388+delete db rlv attr rlvName = executeWithTransaction db $ toDeleteExpr rlvName attr rlv

389+

390+-- | A convenience function to make executing DBContextExpr with commiting simpler. \\

391+-- In particular for expr that just insert, delete and update.

392+-- Therefor ultimately return Either _ ()

393+executeWithTransaction :: DBConnection -> Either RelationalError DatabaseContextExpr -> IO (Either Err ())

394+executeWithTransaction (DB sid conn) expr = do

395+ iEx <- handleError expr

396+ case iEx of

397+ Left e -> pure $ Left e

398+ Right v -> handleIOError $ withTransaction sid conn (executeDatabaseContextExpr sid conn v) (commit sid conn)

399+

400+-- | A polymorphic function to get data (a list of data and possibly errors) from the DB

401+get :: Tupleable b => DBConnection -> Base.RelationalExpr -> IO [Either Err b]

402+get (DB sessionId conn) q = do

403+ eRel <- executeRelationalExpr sessionId conn q

404+ e <- handleError eRel

405+ case e of

406+ Left err -> pure [Left err]

407+ Right pRel -> do

408+ ws <- Relation.toList pRel

409+ mapM (handleError . fromTuple) ws

410+

411+-- | for closing the DB connection.

412+-- Not really needed when using in-memory DB

413+closeConn :: DBConnection -> IO ()

414+closeConn (DB _ conn) = close conn

415+

416+

417+-- | Error handling is heavily inspired by 'blog.hs' the blog example \\

418+-- by (agentm)[https://github.com/agentm] (https://github.com/agentm/project-m36, commit: f8432522adaafeae7c32bc2b8b6cb09c00396fc6). \\

419+-- As stated there, your application should have proper error handling.

420+handleIOErrorAndQuit :: Show e => IO (Either e a) -> IO a

421+handleIOErrorAndQuit m = do

422+ v <- m

423+ handleErrorAndQuit v

424+

425+handleError :: Show e => Either e a -> IO (Either Err a)

426+handleError eErr = case eErr of

427+ Left err -> print err $> Left NotSpecified

428+ Right v -> pure $ Right v

429+

430+handleIOError :: Show e => IO (Either e a) -> IO (Either Err a)

431+handleIOError m = do

432+ v <- m

433+ handleError v

434+

435+handleErrorAndQuit :: Show e => Either e a -> IO a

436+handleErrorAndQuit eErr = case eErr of

437+ Left err -> print err >> error "Quit."

438+ Right v -> pure v

439+

440+handleIOErrorsAndQuit :: Show e => IO [Either e a] -> IO [a]

441+handleIOErrorsAndQuit m = do

442+ eErrs <- m

443+ case lefts eErrs of

444+ [] -> pure (rights eErrs)

445+ err:_ -> handleErrorAndQuit (Left err)

446+

examples/SimpleClient.hs+3−2

@@ -1,11 +1,12 @@

1import ProjectM36.Client

2import ProjectM36.TupleSet

3import ProjectM36.Relation.Show.Term

4+import Data.Text.IO as TIO

5main :: IO ()

6main :: IO ()

6main = do

7main = do

7 -- 1. create a ConnectionInfo

8 -- 1. create a ConnectionInfo

8− let connInfo = RemoteProcessConnectionInfo "mytestdb" (createNodeId "127.0.0.1" defaultServerPort) emptyNotificationCallback

9+ let connInfo = RemoteConnectionInfo "mytestdb" "127.0.0.1" (show defaultServerPort) emptyNotificationCallback

9 -- 2. conncted to the remote database

10 -- 2. conncted to the remote database

10 eConn <- connectProjectM36 connInfo

11 eConn <- connectProjectM36 connInfo

11 case eConn of

12 case eConn of

@@ -32,7 +33,7 @@ main = do

32 eRel <- executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "person" ()))

33 eRel <- executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "person" ()))

33 case eRel of

34 case eRel of

34 Left err -> print err

35 Left err -> print err

35− Right rel -> print (showRelation rel)

36+ Right rel -> TIO.putStrLn (showRelation rel)

37 --7. close the connection

38 --7. close the connection

38 close conn

39 close conn

examples/blog.hs+11−8

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

1-- a simple example of a blog schema

2−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, OverloadedStrings #-}

2+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, OverloadedStrings, CPP, DerivingVia #-}

4import ProjectM36.Client

5import ProjectM36.Base

@@ -10,16 +10,18 @@ import ProjectM36.Tuple (atomForAttributeName)

11import Data.Either

12import GHC.Generics

13−import Data.Binary

14import qualified Data.Text as T

13import qualified Data.Text as T

15import qualified Data.Text.Lazy as TL

14import qualified Data.Text.Lazy as TL

16import Data.Time.Clock

15import Data.Time.Clock

17import Data.Time.Calendar

16import Data.Time.Calendar

18import Control.DeepSeq

17import Control.DeepSeq

19import Data.Proxy

18import Data.Proxy

19+#if __GLASGOW_HASKELL__ < 804

20import Data.Monoid

21+#endif

21import Data.List

22import Data.List

22import Control.Monad (when, forM_)

23import Control.Monad (when, forM_)

24+import Codec.Winery

24import Web.Scotty as S

26import Web.Scotty as S

25import Text.Blaze.Html5 (h1, h2, h3, p, form, input, (!), toHtml, Html, a, toValue, hr, textarea)

27import Text.Blaze.Html5 (h1, h2, h3, p, form, input, (!), toHtml, Html, a, toValue, hr, textarea)

@@ -33,7 +35,7 @@ import Data.Time.Format

33data Blog = Blog {

35data Blog = Blog {

34 title :: T.Text,

36 title :: T.Text,

35 entry :: T.Text,

37 entry :: T.Text,

36− stamp :: UTCTime,

38+ tstamp :: UTCTime,

37 category :: Category --note that this type is an algebraic data type

39 category :: Category --note that this type is an algebraic data type

38 }

40 }

39 deriving (Generic, Show) --derive Generic so that Tupleable can use default instances

41 deriving (Generic, Show) --derive Generic so that Tupleable can use default instances

@@ -50,7 +52,8 @@ data Comment = Comment {

50instance Tupleable Comment

52instance Tupleable Comment

52data Category = Food | Cats | Photos | Other T.Text -- note that this data type could not be represented by an "enumeration" as found in SQL databases

54data Category = Food | Cats | Photos | Other T.Text -- note that this data type could not be represented by an "enumeration" as found in SQL databases

53− deriving (Atomable, Eq, Show, NFData, Binary, Generic) -- derive Atomable so that values of this type can be stored as a database value

55+ deriving (Atomable, Eq, Show, NFData, Generic) -- derive Atomable so that values of this type can be stored as a database value

56+ deriving Serialise via WineryVariant Category -- derive Serialisable to be able to transmit this data remotely

55-- add some short-hand error handling- your application should have proper handling

58-- add some short-hand error handling- your application should have proper handling

56handleIOError :: Show e => IO (Either e a) -> IO a

59handleIOError :: Show e => IO (Either e a) -> IO a

@@ -103,11 +106,11 @@ insertSampleData :: SessionId -> Connection -> IO ()

103insertSampleData sessionId conn = do

106insertSampleData sessionId conn = do

104 let blogs = [Blog { title = "Haskell Lenses",

107 let blogs = [Blog { title = "Haskell Lenses",

105 entry = "I wear Haskell rose-colored lenses.",

108 entry = "I wear Haskell rose-colored lenses.",

106− stamp = UTCTime (fromGregorian 2017 5 8) (secondsToDiffTime 1000),

109+ tstamp = UTCTime (fromGregorian 2017 5 8) (secondsToDiffTime 1000),

107 category = Food },

110 category = Food },

108 Blog { title = "Haskell Monad Analogy",

111 Blog { title = "Haskell Monad Analogy",

109 entry = "Monads are like burritos going through intestines.",

112 entry = "Monads are like burritos going through intestines.",

110− stamp = UTCTime (fromGregorian 2017 6 10) (secondsToDiffTime 2000),

113+ tstamp = UTCTime (fromGregorian 2017 6 10) (secondsToDiffTime 2000),

111 category = Cats }

114 category = Cats }

112 ]

115 ]

113 comments = [Comment { blogTitle = "Haskell Lenses",

116 comments = [Comment { blogTitle = "Haskell Lenses",

@@ -136,7 +139,7 @@ listBlogs sessionId conn = do

136 Left err -> render500 (toHtml (show err))

139 Left err -> render500 (toHtml (show err))

137 Right blogRel -> do

140 Right blogRel -> do

138 blogs <- liftIO (toList blogRel) >>= mapM (handleWebError . fromTuple) :: ActionM [Blog]

141 blogs <- liftIO (toList blogRel) >>= mapM (handleWebError . fromTuple) :: ActionM [Blog]

139− let sortedBlogs = sortBy (\b1 b2 -> stamp b1 `compare` stamp b2) blogs

142+ let sortedBlogs = sortBy (\b1 b2 -> tstamp b1 `compare` tstamp b2) blogs

140 html . renderHtml $ do

143 html . renderHtml $ do

141 h1 "Blog Posts"

144 h1 "Blog Posts"

142 forM_ sortedBlogs $ \blog -> a ! href (toValue $ "/blog/" <> title blog) $ h2 (toHtml (title blog))

145 forM_ sortedBlogs $ \blog -> a ! href (toValue $ "/blog/" <> title blog) $ h2 (toHtml (title blog))

@@ -182,7 +185,7 @@ showBlogEntry sessionId conn = do

182 render $ do

185 render $ do

183 --show blog details

186 --show blog details

184 h1 (toHtml (title blog))

187 h1 (toHtml (title blog))

185− p (toHtml ("Posted at " <> formatStamp (stamp blog) <> " under " <> show (category blog)))

188+ p (toHtml ("Posted at " <> formatStamp (tstamp blog) <> " under " <> show (category blog)))

186 p (toHtml (entry blog))

189 p (toHtml (entry blog))

187 hr

190 hr

188 h3 "Comments"

191 h3 "Comments"

examples/hair.hs+9−6

@@ -1,16 +1,17 @@

1−{-# LANGUAGE DeriveGeneric, DeriveAnyClass, OverloadedStrings #-}

1+{-# LANGUAGE DeriveGeneric, DeriveAnyClass, OverloadedStrings, DerivingVia #-}

2import ProjectM36.Client

3import ProjectM36.Relation.Show.Term

4import GHC.Generics

5import Data.Text

6−import Data.Binary

7import Control.DeepSeq

6import Control.DeepSeq

8import qualified Data.Map as M

7import qualified Data.Map as M

9import qualified Data.Text.IO as TIO

8import qualified Data.Text.IO as TIO

10import Data.Proxy

9import Data.Proxy

10+import Codec.Winery

12data Hair = Bald | Brown | Blond | OtherColor Text

13− deriving (Generic, Show, Eq, Binary, NFData, Atomable)

13+ deriving (Generic, Show, Eq, NFData, Atomable)

14+ deriving Serialise via WineryVariant Hair

15main :: IO ()

16main :: IO ()

16main = do

17main = do

@@ -31,11 +32,13 @@ main = do

32 --create a relation with the new Hair AtomType

33 --create a relation with the new Hair AtomType

33 let blond = NakedAtomExpr (toAtom Blond)

34 let blond = NakedAtomExpr (toAtom Blond)

34− eCheck $ executeDatabaseContextExpr sessionId conn (Assign "people" (MakeRelationFromExprs Nothing [

35+ eCheck $ executeDatabaseContextExpr sessionId conn

36+ (Assign "people"

37+ (MakeRelationFromExprs Nothing $ TupleExprs () [

35− TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))

38+ TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))

37 let restrictionPredicate = AttributeEqualityPredicate "hair" blond

40 let restrictionPredicate = AttributeEqualityPredicate "hair" blond

38 peopleRel <- eCheck $ executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "people" ()))

41 peopleRel <- eCheck $ executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "people" ()))

40 TIO.putStrLn (showRelation peopleRel)

43 TIO.putStrLn (showRelation peopleRel)

41−

44+

examples/out_of_the_tarpit.hs+11−7

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

1-- the Out-of-the-Tarpit example in Haskell and Project:M36

2−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, OverloadedStrings #-}

2+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, OverloadedStrings, DerivingVia #-}

3import ProjectM36.Client

4import ProjectM36.DataTypes.Primitive

5import ProjectM36.Tupleable

@@ -7,11 +7,11 @@ import ProjectM36.Relation

7import ProjectM36.Error

8import Data.Either

9import GHC.Generics

10−import Data.Binary

11import Control.DeepSeq

10import Control.DeepSeq

12import qualified Data.Text as T

11import qualified Data.Text as T

13import Data.Time.Calendar

12import Data.Time.Calendar

14import Data.Proxy

13import Data.Proxy

14+import Codec.Winery

16--create various database value (atom) types

17type Price = Double

@@ -21,16 +21,20 @@ type Name = T.Text

21type Address = T.Text

23data RoomType = Kitchen | Bathroom | LivingRoom

24− deriving (Generic, Atomable, Eq, Show, Binary, NFData)

24+ deriving (Generic, Atomable, Eq, Show, NFData)

25+ deriving Serialise via WineryVariant RoomType

26data PriceBand = Low | Medium | High | Premium

27data PriceBand = Low | Medium | High | Premium

27− deriving (Generic, Atomable, Eq, Show, Binary, NFData)

28+ deriving (Generic, Atomable, Eq, Show, NFData)

29+ deriving Serialise via WineryVariant PriceBand

29data AreaCode = City | Suburban | Rural

31data AreaCode = City | Suburban | Rural

30− deriving (Generic, Atomable, Eq, Show, Binary, NFData)

32+ deriving (Generic, Atomable, Eq, Show, NFData)

33+ deriving Serialise via WineryVariant AreaCode

32data SpeedBand = VeryFastBand | FastBand | MediumBand | SlowBand

35data SpeedBand = VeryFastBand | FastBand | MediumBand | SlowBand

33− deriving (Generic, Atomable, Eq, Show, Binary, NFData)

36+ deriving (Generic, Atomable, Eq, Show, NFData)

37+ deriving Serialise via WineryVariant SpeedBand

35main :: IO ()

39main :: IO ()

36main = do

40main = do

@@ -257,4 +261,4 @@ handleIOErrors m = do

257 [] -> pure (rights eErrs)

261 [] -> pure (rights eErrs)

258 errs -> handleError (Left (someErrors errs))

262 errs -> handleError (Left (someErrors errs))

259

263

260−

264+

examples/out_of_the_tarpit.tutd+4−4

@@ -3,9 +3,9 @@

3data Address = Address Text

4data Agent = Agent Text

5data Name = Name Text

6−data Price = Price Double

6+data Price = Price Integer --dollars

7data RoomType = Kitchen | Bathroom | LivingRoom

8−data PriceBand = Low | Medium | High | Premium

8+data PriceBand = Low | Med | High | Premium

9data AreaCode = City | Suburban | Rural

10data SpeedBand = VeryFast | Fast | Medium | Slow

@@ -57,9 +57,9 @@ constraint noOffersAfterSale (offer join decision where ^dayEarlierThan(@offerDa

57--1. identify offerPrices > 2000 (arbitrarily-chosen high price band which is not specified in the paper)

58--2. remove the properties which have been sold

59--3. group and count sub-relation and restrict by greater than 50

60−constraint noMoreThan50PremiumProperties ((((property where ^gt(offerPrice,2000.0)) minus ((property join decision){address,agent,dateRegistered,photo,price})) group ({} as x) : {z:=gt(count(@x),50)}) {z}){} equals false

60+constraint noMoreThan50PremiumProperties ((((property where ^gt(@price,Price 2000)) minus ((property join decision){address,agent,dateRegistered,photo,price})) group ({} as x) : {z:=gt(count(@x),50)}) {z}){} equals false

62−constraint noBidderCanMakeMoreThan10BidsOnAProperty (((offer group ({all but bidderAddress} as bidder)) : {bidCount:=gt(count(@bidder),10)}) where ^gt(bidCount,10)) {} equals false

62+constraint noBidderCanMakeMoreThan10BidsOnAProperty (((offer group ({all but bidderAddress} as bidder)) : {bidCount:=gt(count(@bidder),10)}) where ^gt(@bidCount,10)) {} equals false

64-- sample data

jupyter/TutorialD Notebook Walkthrough.ipynbnew file+794

@@ -0,0 +1,794 @@

1+{

2+ "cells": [

3+ {

4+ "cell_type": "markdown",

5+ "metadata": {},

6+ "source": [

7+ "# Introduction to TutorialD via Jupyter Notebook\n",

8+ "\n",

9+ "Thanks for trying Project:M36 via this Jupyter notebook. TutorialD is a language for interacting with relational algebra databases, similar to SQL but without the historical cruft. This notebook is based on the [TutorialD Tutorial](https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown). \n",

10+ "\n",

11+ "[Project:M36](https://github.com/agentm/project-m36) is a feature-rich database management system (DBMS) which casts off the baggage of legacy DBMSes by adhering strictly to the mathematics of the relational algebra.\n",

12+ "\n",

13+ "Please refer to the [Project:M36 documentation](https://github.com/agentm/project-m36#documentation) for more detailed examples. Let's get started!\n",

14+ "\n",

15+ "First, let's import the Chris Date example relation variables. The relation variables provided in the example are:\n",

16+ "\n",

17+ "* `s` suppliers\n",

18+ "* `sp` supplier-parts\n",

19+ "* `p` parts"

20+ ]

21+ },

22+ {

23+ "cell_type": "code",

24+ "execution_count": 1,

25+ "metadata": {},

26+ "outputs": [

27+ {

28+ "data": {

29+ "text/html": [

30+ "ok"

31+ ],

32+ "text/plain": [

33+ "ok"

34+ ]

35+ },

36+ "metadata": {},

37+ "output_type": "display_data"

38+ }

39+ ],

40+ "source": [

41+ ":importexample cjdate"

42+ ]

43+ },

44+ {

45+ "cell_type": "markdown",

46+ "metadata": {},

47+ "source": [

48+ "If you see an error in the previous cell regarding `project-m36-websocket-server` not being in your `PATH`, add the binary to your `PATH` and restart the jupyter server.\n",

49+ "\n",

50+ "Let's take a look at the relation variables."

51+ ]

52+ },

53+ {

54+ "cell_type": "code",

55+ "execution_count": 2,

56+ "metadata": {},

57+ "outputs": [

58+ {

59+ "data": {

60+ "text/html": [

61+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>s#::Text</th><th>sname::Text</th><th>status::Integer</th><th>city::Text</th></tr><tr><td>\"S3\"</td><td>\"Blake\"</td><td>30</td><td>\"Paris\"</td></tr><tr><td>\"S5\"</td><td>\"Adams\"</td><td>30</td><td>\"Athens\"</td></tr><tr><td>\"S4\"</td><td>\"Clark\"</td><td>20</td><td>\"London\"</td></tr><tr><td>\"S1\"</td><td>\"Smith\"</td><td>20</td><td>\"London\"</td></tr><tr><td>\"S2\"</td><td>\"Jones\"</td><td>10</td><td>\"Paris\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 5 tuples</td></tr></tfoot></table>"

62+ ],

63+ "text/plain": [

64+ "┌──────────┬────────┬───────────┬───────────────┐\n",

65+ "│city::Text│s#::Text│sname::Text│status::Integer│\n",

66+ "├──────────┼────────┼───────────┼───────────────┤\n",

67+ "│\"Paris\" │\"S2\" │\"Jones\" │10 │\n",

68+ "│\"London\" │\"S1\" │\"Smith\" │20 │\n",

69+ "│\"London\" │\"S4\" │\"Clark\" │20 │\n",

70+ "│\"Athens\" │\"S5\" │\"Adams\" │30 │\n",

71+ "│\"Paris\" │\"S3\" │\"Blake\" │30 │\n",

72+ "└──────────┴────────┴───────────┴───────────────┘"

73+ ]

74+ },

75+ "metadata": {},

76+ "output_type": "display_data"

77+ }

78+ ],

79+ "source": [

80+ ":showexpr s"

81+ ]

82+ },

83+ {

84+ "cell_type": "code",

85+ "execution_count": 3,

86+ "metadata": {},

87+ "outputs": [

88+ {

89+ "data": {

90+ "text/html": [

91+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>s#::Text</th><th>p#::Text</th><th>qty::Integer</th></tr><tr><td>\"S1\"</td><td>\"P2\"</td><td>200</td></tr><tr><td>\"S1\"</td><td>\"P1\"</td><td>300</td></tr><tr><td>\"S3\"</td><td>\"P2\"</td><td>200</td></tr><tr><td>\"S2\"</td><td>\"P2\"</td><td>400</td></tr><tr><td>\"S4\"</td><td>\"P5\"</td><td>400</td></tr><tr><td>\"S1\"</td><td>\"P5\"</td><td>100</td></tr><tr><td>\"S1\"</td><td>\"P6\"</td><td>100</td></tr><tr><td>\"S2\"</td><td>\"P1\"</td><td>300</td></tr><tr><td>\"S1\"</td><td>\"P4\"</td><td>200</td></tr><tr><td>\"S4\"</td><td>\"P4\"</td><td>300</td></tr><tr><td>\"S4\"</td><td>\"P2\"</td><td>200</td></tr><tr><td>\"S1\"</td><td>\"P3\"</td><td>400</td></tr><tfoot><tr><td colspan=\"100%\">Finite 12 tuples</td></tr></tfoot></table>"

92+ ],

93+ "text/plain": [

94+ "┌────────┬────────────┬────────┐\n",

95+ "│p#::Text│qty::Integer│s#::Text│\n",

96+ "├────────┼────────────┼────────┤\n",

97+ "│\"P3\" │400 │\"S1\" │\n",

98+ "│\"P2\" │200 │\"S4\" │\n",

99+ "│\"P4\" │300 │\"S4\" │\n",

100+ "│\"P4\" │200 │\"S1\" │\n",

101+ "│\"P1\" │300 │\"S2\" │\n",

102+ "│\"P6\" │100 │\"S1\" │\n",

103+ "│\"P5\" │100 │\"S1\" │\n",

104+ "│\"P5\" │400 │\"S4\" │\n",

105+ "│\"P2\" │400 │\"S2\" │\n",

106+ "│\"P2\" │200 │\"S3\" │\n",

107+ "│\"P1\" │300 │\"S1\" │\n",

108+ "│\"P2\" │200 │\"S1\" │\n",

109+ "└────────┴────────────┴────────┘"

110+ ]

111+ },

112+ "metadata": {},

113+ "output_type": "display_data"

114+ }

115+ ],

116+ "source": [

117+ ":showexpr sp"

118+ ]

119+ },

120+ {

121+ "cell_type": "code",

122+ "execution_count": 4,

123+ "metadata": {

124+ "scrolled": true

125+ },

126+ "outputs": [

127+ {

128+ "data": {

129+ "text/html": [

130+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>p#::Text</th><th>pname::Text</th><th>color::Text</th><th>weight::Integer</th><th>city::Text</th></tr><tr><td>\"P3\"</td><td>\"Screw\"</td><td>\"Blue\"</td><td>17</td><td>\"Oslo\"</td></tr><tr><td>\"P2\"</td><td>\"Bolt\"</td><td>\"Green\"</td><td>17</td><td>\"Paris\"</td></tr><tr><td>\"P4\"</td><td>\"Screw\"</td><td>\"Red\"</td><td>14</td><td>\"London\"</td></tr><tr><td>\"P6\"</td><td>\"Cog\"</td><td>\"Red\"</td><td>19</td><td>\"London\"</td></tr><tr><td>\"P1\"</td><td>\"Nut\"</td><td>\"Red\"</td><td>12</td><td>\"London\"</td></tr><tr><td>\"P5\"</td><td>\"Cam\"</td><td>\"Blue\"</td><td>12</td><td>\"Paris\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 6 tuples</td></tr></tfoot></table>"

131+ ],

132+ "text/plain": [

133+ "┌──────────┬───────────┬────────┬───────────┬───────────────┐\n",

134+ "│city::Text│color::Text│p#::Text│pname::Text│weight::Integer│\n",

135+ "├──────────┼───────────┼────────┼───────────┼───────────────┤\n",

136+ "│\"Paris\" │\"Blue\" │\"P5\" │\"Cam\" │12 │\n",

137+ "│\"London\" │\"Red\" │\"P1\" │\"Nut\" │12 │\n",

138+ "│\"London\" │\"Red\" │\"P6\" │\"Cog\" │19 │\n",

139+ "│\"London\" │\"Red\" │\"P4\" │\"Screw\" │14 │\n",

140+ "│\"Paris\" │\"Green\" │\"P2\" │\"Bolt\" │17 │\n",

141+ "│\"Oslo\" │\"Blue\" │\"P3\" │\"Screw\" │17 │\n",

142+ "└──────────┴───────────┴────────┴───────────┴───────────────┘"

143+ ]

144+ },

145+ "metadata": {},

146+ "output_type": "display_data"

147+ }

148+ ],

149+ "source": [

150+ "\n",

151+ ":showexpr p"

152+ ]

153+ },

154+ {

155+ "cell_type": "markdown",

156+ "metadata": {},

157+ "source": [

158+ "## Relational Operators\n",

159+ "\n",

160+ "### Restriction\n",

161+ "\n",

162+ "We can see that there is a many-to-many relationship between `s` (suppliers) and `p` (parts) via the `sp` relation variable.\n",

163+ "\n",

164+ "Let's look at the suppliers who are in London. This is called \"restriction\".\n",

165+ "\n",

166+ "Note that the relation attributes have appropriate types which restrict the values which they can contain."

167+ ]

168+ },

169+ {

170+ "cell_type": "code",

171+ "execution_count": 5,

172+ "metadata": {},

173+ "outputs": [

174+ {

175+ "data": {

176+ "text/html": [

177+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>s#::Text</th><th>sname::Text</th><th>status::Integer</th><th>city::Text</th></tr><tr><td>\"S4\"</td><td>\"Clark\"</td><td>20</td><td>\"London\"</td></tr><tr><td>\"S1\"</td><td>\"Smith\"</td><td>20</td><td>\"London\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 2 tuples</td></tr></tfoot></table>"

178+ ],

179+ "text/plain": [

180+ "┌──────────┬────────┬───────────┬───────────────┐\n",

181+ "│city::Text│s#::Text│sname::Text│status::Integer│\n",

182+ "├──────────┼────────┼───────────┼───────────────┤\n",

183+ "│\"London\" │\"S1\" │\"Smith\" │20 │\n",

184+ "│\"London\" │\"S4\" │\"Clark\" │20 │\n",

185+ "└──────────┴────────┴───────────┴───────────────┘"

186+ ]

187+ },

188+ "metadata": {},

189+ "output_type": "display_data"

190+ }

191+ ],

192+ "source": [

193+ ":showexpr s where city=\"London\""

194+ ]

195+ },

196+ {

197+ "cell_type": "markdown",

198+ "metadata": {},

199+ "source": [

200+ "### Join And Projection\n",

201+ "\n",

202+ "Let's examine which parts the London suppliers offer. In the following expression, we make use of the relational join operator (equivalent to `NATURAL JOIN` in SQL) and projection using the trailing curly brackets to only return the relation attributes which interest us."

203+ ]

204+ },

205+ {

206+ "cell_type": "code",

207+ "execution_count": 6,

208+ "metadata": {},

209+ "outputs": [

210+ {

211+ "data": {

212+ "text/html": [

213+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>qty::Integer</th><th>pname::Text</th><th>p#::Text</th></tr><tr><td>100</td><td>\"Cog\"</td><td>\"P6\"</td></tr><tr><td>300</td><td>\"Nut\"</td><td>\"P1\"</td></tr><tr><td>300</td><td>\"Screw\"</td><td>\"P4\"</td></tr><tr><td>200</td><td>\"Screw\"</td><td>\"P4\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 4 tuples</td></tr></tfoot></table>"

214+ ],

215+ "text/plain": [

216+ "┌────────┬───────────┬────────────┐\n",

217+ "│p#::Text│pname::Text│qty::Integer│\n",

218+ "├────────┼───────────┼────────────┤\n",

219+ "│\"P4\" │\"Screw\" │200 │\n",

220+ "│\"P4\" │\"Screw\" │300 │\n",

221+ "│\"P1\" │\"Nut\" │300 │\n",

222+ "│\"P6\" │\"Cog\" │100 │\n",

223+ "└────────┴───────────┴────────────┘"

224+ ]

225+ },

226+ "metadata": {},

227+ "output_type": "display_data"

228+ }

229+ ],

230+ "source": [

231+ ":showexpr ((s where city=\"London\") join sp join p){p#,pname,qty}"

232+ ]

233+ },

234+ {

235+ "cell_type": "markdown",

236+ "metadata": {},

237+ "source": [

238+ "### Extend and Atom Functions\n",

239+ "\n",

240+ "We can also execute server-side functions on values and add them to our result relation."

241+ ]

242+ },

243+ {

244+ "cell_type": "code",

245+ "execution_count": 7,

246+ "metadata": {},

247+ "outputs": [

248+ {

249+ "data": {

250+ "text/html": [

251+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>s#::Text</th><th>status::Integer</th><th>statusplus10::Integer</th></tr><tr><td>\"S1\"</td><td>20</td><td>30</td></tr><tr><td>\"S4\"</td><td>20</td><td>30</td></tr><tr><td>\"S5\"</td><td>30</td><td>40</td></tr><tr><td>\"S3\"</td><td>30</td><td>40</td></tr><tr><td>\"S2\"</td><td>10</td><td>20</td></tr><tfoot><tr><td colspan=\"100%\">Finite 5 tuples</td></tr></tfoot></table>"

252+ ],

253+ "text/plain": [

254+ "┌────────┬───────────────┬─────────────────────┐\n",

255+ "│s#::Text│status::Integer│statusplus10::Integer│\n",

256+ "├────────┼───────────────┼─────────────────────┤\n",

257+ "│\"S2\" │10 │20 │\n",

258+ "│\"S3\" │30 │40 │\n",

259+ "│\"S5\" │30 │40 │\n",

260+ "│\"S4\" │20 │30 │\n",

261+ "│\"S1\" │20 │30 │\n",

262+ "└────────┴───────────────┴─────────────────────┘"

263+ ]

264+ },

265+ "metadata": {},

266+ "output_type": "display_data"

267+ }

268+ ],

269+ "source": [

270+ ":showexpr (s:{statusplus10:=add(@status,10)}){s#,status,statusplus10}"

271+ ]

272+ },

273+ {

274+ "cell_type": "markdown",

275+ "metadata": {},

276+ "source": [

277+ "### Group and Ungroup\n",

278+ "\n",

279+ "Unlike most databases, Project:M36 supports relation-valued attributes. This means that database values (atoms) can also be relations. Relation-valued attributes can be represented in the notebook as nested tables of values. Note that the nested relation's type is `relation {qty::Integer,pname::Text,s#::Text}`. \n",

280+ "\n",

281+ "Relation-valued attributes reduce tuple duplication by clearly associating certain values with their related multiple tuples. The `group` operator can also be used to create the SQL equivalent of `OUTER JOIN` but without the need for representing `NULL` in any form.\n",

282+ "\n",

283+ "Let's list the available counts for each supplier for each part."

284+ ]

285+ },

286+ {

287+ "cell_type": "code",

288+ "execution_count": 8,

289+ "metadata": {},

290+ "outputs": [

291+ {

292+ "data": {

293+ "text/html": [

294+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>p#::Text</th><th>availability::relation {qty::Integer,pname::Text,s#::Text}</th></tr><tr><td>\"P6\"</td><td><style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>qty::Integer</th><th>pname::Text</th><th>s#::Text</th></tr><tr><td>100</td><td>\"Cog\"</td><td>\"S1\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 1 tuples</td></tr></tfoot></table></td></tr><tr><td>\"P1\"</td><td><style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>qty::Integer</th><th>pname::Text</th><th>s#::Text</th></tr><tr><td>300</td><td>\"Nut\"</td><td>\"S2\"</td></tr><tr><td>300</td><td>\"Nut\"</td><td>\"S1\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 2 tuples</td></tr></tfoot></table></td></tr><tr><td>\"P2\"</td><td><style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>qty::Integer</th><th>pname::Text</th><th>s#::Text</th></tr><tr><td>200</td><td>\"Bolt\"</td><td>\"S4\"</td></tr><tr><td>200</td><td>\"Bolt\"</td><td>\"S1\"</td></tr><tr><td>400</td><td>\"Bolt\"</td><td>\"S2\"</td></tr><tr><td>200</td><td>\"Bolt\"</td><td>\"S3\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 4 tuples</td></tr></tfoot></table></td></tr><tr><td>\"P4\"</td><td><style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>qty::Integer</th><th>pname::Text</th><th>s#::Text</th></tr><tr><td>200</td><td>\"Screw\"</td><td>\"S1\"</td></tr><tr><td>300</td><td>\"Screw\"</td><td>\"S4\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 2 tuples</td></tr></tfoot></table></td></tr><tr><td>\"P3\"</td><td><style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>qty::Integer</th><th>pname::Text</th><th>s#::Text</th></tr><tr><td>400</td><td>\"Screw\"</td><td>\"S1\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 1 tuples</td></tr></tfoot></table></td></tr><tr><td>\"P5\"</td><td><style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>qty::Integer</th><th>pname::Text</th><th>s#::Text</th></tr><tr><td>400</td><td>\"Cam\"</td><td>\"S4\"</td></tr><tr><td>100</td><td>\"Cam\"</td><td>\"S1\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 2 tuples</td></tr></tfoot></table></td></tr><tfoot><tr><td colspan=\"100%\">Finite 6 tuples</td></tr></tfoot></table>"

295+ ],

296+ "text/plain": [

297+ "┌──────────────────────────────────────────────────────────┬────────┐\n",

298+ "│availability::relation {qty::Integer,pname::Text,s#::Text}│p#::Text│\n",

299+ "├──────────────────────────────────────────────────────────┼────────┤\n",

300+ "│┌───────────┬────────────┬────────┐ │\"P5\" │\n",

301+ "││pname::Text│qty::Integer│s#::Text│ │ │\n",

302+ "│├───────────┼────────────┼────────┤ │ │\n",

303+ "││\"Cam\" │100 │\"S1\" │ │ │\n",

304+ "││\"Cam\" │400 │\"S4\" │ │ │\n",

305+ "│└───────────┴────────────┴────────┘ │ │\n",

306+ "│┌───────────┬────────────┬────────┐ │\"P3\" │\n",

307+ "││pname::Text│qty::Integer│s#::Text│ │ │\n",

308+ "│├───────────┼────────────┼────────┤ │ │\n",

309+ "││\"Screw\" │400 │\"S1\" │ │ │\n",

310+ "│└───────────┴────────────┴────────┘ │ │\n",

311+ "│┌───────────┬────────────┬────────┐ │\"P4\" │\n",

312+ "││pname::Text│qty::Integer│s#::Text│ │ │\n",

313+ "│├───────────┼────────────┼────────┤ │ │\n",

314+ "││\"Screw\" │300 │\"S4\" │ │ │\n",

315+ "││\"Screw\" │200 │\"S1\" │ │ │\n",

316+ "│└───────────┴────────────┴────────┘ │ │\n",

317+ "│┌───────────┬────────────┬────────┐ │\"P2\" │\n",

318+ "││pname::Text│qty::Integer│s#::Text│ │ │\n",

319+ "│├───────────┼────────────┼────────┤ │ │\n",

320+ "││\"Bolt\" │200 │\"S3\" │ │ │\n",

321+ "││\"Bolt\" │400 │\"S2\" │ │ │\n",

322+ "││\"Bolt\" │200 │\"S1\" │ │ │\n",

323+ "││\"Bolt\" │200 │\"S4\" │ │ │\n",

324+ "│└───────────┴────────────┴────────┘ │ │\n",

325+ "│┌───────────┬────────────┬────────┐ │\"P1\" │\n",

326+ "││pname::Text│qty::Integer│s#::Text│ │ │\n",

327+ "│├───────────┼────────────┼────────┤ │ │\n",

328+ "││\"Nut\" │300 │\"S1\" │ │ │\n",

329+ "││\"Nut\" │300 │\"S2\" │ │ │\n",

330+ "│└───────────┴────────────┴────────┘ │ │\n",

331+ "│┌───────────┬────────────┬────────┐ │\"P6\" │\n",

332+ "││pname::Text│qty::Integer│s#::Text│ │ │\n",

333+ "│├───────────┼────────────┼────────┤ │ │\n",

334+ "││\"Cog\" │100 │\"S1\" │ │ │\n",

335+ "│└───────────┴────────────┴────────┘ │ │\n",

336+ "└──────────────────────────────────────────────────────────┴────────┘"

337+ ]

338+ },

339+ "metadata": {},

340+ "output_type": "display_data"

341+ }

342+ ],

343+ "source": [

344+ ":showexpr (p join sp){qty,pname,s#,p#} group ({s#,pname,qty} as availability)"

345+ ]

346+ },

347+ {

348+ "cell_type": "markdown",

349+ "metadata": {},

350+ "source": [

351+ "We can flatten the relation-valued attributes, thereby generating more top-level tuples."

352+ ]

353+ },

354+ {

355+ "cell_type": "code",

356+ "execution_count": 9,

357+ "metadata": {},

358+ "outputs": [

359+ {

360+ "data": {

361+ "text/html": [

362+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>qty::Integer</th><th>pname::Text</th><th>s#::Text</th><th>p#::Text</th></tr><tr><td>400</td><td>\"Screw\"</td><td>\"S1\"</td><td>\"P3\"</td></tr><tr><td>200</td><td>\"Bolt\"</td><td>\"S4\"</td><td>\"P2\"</td></tr><tr><td>100</td><td>\"Cog\"</td><td>\"S1\"</td><td>\"P6\"</td></tr><tr><td>100</td><td>\"Cam\"</td><td>\"S1\"</td><td>\"P5\"</td></tr><tr><td>300</td><td>\"Nut\"</td><td>\"S2\"</td><td>\"P1\"</td></tr><tr><td>400</td><td>\"Cam\"</td><td>\"S4\"</td><td>\"P5\"</td></tr><tr><td>300</td><td>\"Screw\"</td><td>\"S4\"</td><td>\"P4\"</td></tr><tr><td>200</td><td>\"Bolt\"</td><td>\"S1\"</td><td>\"P2\"</td></tr><tr><td>200</td><td>\"Screw\"</td><td>\"S1\"</td><td>\"P4\"</td></tr><tr><td>200</td><td>\"Bolt\"</td><td>\"S3\"</td><td>\"P2\"</td></tr><tr><td>300</td><td>\"Nut\"</td><td>\"S1\"</td><td>\"P1\"</td></tr><tr><td>400</td><td>\"Bolt\"</td><td>\"S2\"</td><td>\"P2\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 12 tuples</td></tr></tfoot></table>"

363+ ],

364+ "text/plain": [

365+ "┌────────┬───────────┬────────────┬────────┐\n",

366+ "│p#::Text│pname::Text│qty::Integer│s#::Text│\n",

367+ "├────────┼───────────┼────────────┼────────┤\n",

368+ "│\"P2\" │\"Bolt\" │400 │\"S2\" │\n",

369+ "│\"P1\" │\"Nut\" │300 │\"S1\" │\n",

370+ "│\"P2\" │\"Bolt\" │200 │\"S3\" │\n",

371+ "│\"P4\" │\"Screw\" │200 │\"S1\" │\n",

372+ "│\"P2\" │\"Bolt\" │200 │\"S1\" │\n",

373+ "│\"P4\" │\"Screw\" │300 │\"S4\" │\n",

374+ "│\"P5\" │\"Cam\" │400 │\"S4\" │\n",

375+ "│\"P1\" │\"Nut\" │300 │\"S2\" │\n",

376+ "│\"P5\" │\"Cam\" │100 │\"S1\" │\n",

377+ "│\"P6\" │\"Cog\" │100 │\"S1\" │\n",

378+ "│\"P2\" │\"Bolt\" │200 │\"S4\" │\n",

379+ "│\"P3\" │\"Screw\" │400 │\"S1\" │\n",

380+ "└────────┴───────────┴────────────┴────────┘"

381+ ]

382+ },

383+ "metadata": {},

384+ "output_type": "display_data"

385+ }

386+ ],

387+ "source": [

388+ ":showexpr ((p join sp){qty,pname,s#,p#} group ({s#,pname,qty} as availability)) ungroup availability"

389+ ]

390+ },

391+ {

392+ "cell_type": "markdown",

393+ "metadata": {},

394+ "source": [

395+ "## Database State Operators\n",

396+ "\n",

397+ "Thus far, we have only been inspecting the database state. Next, let's cover some database update operators. These operators are all similar to SQL operators, so we don't need a lot of exposition."

398+ ]

399+ },

400+ {

401+ "cell_type": "markdown",

402+ "metadata": {},

403+ "source": [

404+ "### Insert"

405+ ]

406+ },

407+ {

408+ "cell_type": "code",

409+ "execution_count": 10,

410+ "metadata": {},

411+ "outputs": [

412+ {

413+ "data": {

414+ "text/html": [

415+ "ok"

416+ ],

417+ "text/plain": [

418+ "ok"

419+ ]

420+ },

421+ "metadata": {},

422+ "output_type": "display_data"

423+ }

424+ ],

425+ "source": [

426+ "insert s relation{tuple{s# \"S6\", sname \"Bob\", status 50, city \"Boston\"}}"

427+ ]

428+ },

429+ {

430+ "cell_type": "code",

431+ "execution_count": 11,

432+ "metadata": {},

433+ "outputs": [

434+ {

435+ "data": {

436+ "text/html": [

437+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>city::Text</th><th>s#::Text</th><th>sname::Text</th><th>status::Integer</th></tr><tr><td>\"Boston\"</td><td>\"S6\"</td><td>\"Bob\"</td><td>50</td></tr><tr><td>\"Paris\"</td><td>\"S3\"</td><td>\"Blake\"</td><td>30</td></tr><tr><td>\"Athens\"</td><td>\"S5\"</td><td>\"Adams\"</td><td>30</td></tr><tr><td>\"London\"</td><td>\"S4\"</td><td>\"Clark\"</td><td>20</td></tr><tr><td>\"London\"</td><td>\"S1\"</td><td>\"Smith\"</td><td>20</td></tr><tr><td>\"Paris\"</td><td>\"S2\"</td><td>\"Jones\"</td><td>10</td></tr><tfoot><tr><td colspan=\"100%\">Finite 6 tuples</td></tr></tfoot></table>"

438+ ],

439+ "text/plain": [

440+ "┌──────────┬────────┬───────────┬───────────────┐\n",

441+ "│city::Text│s#::Text│sname::Text│status::Integer│\n",

442+ "├──────────┼────────┼───────────┼───────────────┤\n",

443+ "│\"Paris\" │\"S2\" │\"Jones\" │10 │\n",

444+ "│\"London\" │\"S1\" │\"Smith\" │20 │\n",

445+ "│\"London\" │\"S4\" │\"Clark\" │20 │\n",

446+ "│\"Athens\" │\"S5\" │\"Adams\" │30 │\n",

447+ "│\"Paris\" │\"S3\" │\"Blake\" │30 │\n",

448+ "│\"Boston\" │\"S6\" │\"Bob\" │50 │\n",

449+ "└──────────┴────────┴───────────┴───────────────┘"

450+ ]

451+ },

452+ "metadata": {},

453+ "output_type": "display_data"

454+ }

455+ ],

456+ "source": [

457+ ":showexpr s"

458+ ]

459+ },

460+ {

461+ "cell_type": "markdown",

462+ "metadata": {},

463+ "source": [

464+ "### Delete"

465+ ]

466+ },

467+ {

468+ "cell_type": "code",

469+ "execution_count": 12,

470+ "metadata": {},

471+ "outputs": [

472+ {

473+ "data": {

474+ "text/html": [

475+ "ok"

476+ ],

477+ "text/plain": [

478+ "ok"

479+ ]

480+ },

481+ "metadata": {},

482+ "output_type": "display_data"

483+ }

484+ ],

485+ "source": [

486+ "delete s where sname=\"Bob\""

487+ ]

488+ },

489+ {

490+ "cell_type": "code",

491+ "execution_count": 13,

492+ "metadata": {},

493+ "outputs": [

494+ {

495+ "data": {

496+ "text/html": [

497+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>city::Text</th><th>s#::Text</th><th>sname::Text</th><th>status::Integer</th></tr><tr><td>\"Paris\"</td><td>\"S3\"</td><td>\"Blake\"</td><td>30</td></tr><tr><td>\"Athens\"</td><td>\"S5\"</td><td>\"Adams\"</td><td>30</td></tr><tr><td>\"London\"</td><td>\"S4\"</td><td>\"Clark\"</td><td>20</td></tr><tr><td>\"London\"</td><td>\"S1\"</td><td>\"Smith\"</td><td>20</td></tr><tr><td>\"Paris\"</td><td>\"S2\"</td><td>\"Jones\"</td><td>10</td></tr><tfoot><tr><td colspan=\"100%\">Finite 5 tuples</td></tr></tfoot></table>"

498+ ],

499+ "text/plain": [

500+ "┌──────────┬────────┬───────────┬───────────────┐\n",

501+ "│city::Text│s#::Text│sname::Text│status::Integer│\n",

502+ "├──────────┼────────┼───────────┼───────────────┤\n",

503+ "│\"Paris\" │\"S2\" │\"Jones\" │10 │\n",

504+ "│\"London\" │\"S1\" │\"Smith\" │20 │\n",

505+ "│\"London\" │\"S4\" │\"Clark\" │20 │\n",

506+ "│\"Athens\" │\"S5\" │\"Adams\" │30 │\n",

507+ "│\"Paris\" │\"S3\" │\"Blake\" │30 │\n",

508+ "└──────────┴────────┴───────────┴───────────────┘"

509+ ]

510+ },

511+ "metadata": {},

512+ "output_type": "display_data"

513+ }

514+ ],

515+ "source": [

516+ ":showexpr s"

517+ ]

518+ },

519+ {

520+ "cell_type": "markdown",

521+ "metadata": {},

522+ "source": [

523+ "### Update"

524+ ]

525+ },

526+ {

527+ "cell_type": "code",

528+ "execution_count": 14,

529+ "metadata": {},

530+ "outputs": [

531+ {

532+ "data": {

533+ "text/html": [

534+ "ok"

535+ ],

536+ "text/plain": [

537+ "ok"

538+ ]

539+ },

540+ "metadata": {},

541+ "output_type": "display_data"

542+ }

543+ ],

544+ "source": [

545+ "update s where city=\"London\" (status:=90)"

546+ ]

547+ },

548+ {

549+ "cell_type": "code",

550+ "execution_count": 15,

551+ "metadata": {},

552+ "outputs": [

553+ {

554+ "data": {

555+ "text/html": [

556+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>city::Text</th><th>s#::Text</th><th>sname::Text</th><th>status::Integer</th></tr><tr><td>\"London\"</td><td>\"S1\"</td><td>\"Smith\"</td><td>90</td></tr><tr><td>\"Paris\"</td><td>\"S3\"</td><td>\"Blake\"</td><td>30</td></tr><tr><td>\"Athens\"</td><td>\"S5\"</td><td>\"Adams\"</td><td>30</td></tr><tr><td>\"London\"</td><td>\"S4\"</td><td>\"Clark\"</td><td>90</td></tr><tr><td>\"Paris\"</td><td>\"S2\"</td><td>\"Jones\"</td><td>10</td></tr><tfoot><tr><td colspan=\"100%\">Finite 5 tuples</td></tr></tfoot></table>"

557+ ],

558+ "text/plain": [

559+ "┌──────────┬────────┬───────────┬───────────────┐\n",

560+ "│city::Text│s#::Text│sname::Text│status::Integer│\n",

561+ "├──────────┼────────┼───────────┼───────────────┤\n",

562+ "│\"Paris\" │\"S2\" │\"Jones\" │10 │\n",

563+ "│\"London\" │\"S4\" │\"Clark\" │90 │\n",

564+ "│\"Athens\" │\"S5\" │\"Adams\" │30 │\n",

565+ "│\"Paris\" │\"S3\" │\"Blake\" │30 │\n",

566+ "│\"London\" │\"S1\" │\"Smith\" │90 │\n",

567+ "└──────────┴────────┴───────────┴───────────────┘"

568+ ]

569+ },

570+ "metadata": {},

571+ "output_type": "display_data"

572+ }

573+ ],

574+ "source": [

575+ ":showexpr s"

576+ ]

577+ },

578+ {

579+ "cell_type": "markdown",

580+ "metadata": {},

581+ "source": [

582+ "### Assign"

583+ ]

584+ },

585+ {

586+ "cell_type": "code",

587+ "execution_count": 16,

588+ "metadata": {},

589+ "outputs": [

590+ {

591+ "data": {

592+ "text/html": [

593+ "ok"

594+ ],

595+ "text/plain": [

596+ "ok"

597+ ]

598+ },

599+ "metadata": {},

600+ "output_type": "display_data"

601+ }

602+ ],

603+ "source": [

604+ "london_suppliers := s where city=\"London\""

605+ ]

606+ },

607+ {

608+ "cell_type": "code",

609+ "execution_count": 17,

610+ "metadata": {},

611+ "outputs": [

612+ {

613+ "data": {

614+ "text/html": [

615+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>city::Text</th><th>s#::Text</th><th>sname::Text</th><th>status::Integer</th></tr><tr><td>\"London\"</td><td>\"S1\"</td><td>\"Smith\"</td><td>90</td></tr><tr><td>\"London\"</td><td>\"S4\"</td><td>\"Clark\"</td><td>90</td></tr><tfoot><tr><td colspan=\"100%\">Finite 2 tuples</td></tr></tfoot></table>"

616+ ],

617+ "text/plain": [

618+ "┌──────────┬────────┬───────────┬───────────────┐\n",

619+ "│city::Text│s#::Text│sname::Text│status::Integer│\n",

620+ "├──────────┼────────┼───────────┼───────────────┤\n",

621+ "│\"London\" │\"S4\" │\"Clark\" │90 │\n",

622+ "│\"London\" │\"S1\" │\"Smith\" │90 │\n",

623+ "└──────────┴────────┴───────────┴───────────────┘"

624+ ]

625+ },

626+ "metadata": {},

627+ "output_type": "display_data"

628+ }

629+ ],

630+ "source": [

631+ ":showexpr london_suppliers"

632+ ]

633+ },

634+ {

635+ "cell_type": "markdown",

636+ "metadata": {},

637+ "source": [

638+ "## Constraints\n",

639+ "\n",

640+ "Project:M36 supports too many features to cover in one notebook, but constraints are certainly essential.\n",

641+ "\n",

642+ "Let's examine the current constraints."

643+ ]

644+ },

645+ {

646+ "cell_type": "code",

647+ "execution_count": 18,

648+ "metadata": {},

649+ "outputs": [

650+ {

651+ "data": {

652+ "text/html": [

653+ "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style><table class=\"pm36relation\"\"><tr><th>name::Text</th><th>sub::Text</th><th>super::Text</th></tr><tr><td>\"p_pkey\"</td><td>\"NotEquals (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (RelationVariable \\\"p\\\" ()))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]})))))) (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (Project (AttributeNames (fromList [\\\"p#\\\"])) (RelationVariable \\\"p\\\" ())))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]}))))))\"</td><td>\"ExistingRelation (Relation [] (RelationTupleSet {asList = []}))\"</td></tr><tr><td>\"s_pkey\"</td><td>\"NotEquals (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (RelationVariable \\\"s\\\" ()))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]})))))) (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (Project (AttributeNames (fromList [\\\"s#\\\"])) (RelationVariable \\\"s\\\" ())))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]}))))))\"</td><td>\"ExistingRelation (Relation [] (RelationTupleSet {asList = []}))\"</td></tr><tr><td>\"sp_pkey\"</td><td>\"NotEquals (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (RelationVariable \\\"sp\\\" ()))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]})))))) (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (Project (AttributeNames (fromList [\\\"p#\\\",\\\"s#\\\"])) (RelationVariable \\\"sp\\\" ())))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]}))))))\"</td><td>\"ExistingRelation (Relation [] (RelationTupleSet {asList = []}))\"</td></tr><tfoot><tr><td colspan=\"100%\">Finite 3 tuples</td></tr></tfoot></table>"

654+ ],

655+ "text/plain": [

656+ "┌──────────┬───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┬─────────────────────────────────────────────────────────────────┐\n",

657+ "│name::Text│sub::Text │super::Text │\n",

658+ "├──────────┼───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┼─────────────────────────────────────────────────────────────────┤\n",

659+ "│\"sp_pkey\" │\"NotEquals (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (RelationVariable \\\"sp\\\" ()))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]})))))) (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (Project (AttributeNames (fromList [\\\"p#\\\",\\\"s#\\\"])) (RelationVariable \\\"sp\\\" ())))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]}))))))\"│\"ExistingRelation (Relation [] (RelationTupleSet {asList = []}))\"│\n",

660+ "│\"s_pkey\" │\"NotEquals (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (RelationVariable \\\"s\\\" ()))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]})))))) (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (Project (AttributeNames (fromList [\\\"s#\\\"])) (RelationVariable \\\"s\\\" ())))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]}))))))\" │\"ExistingRelation (Relation [] (RelationTupleSet {asList = []}))\"│\n",

661+ "│\"p_pkey\" │\"NotEquals (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (RelationVariable \\\"p\\\" ()))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]})))))) (Project (AttributeNames (fromList [\\\"b\\\"])) (Extend (AttributeExtendTupleExpr \\\"b\\\" (FunctionAtomExpr \\\"count\\\" [AttributeAtomExpr \\\"a\\\"] ())) (Extend (AttributeExtendTupleExpr \\\"a\\\" (RelationAtomExpr (Project (AttributeNames (fromList [\\\"p#\\\"])) (RelationVariable \\\"p\\\" ())))) (ExistingRelation (Relation [] (RelationTupleSet {asList = [RelationTuple [] []]}))))))\" │\"ExistingRelation (Relation [] (RelationTupleSet {asList = []}))\"│\n",

662+ "└──────────┴───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┴─────────────────────────────────────────────────────────────────┘"

663+ ]

664+ },

665+ "metadata": {},

666+ "output_type": "display_data"

667+ }

668+ ],

669+ "source": [

670+ ":constraints"

671+ ]

672+ },

673+ {

674+ "cell_type": "markdown",

675+ "metadata": {},

676+ "source": [

677+ "Constraints are represented as \"inclusion dependencies\". An inclusion dependency is a generalization of all possible constraints on the database and can represent keys, uniqueness constraints, foreign key constraints, as well as span multiple relation variables.\n",

678+ "\n",

679+ "An inclusion dependency requires that the result of relational expression `sub` is a subset of relational expression `super`.\n",

680+ "\n",

681+ "Project:M36 includes some utilities to generate inclusion dependencies."

682+ ]

683+ },

684+ {

685+ "cell_type": "code",

686+ "execution_count": 19,

687+ "metadata": {},

688+ "outputs": [

689+ {

690+ "data": {

691+ "text/html": [

692+ "ok"

693+ ],

694+ "text/plain": [

695+ "ok"

696+ ]

697+ },

698+ "metadata": {},

699+ "output_type": "display_data"

700+ }

701+ ],

702+ "source": [

703+ "sandwich := relation{tuple{name \"Cheese\", price 4},tuple{name \"Tuna\", price 5}}"

704+ ]

705+ },

706+ {

707+ "cell_type": "code",

708+ "execution_count": 20,

709+ "metadata": {},

710+ "outputs": [

711+ {

712+ "data": {

713+ "text/html": [

714+ "ok"

715+ ],

716+ "text/plain": [

717+ "ok"

718+ ]

719+ },

720+ "metadata": {},

721+ "output_type": "display_data"

722+ }

723+ ],

724+ "source": [

725+ "key sandwich_name{name} sandwich"

726+ ]

727+ },

728+ {

729+ "cell_type": "code",

730+ "execution_count": 21,

731+ "metadata": {},

732+ "outputs": [

733+ {

734+ "ename": "TutorialDError",

735+ "evalue": "",

736+ "output_type": "error",

737+ "traceback": [

738+ "InclusionDependencyCheckError \"sandwich_name\""

739+ ]

740+ }

741+ ],

742+ "source": [

743+ "insert sandwich relation{tuple{name \"Tuna\", price 6}}"

744+ ]

745+ },

746+ {

747+ "cell_type": "markdown",

748+ "metadata": {},

749+ "source": [

750+ "## Jupyter Kernel Features\n",

751+ "\n",

752+ "By default, the TutorialD kernel will automatically start a `project-m36-websocket-server` when the first TutorialD command is executed. For this to work, `project-m36-websocket-server` must be in the jupyter server's `PATH` environment variable.\n",

753+ "\n",

754+ "### Magic\n",

755+ "\n",

756+ "Like the python kernel, the TutorialD kernel includes some commands to interact directly with the kernel. These commands are not passed to the TutorialD interpreter.\n",

757+ "\n",

758+ "* `%help` brings up some help which includes links to additional documentation\n",

759+ "* `%connect ws://<host>:<port> <dbname>` connects to the `project-m36-websocket-server` already running. For example:\n",

760+ " ```\n",

761+ " %connect ws://localhost:64000 employees\n",

762+ " ```\n",

763+ " connects to the websocket server running on the localhost on port 64000 and selects the database named \"employees\". Note that the database name is not part of the websocket URL.\n",

764+ " \n",

765+ "## Conclusion\n",

766+ "\n",

767+ "[Project:M36](https://github.com/agentm/project-m36) is a fully-featured relational algebra engine suitable for use a database. It sets out to prove that sticking to the mathematical underpinnings of the relational algebra is straightforward and results in improved correctness and performance.\n",

768+ "\n",

769+ "If you would like to learn more, please refer to the [documentation](https://github.com/agentm/project-m36#documentation) and join our welcoming [community](https://github.com/agentm/project-m36#community) to ask questions."

770+ ]

771+ },

772+ {

773+ "cell_type": "code",

774+ "execution_count": null,

775+ "metadata": {},

776+ "outputs": [],

777+ "source": []

778+ }

779+ ],

780+ "metadata": {

781+ "kernelspec": {

782+ "display_name": "TutorialD (Project:M36)",

783+ "language": "TutorialD",

784+ "name": "tutd"

785+ },

786+ "language_info": {

787+ "file_extension": ".tutd",

788+ "mimetype": "text/x-tutd",

789+ "name": "TutorialD"

790+ }

791+ },

792+ "nbformat": 4,

793+ "nbformat_minor": 2

794+}

jupyter/itutd/ITutorialDKernel.pynew file+179

@@ -0,0 +1,179 @@

1+from ipykernel.kernelbase import Kernel

2+import subprocess

3+from websocket import create_connection, WebSocketConnectionClosedException, WebSocketBadStatusException

4+import time

5+import select

6+import json

7+import socket

8+import errno

9+import urlparse

10+

11+class ITutorialDKernel(Kernel):

12+ implementation = 'ITutorialD'

13+ implementation_version = '0.1'

14+

15+ banner = 'TutorialD kernel using Project:M36 https://github.com/agentm/project-m36'

16+

17+ language = 'TutorialD'

18+ language_version = '0.3'

19+ language_info = {

20+ 'name': 'TutorialD',

21+ 'mimetype': 'text/x-tutd',

22+ 'file_extension': '.tutd',

23+ }

24+ dbserver = None

25+ ws = None

26+

27+# todo: implement wrong database name handling

28+ def runtutd(self, tutd):

29+ #setup server

30+ dbname = 'jupyter'

31+ port = 63000

32+ if not self.ws and not self.dbserver:

33+ try:

34+ self.dbserver = subprocess.Popen(['project-m36-websocket-server',

35+ '--database', dbname,

36+ '--port', str(port)],

37+ )

38+ except OSError as err:

39+ if err.errno == errno.ENOENT:

40+ return ('"project-m36-websocket-server" is not in the PATH environment variable and could not be started.', None)

41+ else:

42+ raise

43+ res = self.connect_ws('ws://127.0.0.1:63000', dbname, retries=10)

44+ if res:

45+ return ('Connection failed: {}'.format(res), None)

46+

47+ self.ws.send('executetutd/html+text:' + tutd)

48+ try:

49+ jsonresult = self.discard_prompts()

50+ except WebSocketConnectionClosedException:

51+ self.ws = None

52+ return ('Websocket server closed the connection.',None)

53+ res = json.loads(jsonresult)

54+ if 'displayerror' in res:

55+ return (res['displayerror']['text'], None)

56+ elif 'acknowledged' in res:

57+ return (None, {'html':'ok', 'text':'ok'})

58+ else:

59+ return (None, res['displayrelation'])

60+

61+ def connect_ws(self, url, dbname, retries=0):

62+ while 1:

63+ try:

64+ ws = create_connection(url)

65+ except socket.error as err:

66+ if err.errno in (errno.ECONNREFUSED, ):

67+ time.sleep(1.0)

68+ if retries == 0:

69+ return 'Failed to connect to websocket.'

70+ retries -= 1

71+ else:

72+ raise

73+ except WebSocketBadStatusException:

74+ return 'Failed to negotiate websocket connection.'

75+ else:

76+ break

77+ self.ws = ws

78+ self.ws.send('connectdb:{}'.format(dbname))

79+ msg = json.loads(self.ws.recv())

80+ if 'displayerror' in msg:

81+ return msg['displayerror']['tag']

82+ return None

83+

84+ def discard_prompts(self):

85+ #read from the websocket until a non-prompt message is received

86+ while 1:

87+ sel = select.select([self.ws.sock],[],[],0)

88+ if len(sel[0]) > 0:

89+ #there is something to read

90+ msg = self.ws.recv()

91+ if 'promptInfo' not in msg:

92+ return msg

93+

94+ def send_error(self, msg):

95+ stream_content = {'ename':'TutorialDError',

96+ 'traceback':[msg],

97+ 'evalue':''}

98+ self.send_response(self.iopub_socket, 'error', stream_content)

99+

100+

101+ def process_magic(self, code):

102+ #handle "magic" processing of commands which are not sent to the tutd interpreter

103+ cmds = code.split(' ')

104+ ok = {'text':'ok', 'html':'ok'}

105+

106+ if cmds[0] == '%connect' and len(cmds) == 3:

107+ #connect to alternate database

108+ url = urlparse.urlparse(cmds[1])

109+ dbname = cmds[2]

110+ if not url.scheme.startswith('ws'):

111+ return ('Rejected attempt to connect to non-websocket. Use ws:// or wss:// scheme',None)

112+ res = self.connect_ws(url.geturl(), dbname)

113+ if res: #error from connection

114+ return (res, None, None)

115+ else: #connection successful

116+ return (None, ok, None)

117+ elif cmds[0] == '%help' and len(cmds) == 1:

118+ #display some help

119+ return (None, ok, self.show_help())

120+ elif cmds[0].startswith('%'):

121+ return ('Invalid magic command.', None)

122+

123+ def do_execute(self, code, silent,

124+ store_history=True,

125+ user_expressions=False,

126+ allow_stdin=False):

127+ magic = self.process_magic(code)

128+ payload = None

129+ if magic:

130+ (err, result, payload) = magic

131+ else:

132+ (err, result) = self.runtutd(code)

133+ if not silent:

134+ if err:

135+ status = 'error'

136+ self.send_error(err)

137+ else:

138+ status = 'ok'

139+ display_content = {

140+ 'data':{'text/html':result['html'],

141+ 'text/plain':result['text']},

142+ 'metadata':{},

143+ 'transient':{}

144+ }

145+ self.send_response(self.iopub_socket, 'display_data', display_content)

146+ ret ={'status': status,

147+ 'execution_count': self.execution_count,

148+ 'payload':[payload],

149+ 'user_expressions':{}}

150+ if payload:

151+ ret['payload'] = [payload]

152+ return ret

153+

154+ def do_shutdown(self, restart):

155+ if self.dbserver:

156+ self.dbserver.terminate()

157+ self.dbserver.kill()

158+

159+ def show_help(self):

160+ return {'source': 'page',

161+ 'start':0,

162+ 'data':{'text/html':'''<h1>Project:M36 TutorialD Jupyter Kernel Help</h1>

163+<p>TutorialD is an interactive language for the relational algebra.</p>

164+

165+<p><a href="https://github.com/agentm/project-m36/blob/master/docs/15_minute_tutorial.markdown">15 Minute TutorialD Introduction</a></p>

166+<p><a href="https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown">TutorialD Documentation</a></p>

167+''',

168+ 'text/plain':

169+'''Project:M36 TutorialD Jupyter Kernel Help

170+

171+TutorialD is an interactive language for the relational algebra.

172+

173+15 Minute TutorialD Introduction: https://github.com/agentm/project-m36/blob/master/docs/15_minute_tutorial.markdown

174+TutorialD Documentation: https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown

175+'''}}

176+

177+if __name__ == '__main__':

178+ from ipykernel.kernelapp import IPKernelApp

179+ IPKernelApp.launch_instance(kernel_class=ITutorialDKernel)

jupyter/itutd/__init__.pynew file+1

@@ -0,0 +1 @@

jupyter/itutd/__main__.pynew file+4

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

1+from ipykernel.kernelapp import IPKernelApp

2+from . import ITutorialDKernel

4+IPKernelApp.launch_instance(kernel_class=ITutorialDKernel)

jupyter/kernel.jsonnew file+5

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

1+{

2+ "language":"TutorialD",

3+ "display_name":"TutorialD (Project:M36)",

4+ "argv":["python", "-m", "itutd.ITutorialDKernel", "-f", "{connection_file}"]

5+}

jupyter/setup.pynew file+19

@@ -0,0 +1,19 @@

1+from setuptools import setup

3+setup(

4+ name='itutd',

5+ version='0.1',

6+ packages=['itutd'],

7+ description='TutorialD Jupyter kernel for Project:M36',

8+ author='AgentM',

9+ author_email='agentm@themactionfaction.com',

10+ url='https://github.com/agentm/project-m36/jupyter/',

11+ install_requires=[

12+ 'jupyter_client', 'IPython', 'ipykernel', 'websocket-client'

13+ ],

14+ classifiers=[

15+ 'Intended Audience :: Developers',

16+ 'License :: OSI Approved :: Public Domain',

17+ 'Programming Language :: Python :: 2',

18+ ],

19+)

nix/sources.jsonnew file+50

@@ -0,0 +1,50 @@

1+{

2+ "curryer": {

3+ "branch": "master",

4+ "description": "Fast Haskell RPC",

5+ "homepage": null,

6+ "owner": "agentm",

7+ "repo": "curryer",

8+ "rev": "74ecaac619ad1165a4517d5c0f4e530493bda130",

9+ "sha256": "1izdvzj00k0y76ixm7dfgvq2fzphb8h4nzqgwkl3p0bg0806rsn1",

10+ "type": "tarball",

11+ "url": "https://github.com/agentm/curryer/archive/74ecaac619ad1165a4517d5c0f4e530493bda130.tar.gz",

12+ "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

13+ },

14+ "niv": {

15+ "branch": "master",

16+ "description": "Easy dependency management for Nix projects",

17+ "homepage": "https://github.com/nmattia/niv",

18+ "owner": "nmattia",

19+ "repo": "niv",

20+ "rev": "1819632b5823e0527da28ad82fecd6be5136c1e9",

21+ "sha256": "08jz17756qchq0zrqmapcm33nr4ms9f630mycc06i6zkfwl5yh5i",

22+ "type": "tarball",

23+ "url": "https://github.com/nmattia/niv/archive/1819632b5823e0527da28ad82fecd6be5136c1e9.tar.gz",

24+ "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

25+ },

26+ "nixpkgs": {

27+ "branch": "master",

28+ "description": "Nix Packages collection",

29+ "homepage": "",

30+ "owner": "NixOS",

31+ "repo": "nixpkgs",

32+ "rev": "429c23aad0fce9ef38b0e60d55d7459c19d53ddc",

33+ "sha256": "1nj8sh1fnxp07jdlvjkijwfd1pnsi2zj0ivy7a0dhx02g63byhg3",

34+ "type": "tarball",

35+ "url": "https://github.com/NixOS/nixpkgs/archive/429c23aad0fce9ef38b0e60d55d7459c19d53ddc.tar.gz",

36+ "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

37+ },

38+ "streamly": {

39+ "branch": "ac3af8749194f1788704dda8667d0b3807075cc2",

40+ "description": "Beautiful Streaming, Concurrent and Reactive Composition (Haskell)",

41+ "homepage": "https://hackage.haskell.org/package/streamly",

42+ "owner": "composewell",

43+ "repo": "streamly",

44+ "rev": "ac3af8749194f1788704dda8667d0b3807075cc2",

45+ "sha256": "04d8fk654vawdfs0dfidmq2awwgwi8x44iv8r7vqz70zkcsd5fij",

46+ "type": "tarball",

47+ "url": "https://github.com/composewell/streamly/archive/ac3af8749194f1788704dda8667d0b3807075cc2.tar.gz",

48+ "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"

49+ }

50+}

nix/sources.nixnew file+171

@@ -0,0 +1,171 @@

1+# This file has been generated by Niv.

3+let

5+ #

6+ # The fetchers. fetch_<type> fetches specs of type <type>.

7+ #

9+ fetch_file = pkgs: name: spec:

10+ let

11+ name' = sanitizeName name + "-src";

12+ in

13+ if spec.builtin or true then

14+ builtins_fetchurl { inherit (spec) url sha256; name = name'; }

15+ else

16+ pkgs.fetchurl { inherit (spec) url sha256; name = name'; };

17+

18+ fetch_tarball = pkgs: name: spec:

19+ let

20+ name' = sanitizeName name + "-src";

21+ in

22+ if spec.builtin or true then

23+ builtins_fetchTarball { name = name'; inherit (spec) url sha256; }

24+ else

25+ pkgs.fetchzip { name = name'; inherit (spec) url sha256; };

26+

27+ fetch_git = name: spec:

28+ let

29+ ref =

30+ if spec ? ref then spec.ref else

31+ if spec ? branch then "refs/heads/${spec.branch}" else

32+ if spec ? tag then "refs/tags/${spec.tag}" else

33+ abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!";

34+ in

35+ builtins.fetchGit { url = spec.repo; inherit (spec) rev; inherit ref; };

36+

37+ fetch_local = spec: spec.path;

38+

39+ fetch_builtin-tarball = name: throw

40+ ''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`.

41+ $ niv modify ${name} -a type=tarball -a builtin=true'';

42+

43+ fetch_builtin-url = name: throw

44+ ''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`.

45+ $ niv modify ${name} -a type=file -a builtin=true'';

46+

47+ #

48+ # Various helpers

49+ #

50+

51+ # https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695

52+ sanitizeName = name:

53+ (

54+ concatMapStrings (s: if builtins.isList s then "-" else s)

55+ (

56+ builtins.split "[^[:alnum:]+._?=-]+"

57+ ((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name)

58+ )

59+ );

60+

61+ # The set of packages used when specs are fetched using non-builtins.

62+ mkPkgs = sources: system:

63+ let

64+ sourcesNixpkgs =

65+ import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; };

66+ hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath;

67+ hasThisAsNixpkgsPath = <nixpkgs> == ./.;

68+ in

69+ if builtins.hasAttr "nixpkgs" sources

70+ then sourcesNixpkgs

71+ else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then

72+ import <nixpkgs> {}

73+ else

74+ abort

75+ ''

76+ Please specify either <nixpkgs> (through -I or NIX_PATH=nixpkgs=...) or

77+ add a package called "nixpkgs" to your sources.json.

78+ '';

79+

80+ # The actual fetching function.

81+ fetch = pkgs: name: spec:

82+

83+ if ! builtins.hasAttr "type" spec then

84+ abort "ERROR: niv spec ${name} does not have a 'type' attribute"

85+ else if spec.type == "file" then fetch_file pkgs name spec

86+ else if spec.type == "tarball" then fetch_tarball pkgs name spec

87+ else if spec.type == "git" then fetch_git name spec

88+ else if spec.type == "local" then fetch_local spec

89+ else if spec.type == "builtin-tarball" then fetch_builtin-tarball name

90+ else if spec.type == "builtin-url" then fetch_builtin-url name

91+ else

92+ abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}";

93+

94+ # If the environment variable NIV_OVERRIDE_${name} is set, then use

95+ # the path directly as opposed to the fetched source.

96+ replace = name: drv:

97+ let

98+ saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name;

99+ ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";

100+ in

101+ if ersatz == "" then drv else ersatz;

102+

103+ # Ports of functions for older nix versions

104+

105+ # a Nix version of mapAttrs if the built-in doesn't exist

106+ mapAttrs = builtins.mapAttrs or (

107+ f: set: with builtins;

108+ listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set))

109+ );

110+

111+ # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295

112+ range = first: last: if first > last then [] else builtins.genList (n: first + n) (last - first + 1);

113+

114+ # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257

115+ stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1));

116+

117+ # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269

118+ stringAsChars = f: s: concatStrings (map f (stringToCharacters s));

119+ concatMapStrings = f: list: concatStrings (map f list);

120+ concatStrings = builtins.concatStringsSep "";

121+

122+ # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331

123+ optionalAttrs = cond: as: if cond then as else {};

124+

125+ # fetchTarball version that is compatible between all the versions of Nix

126+ builtins_fetchTarball = { url, name ? null, sha256 }@attrs:

127+ let

128+ inherit (builtins) lessThan nixVersion fetchTarball;

129+ in

130+ if lessThan nixVersion "1.12" then

131+ fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))

132+ else

133+ fetchTarball attrs;

134+

135+ # fetchurl version that is compatible between all the versions of Nix

136+ builtins_fetchurl = { url, name ? null, sha256 }@attrs:

137+ let

138+ inherit (builtins) lessThan nixVersion fetchurl;

139+ in

140+ if lessThan nixVersion "1.12" then

141+ fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; }))

142+ else

143+ fetchurl attrs;

144+

145+ # Create the final "sources" from the config

146+ mkSources = config:

147+ mapAttrs (

148+ name: spec:

149+ if builtins.hasAttr "outPath" spec

150+ then abort

151+ "The values in sources.json should not have an 'outPath' attribute"

152+ else

153+ spec // { outPath = replace name (fetch config.pkgs name spec); }

154+ ) config.sources;

155+

156+ # The "config" used by the fetchers

157+ mkConfig =

158+ { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null

159+ , sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)

160+ , system ? builtins.currentSystem

161+ , pkgs ? mkPkgs sources system

162+ }: rec {

163+ # The sources, i.e. the attribute set of spec name to spec

164+ inherit sources;

165+

166+ # The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers

167+ inherit pkgs;

168+ };

169+

170+in

171+mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); }

project-m36.cabal+198−215

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

1+Cabal-Version: 2.2

1Name: project-m36

2Name: project-m36

2−Version: 0.3

3+Version: 0.9.3

3−License: PublicDomain

4+License: MIT

5+--note that this license specification is erroneous and only labeled MIT to appease hackage which does not recognize public domain packages in cabal >2.2- Project:M36 is dedicated to the public domain

4Build-Type: Simple

6Build-Type: Simple

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

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

6Bug-Reports: https://github.com/agentm/project-m36/issues

8Bug-Reports: https://github.com/agentm/project-m36/issues

@@ -8,7 +10,6 @@ Author: AgentM

8Stability: experimental

10Stability: experimental

9Category: Relational Algebra

11Category: Relational Algebra

10Maintainer: agentm@themactionfaction.com

12Maintainer: agentm@themactionfaction.com

11−Cabal-Version: >= 1.10

12Synopsis: Relational Algebra Engine

13Synopsis: Relational Algebra Engine

13Description: A relational algebra engine which can be used to persist and query Haskell data types.

14Description: A relational algebra engine which can be used to persist and query Haskell data types.

14Extra-Source-Files: Changelog.markdown README.markdown

15Extra-Source-Files: Changelog.markdown README.markdown

@@ -22,66 +23,27 @@ Flag profiler

22 Default: False

23 Default: False

23 Manual: True

24 Manual: True

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

27+Flag stack

28+ Description: build with stack and stackage

29+ Manual: True

30+ Default: False

31+

32+Flag haskell-scripting

33+ Description: enables Haskell scripting which links against GHC as a library

34+ Manual: True

35+ Default: True

36+

25Library

37Library

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

38+ 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, 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.4, winery, curryer-rpc, network, async, vector-instances, recursion-schemes, streamly >= 0.7.2, convertible

27− ,ghc >= 7.8 && < 8.3

39+ if flag(haskell-scripting)

28− ,ghc-paths

40+ Build-Depends: ghc >= 8.2 && < 8.11

29− ,mtl

41+ CPP-Options: -DPM36_HASKELL_SCRIPTING

30− ,containers

42+ if impl(ghc>= 8) && flag(haskell-scripting)

31− ,unordered-containers

43+ build-depends:

32− ,hashable

44+ ghc-boot, ghci

33− ,haskeline

45+ if impl(ghc>= 8.6)

34− ,directory

46+ Build-Depends: deferred-folds

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

48− ,gnuplot

49− ,binary

50− ,filepath

51− ,zlib

52− ,directory

53− ,vector-binary-instances

54− ,temporary

55− ,stm

56− ,time

57− ,hashable-time

58− ,old-locale

59− --used for CSV parsing

60− ,attoparsec

61− ,either

62− ,base64-bytestring

63− ,data-interval

64− ,extended-reals

65− ,network-transport

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

67− ,aeson >= 1.1

68− ,path-pieces

69− ,conduit

70− ,resourcet

71− ,http-api-data

72−--needed for remote access

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

74− ,distributed-process >= 0.6.6

75− ,distributed-process-extras >= 0.3.2

76− ,distributed-process-async >= 0.2.4

77− ,network-transport-tcp

78− ,network-transport

79− ,list-t

80− ,stm-containers >= 0.2.15

81− ,optparse-applicative

82− ,Glob

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

84− ,cryptohash-sha256

85 Exposed-Modules: ProjectM36.Error,

47 Exposed-Modules: ProjectM36.Error,

86 ProjectM36.Transaction,

48 ProjectM36.Transaction,

87 ProjectM36.TransactionGraph,

49 ProjectM36.TransactionGraph,

@@ -90,6 +52,9 @@ Library

90 ProjectM36.TransactionGraph.Merge,

52 ProjectM36.TransactionGraph.Merge,

91 ProjectM36.TransGraphRelationalExpression,

53 ProjectM36.TransGraphRelationalExpression,

92 ProjectM36.Base,

54 ProjectM36.Base,

55+ ProjectM36.Serialise.Base,

56+ ProjectM36.Serialise.Error,

57+ ProjectM36.DataFrame,

93 ProjectM36.Attribute,

58 ProjectM36.Attribute,

94 ProjectM36.AttributeNames,

59 ProjectM36.AttributeNames,

95 ProjectM36.Tuple,

60 ProjectM36.Tuple,

@@ -98,6 +63,7 @@ Library

98 ProjectM36.AtomFunction,

63 ProjectM36.AtomFunction,

99 ProjectM36.AtomFunctionError,

64 ProjectM36.AtomFunctionError,

100 ProjectM36.ScriptSession,

65 ProjectM36.ScriptSession,

66+ ProjectM36.Shortcuts,

101 ProjectM36.DatabaseContextFunction,

67 ProjectM36.DatabaseContextFunction,

102 ProjectM36.DatabaseContextFunctionError,

68 ProjectM36.DatabaseContextFunctionError,

103 ProjectM36.DatabaseContextFunctionUtils,

69 ProjectM36.DatabaseContextFunctionUtils,

@@ -111,26 +77,32 @@ Library

111 ProjectM36.Relation.Show.HTML,

77 ProjectM36.Relation.Show.HTML,

112 ProjectM36.StaticOptimizer,

78 ProjectM36.StaticOptimizer,

113 ProjectM36.Relation.Show.Term,

79 ProjectM36.Relation.Show.Term,

80+ ProjectM36.WCWidth,

114 ProjectM36.Relation.Show.CSV,

81 ProjectM36.Relation.Show.CSV,

115 ProjectM36.Relation.Show.Gnuplot,

82 ProjectM36.Relation.Show.Gnuplot,

116 ProjectM36.Relation.Parse.CSV,

83 ProjectM36.Relation.Parse.CSV,

117 ProjectM36.IsomorphicSchema,

84 ProjectM36.IsomorphicSchema,

118 ProjectM36.InclusionDependency,

85 ProjectM36.InclusionDependency,

86+ ProjectM36.MerkleHash,

119 ProjectM36.Client,

87 ProjectM36.Client,

120 ProjectM36.Client.Simple,

88 ProjectM36.Client.Simple,

121 ProjectM36.Persist,

89 ProjectM36.Persist,

122 ProjectM36.AtomType,

90 ProjectM36.AtomType,

91+ ProjectM36.AttributeExpr,

123 ProjectM36.AtomFunctions.Basic,

92 ProjectM36.AtomFunctions.Basic,

124 ProjectM36.AtomFunctions.Primitive,

93 ProjectM36.AtomFunctions.Primitive,

125 ProjectM36.Atomable,

94 ProjectM36.Atomable,

126 ProjectM36.Tupleable,

95 ProjectM36.Tupleable,

96+ ProjectM36.Tupleable.Deriving,

127 ProjectM36.DataConstructorDef,

97 ProjectM36.DataConstructorDef,

128 ProjectM36.DataTypes.Basic,

98 ProjectM36.DataTypes.Basic,

99+ ProjectM36.DataTypes.Sorting,

129 ProjectM36.DataTypes.Day,

100 ProjectM36.DataTypes.Day,

130 ProjectM36.DataTypes.DateTime,

101 ProjectM36.DataTypes.DateTime,

131 ProjectM36.DataTypes.Either,

102 ProjectM36.DataTypes.Either,

132 ProjectM36.DataTypes.Maybe,

103 ProjectM36.DataTypes.Maybe,

133 ProjectM36.DataTypes.List,

104 ProjectM36.DataTypes.List,

105+ ProjectM36.DataTypes.NonEmptyList,

134 ProjectM36.DataTypes.Primitive,

106 ProjectM36.DataTypes.Primitive,

135 ProjectM36.DataTypes.Interval,

107 ProjectM36.DataTypes.Interval,

136 ProjectM36.DataTypes.ByteString,

108 ProjectM36.DataTypes.ByteString,

@@ -142,31 +114,42 @@ Library

142 ProjectM36.Server.EntryPoints,

114 ProjectM36.Server.EntryPoints,

143 ProjectM36.Server.ParseArgs,

115 ProjectM36.Server.ParseArgs,

144 ProjectM36.Server.RemoteCallTypes,

116 ProjectM36.Server.RemoteCallTypes,

117+ ProjectM36.Serialise.AtomFunctionError,

118+ ProjectM36.Serialise.DataFrame,

119+ ProjectM36.Serialise.DatabaseContextFunctionError,

120+ ProjectM36.Serialise.IsomorphicSchema,

145 ProjectM36.Session,

121 ProjectM36.Session,

146 ProjectM36.Sessions,

122 ProjectM36.Sessions,

147 ProjectM36.Transaction.Persist,

123 ProjectM36.Transaction.Persist,

148 ProjectM36.TypeConstructor,

124 ProjectM36.TypeConstructor,

149 ProjectM36.TypeConstructorDef,

125 ProjectM36.TypeConstructorDef,

150 ProjectM36.FileLock,

126 ProjectM36.FileLock,

151− ProjectM36.FSType

127+ ProjectM36.FSType,

128+ ProjectM36.Arbitrary,

129+ ProjectM36.GraphRefRelationalExpr,

130+ ProjectM36.NormalizeExpr,

131+ ProjectM36.TransactionInfo,

132+ ProjectM36.WithNameExpr

152− GHC-Options: -Wall

133+ GHC-Options: -Wall -rdynamic

153 if os(windows)

134 if os(windows)

154− Build-Depends: Win32 >= 2.3

135+ Build-Depends: Win32 >= 2.5.4.1

155 Other-Modules: ProjectM36.Win32Handle

136 Other-Modules: ProjectM36.Win32Handle

156 else

137 else

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

139+ GHC-Options: -rdynamic -fexternal-interpreter

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

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

158 Build-Depends: unix

141 Build-Depends: unix

159 CC-Options: -fPIC

142 CC-Options: -fPIC

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

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

161 Default-Language: Haskell2010

144 Default-Language: Haskell2010

162 Default-Extensions: OverloadedStrings, CPP

145 Default-Extensions: OverloadedStrings, CPP

163− if impl(ghc>= 8)

146+ if !flag(stack)

164− build-depends:

147+ Build-Depends: deferred-folds

165− ghc-boot

166

148

167Executable tutd

149Executable tutd

150+ if flag(haskell-scripting)

151+ Build-Depends: ghc >= 8.2 && < 8.11

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

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

169− ghc >= 7.8 && < 8.3,

170 ghc-paths,

153 ghc-paths,

171 project-m36,

154 project-m36,

172 containers,

155 containers,

@@ -180,13 +163,11 @@ Executable tutd

180 MonadRandom, MonadRandom,

163 MonadRandom, MonadRandom,

181 vector,

164 vector,

182 text,

165 text,

183− vector-binary-instances,

184 time,

166 time,

185 hashable-time,

167 hashable-time,

186 bytestring,

168 bytestring,

187 stm,

169 stm,

188 deepseq,

170 deepseq,

189− binary,

190 data-interval,

171 data-interval,

191 parallel,

172 parallel,

192 cassava,

173 cassava,

@@ -194,14 +175,23 @@ Executable tutd

194 directory,

175 directory,

195 filepath,

176 filepath,

196 temporary,

177 temporary,

197− megaparsec >= 5.2.0 && < 5.4,

178+ megaparsec >= 5.2.0 && < 10,

198 haskeline,

179 haskeline,

199 random, MonadRandom,

180 random, MonadRandom,

200 base64-bytestring,

181 base64-bytestring,

201 optparse-applicative,

182 optparse-applicative,

202 attoparsec,

183 attoparsec,

203− stm-containers,

184+ stm-containers >= 1.0.0,

204− list-t

185+ list-t,

186+ parser-combinators,

187+ curryer-rpc,

188+ prettyprinter,

189+ cryptohash-sha256,

190+ --due to decode signature change

191+ base16-bytestring >= 1.0.0.0,

192+ http-conduit,

193+ modern-uri,

194+ http-types

205 Other-Modules: TutorialD.Interpreter,

195 Other-Modules: TutorialD.Interpreter,

206 TutorialD.Interpreter.Base,

196 TutorialD.Interpreter.Base,

207 TutorialD.Interpreter.DatabaseContextExpr,

197 TutorialD.Interpreter.DatabaseContextExpr,

@@ -220,20 +210,21 @@ Executable tutd

220 TutorialD.Interpreter.SchemaOperator,

210 TutorialD.Interpreter.SchemaOperator,

221 TutorialD.Interpreter.TransGraphRelationalOperator,

211 TutorialD.Interpreter.TransGraphRelationalOperator,

222 TutorialD.Interpreter.SchemaOperator

212 TutorialD.Interpreter.SchemaOperator

213+ TutorialD.Printer

223 main-is: TutorialD/tutd.hs

214 main-is: TutorialD/tutd.hs

224 CC-Options: -fPIC

215 CC-Options: -fPIC

225− GHC-Options: -Wall

216+ GHC-Options: -Wall -threaded

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

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

227 Default-Language: Haskell2010

218 Default-Language: Haskell2010

228 Default-Extensions: OverloadedStrings

219 Default-Extensions: OverloadedStrings

229

220

230Executable project-m36-server

221Executable project-m36-server

222+ if flag(haskell-scripting)

223+ Build-Depends: ghc >= 8.2 && < 8.11

231 Build-Depends: base,

224 Build-Depends: base,

232− ghc >= 7.8 && < 8.3,

233 ghc-paths,

225 ghc-paths,

234− project-m36,

235− binary,

236 transformers,

226 transformers,

227+ project-m36,

237 temporary,

228 temporary,

238 data-interval,

229 data-interval,

239 deepseq,

230 deepseq,

@@ -246,7 +237,6 @@ Executable project-m36-server

246 optparse-applicative,

237 optparse-applicative,

247 hashable-time,

238 hashable-time,

248 time,

239 time,

249− vector-binary-instances,

250 text,

240 text,

251 deepseq-generics,

241 deepseq-generics,

252 mtl,

242 mtl,

@@ -268,7 +258,7 @@ Executable project-m36-server

268Executable bigrel

258Executable bigrel

269 Default-Language: Haskell2010

259 Default-Language: Haskell2010

270 Default-Extensions: OverloadedStrings

260 Default-Extensions: OverloadedStrings

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

261+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, 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

272 Other-Modules: TutorialD.Interpreter.Base,

262 Other-Modules: TutorialD.Interpreter.Base,

273 TutorialD.Interpreter.DatabaseContextExpr,

263 TutorialD.Interpreter.DatabaseContextExpr,

274 TutorialD.Interpreter.RelationalExpr,

264 TutorialD.Interpreter.RelationalExpr,

@@ -279,232 +269,220 @@ Executable bigrel

279 if flag(profiler)

269 if flag(profiler)

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

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

281

271

282−Test-Suite test-tutoriald

272+Common commontest

283 Default-Language: Haskell2010

273 Default-Language: Haskell2010

274+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, 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-rpc, prettyprinter, base64-bytestring, modern-uri, http-types, http-conduit, base16-bytestring,cryptohash-sha256

284 Default-Extensions: OverloadedStrings

275 Default-Extensions: OverloadedStrings

285− type: exitcode-stdio-1.0

286− main-is: test/TutorialD/Interpreter.hs

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

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

289− GHC-Options: -Wall

276+ GHC-Options: -Wall -threaded

290− Hs-Source-Dirs: ./src/bin, ., test

277+ Hs-Source-Dirs: test, src/bin

291

278

292−Test-Suite test-tutoriald-atomfunctionscript

279+Benchmark basic-benchmark

293 Default-Language: Haskell2010

280 Default-Language: Haskell2010

294 Default-Extensions: OverloadedStrings

281 Default-Extensions: OverloadedStrings

282+ Build-Depends: base, criterion, project-m36, text, vector, transformers, containers, temporary, directory, filepath

283+ Main-Is: benchmark/Basic.hs

284+ Type: exitcode-stdio-1.0

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

286+ HS-Source-Dirs: ./src/bin

287+ if flag(profiler)

288+ GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall

289+

290+--benchmark inserts, updates, deletes for a basic use-case to shake out any space leaks

291+Benchmark update-exprs

292+ Default-Language: Haskell2010

293+ Default-Extensions: OverloadedStrings

294+ Build-Depends: base, criterion, project-m36, text, winery

295+ Main-Is: benchmark/Server.hs

296+ Type: exitcode-stdio-1.0

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

298+ HS-Source-Dirs: ./src/bin

299+ if flag(profiler)

300+ GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall -fexternal-interpreter

301+

302+Test-Suite test-tutoriald

303+ import: commontest

295 type: exitcode-stdio-1.0

304 type: exitcode-stdio-1.0

305+ main-is: TutorialD/InterpreterTest.hs

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

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

297− main-is: test/TutorialD/Interpreter/AtomFunctionScript.hs

307+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, 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

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

308+

299− GHC-Options: -Wall

309+Test-Suite test-tutoriald-atomfunctionscript

300− Hs-Source-Dirs: ./src/bin, ./test, .

310+ import: commontest

311+ type: exitcode-stdio-1.0

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

313+ main-is: TutorialD/Interpreter/AtomFunctionScript.hs

301

314

302Test-Suite test-tutoriald-databasecontextfunctionscript

315Test-Suite test-tutoriald-databasecontextfunctionscript

303− Default-Language: Haskell2010

316+ import: commontest

304− Default-Extensions: OverloadedStrings

305 type: exitcode-stdio-1.0

317 type: exitcode-stdio-1.0

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

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

307− main-is: test/TutorialD/Interpreter/DatabaseContextFunctionScript.hs

319+ main-is: TutorialD/Interpreter/DatabaseContextFunctionScript.hs

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

309− GHC-Options: -Wall

310− Hs-Source-Dirs: ./src/bin, ./test, .

311

320

312Test-Suite test-relation

321Test-Suite test-relation

313− Default-Language: Haskell2010

322+ import: commontest

314− Default-Extensions: OverloadedStrings

315 type: exitcode-stdio-1.0

323 type: exitcode-stdio-1.0

316− main-is: test/Relation/Basic.hs

324+ main-is: Relation/Basic.hs

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

318− GHC-Options: -Wall

319

325

320Test-Suite test-static-optimizer

326Test-Suite test-static-optimizer

321− Default-Language: Haskell2010

327+ import: commontest

322− Default-Extensions: OverloadedStrings

323 type: exitcode-stdio-1.0

328 type: exitcode-stdio-1.0

324− main-is: test/Relation/StaticOptimizer.hs

329+ main-is: Relation/StaticOptimizer.hs

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

326− GHC-Options: -Wall

327

330

328Test-Suite test-transactiongraph-persist

331Test-Suite test-transactiongraph-persist

329− Default-Language: Haskell2010

332+ import: commontest

330− Default-Extensions: OverloadedStrings

331 type: exitcode-stdio-1.0

333 type: exitcode-stdio-1.0

332− main-is: test/TransactionGraph/Persist.hs

334+ main-is: TransactionGraph/Persist.hs

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

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

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

335− Hs-Source-Dirs: ., ./src/bin

336− GHC-Options: -Wall

337

336

338Test-Suite test-relation-import-csv

337Test-Suite test-relation-import-csv

339− Default-Language: Haskell2010

338+ import: commontest

340− Default-Extensions: OverloadedStrings

341 type: exitcode-stdio-1.0

339 type: exitcode-stdio-1.0

342− main-is: test/Relation/Import/CSV.hs

340+ main-is: Relation/Import/CSV.hs

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

344− GHC-Options: -Wall

345

341

346Test-Suite test-tutoriald-import-tutoriald

342Test-Suite test-tutoriald-import-tutoriald

347− Default-Language: Haskell2010

343+ import: commontest

348− Default-Extensions: OverloadedStrings

349 type: exitcode-stdio-1.0

344 type: exitcode-stdio-1.0

350− main-is: test/TutorialD/Interpreter/Import/TutorialD.hs

345+ main-is: TutorialD/Interpreter/Import/ImportTest.hs

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

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

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

353− GHC-Options: -Wall

354− Hs-Source-Dirs: ., ./src/bin

355

347

356Test-Suite test-relation-export-csv

348Test-Suite test-relation-export-csv

357− Default-Language: Haskell2010

349+ import: commontest

358− Default-Extensions: OverloadedStrings

359 type: exitcode-stdio-1.0

350 type: exitcode-stdio-1.0

360− main-is: test/Relation/Export/CSV.hs

351+ main-is: Relation/Export/CSV.hs

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

362− GHC-Options: -Wall

363

352

364Test-Suite test-transactiongraph-merge

353Test-Suite test-transactiongraph-merge

365− Default-Language: Haskell2010

354+ import: commontest

366− Default-Extensions: OverloadedStrings

367 type: exitcode-stdio-1.0

355 type: exitcode-stdio-1.0

368− main-is: test/TransactionGraph/Merge.hs

356+ main-is: TransactionGraph/Merge.hs

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

357+

370− GHC-Options: -Wall

358+

359+Test-Suite test-prettyprinter

360+ import: commontest

361+ type: exitcode-stdio-1.0

362+ main-is: TutorialD/PrinterTest.hs

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

371

364

372benchmark bench

365benchmark bench

373− Default-Language: Haskell2010

366+ import: commontest

374− Default-Extensions: OverloadedStrings

375 type: exitcode-stdio-1.0

367 type: exitcode-stdio-1.0

376 main-is: benchmark/Relation.hs

368 main-is: benchmark/Relation.hs

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

378− GHC-Options: -Wall -rtsopts

379− Hs-Source-Dirs: ./src/bin

380

369

381Test-Suite test-server

370Test-Suite test-server

382− Default-Language: Haskell2010

371+ import: commontest

383− Default-Extensions: OverloadedStrings

384 type: exitcode-stdio-1.0

372 type: exitcode-stdio-1.0

385− main-is: test/Server/Main.hs

373+ main-is: Server/Main.hs

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

374+

387− HS-Source-Dirs: ., ./src/bin

388− GHC-Options: -Wall

389

375

390Executable Example-SimpleClient

376Executable Example-SimpleClient

391 Default-Language: Haskell2010

377 Default-Language: Haskell2010

392 Default-Extensions: OverloadedStrings

378 Default-Extensions: OverloadedStrings

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

379+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, 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, ghc, ghc-paths, project-m36, random, MonadRandom

394 Main-Is: examples/SimpleClient.hs

380 Main-Is: examples/SimpleClient.hs

395− GHC-Options: -Wall

381+ GHC-Options: -Wall -threaded

396

382

397Executable Example-OutOfTheTarpit

383Executable Example-OutOfTheTarpit

398 Default-Language: Haskell2010

384 Default-Language: Haskell2010

399 Default-Extensions: OverloadedStrings

385 Default-Extensions: OverloadedStrings

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

386+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, 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, aeson, path-pieces, either, conduit, http-api-data, template-haskell, ghc, ghc-paths, project-m36, winery

401 Main-Is: examples/out_of_the_tarpit.hs

387 Main-Is: examples/out_of_the_tarpit.hs

402− GHC-Options: -Wall

388+ GHC-Options: -Wall -threaded

403

389

404Executable Example-Blog

390Executable Example-Blog

405 Default-Language: Haskell2010

391 Default-Language: Haskell2010

406 Default-Extensions: OverloadedStrings

392 Default-Extensions: OverloadedStrings

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

393+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, 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, aeson, path-pieces, either, conduit, http-api-data, template-haskell, ghc, ghc-paths, project-m36, scotty, blaze-html, http-types, winery

408 Main-Is: examples/blog.hs

394 Main-Is: examples/blog.hs

409− GHC-Options: -Wall

395+ GHC-Options: -Wall -threaded

410−

411

396

412Executable Example-Hair

397Executable Example-Hair

413 Default-Language: Haskell2010

398 Default-Language: Haskell2010

414 Default-Extensions: OverloadedStrings

399 Default-Extensions: OverloadedStrings

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

400+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, 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, aeson, path-pieces, either, conduit, http-api-data, template-haskell, ghc, ghc-paths, project-m36, winery

416 Main-Is: examples/hair.hs

401 Main-Is: examples/hair.hs

417− GHC-Options: -Wall

402+ GHC-Options: -Wall -threaded

418

403

419−Test-Suite test-scripts

404+Executable Example-Plantfarm

420 Default-Language: Haskell2010

405 Default-Language: Haskell2010

421 Default-Extensions: OverloadedStrings

406 Default-Extensions: OverloadedStrings

407+ Build-Depends: aeson, barbies, base, binary, containers, deepseq, hashable, project-m36, random, scotty, text, winery

408+ Main-Is: examples/Plantfarm.hs

409+ GHC-Options: -Wall -threaded

410+

411+Executable Example-CustomTupleable

412+ Default-Language: Haskell2010

413+ Default-Extensions: OverloadedStrings

414+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, 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, aeson, path-pieces, either, conduit, http-api-data, template-haskell, ghc, ghc-paths, project-m36, winery

415+ Main-Is: examples/CustomTupleable.hs

416+ GHC-Options: -Wall -threaded

417+

418+Executable Example-DerivingCustomTupleable

419+ if impl(ghc>=8.6)

420+ Buildable: True

421+ else

422+ Buildable: False

423+ Default-Language: Haskell2010

424+ Build-Depends: base, text, deepseq, project-m36, winery

425+ Main-Is: examples/DerivingCustomTupleable.hs

426+ GHC-Options: -Wall -threaded

427+

428+Test-Suite test-scripts

429+ import: commontest

422 type: exitcode-stdio-1.0

430 type: exitcode-stdio-1.0

423− main-is: test/scripts.hs

431+ main-is: scripts.hs

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

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

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

426− GHC-Options: -Wall

427− Hs-Source-Dirs: ., ./src/bin

428

433

429Executable project-m36-websocket-server

434Executable project-m36-websocket-server

430 Default-Language: Haskell2010

435 Default-Language: Haskell2010

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

436+ 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, semigroups, attoparsec, parser-combinators, prettyprinter, network, modern-uri, http-conduit, base16-bytestring, http-types, cryptohash-sha256, wai, wai-websockets, warp, warp-tls

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

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

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

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

434− GHC-Options: -Wall

439+ GHC-Options: -Wall -threaded

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

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

436 Default-Extensions: OverloadedStrings

441 Default-Extensions: OverloadedStrings

437

442

438Test-Suite test-websocket-server

443Test-Suite test-websocket-server

439− Default-Language: Haskell2010

444+ import: commontest

440 type: exitcode-stdio-1.0

445 type: exitcode-stdio-1.0

441− main-is: test/Server/WebSocket.hs

446+ main-is: Server/WebSocket.hs

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

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

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

444− Default-Extensions: OverloadedStrings

445− GHC-Options: -Wall

446− Hs-Source-Dirs: ./src/bin, .

447

448

448Test-Suite test-isomorphic-schemas

449Test-Suite test-isomorphic-schemas

449− Default-Language: Haskell2010

450+ import: commontest

450 type: exitcode-stdio-1.0

451 type: exitcode-stdio-1.0

451− main-is: test/IsomorphicSchema.hs

452+ main-is: IsomorphicSchema.hs

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

453− Default-Extensions: OverloadedStrings

454− GHC-Options: -Wall

455− Hs-Source-Dirs: ./src/bin, .

456

453

457Test-Suite test-atomable

454Test-Suite test-atomable

458− Default-Language: Haskell2010

455+ import: commontest

459 type: exitcode-stdio-1.0

456 type: exitcode-stdio-1.0

460− main-is: test/Relation/Atomable.hs

457+ main-is: Relation/Atomable.hs

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

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

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

463− Default-Extensions: OverloadedStrings

464− GHC-Options: -Wall

465− Hs-Source-Dirs: ./src/bin, ., test/

466

459

467Test-Suite test-multiprocess-access

460Test-Suite test-multiprocess-access

468− Default-Language: Haskell2010

461+ import: commontest

469 type: exitcode-stdio-1.0

462 type: exitcode-stdio-1.0

470− main-is: test/MultiProcessDatabaseAccess.hs

463+ main-is: MultiProcessDatabaseAccess.hs

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

472− Default-Extensions: OverloadedStrings

473− GHC-Options: -Wall

474− Hs-Source-Dirs: ./src/bin, ., test/

475

464

476Test-Suite test-transactiongraph-automerge

465Test-Suite test-transactiongraph-automerge

477− Default-Language: Haskell2010

466+ import: commontest

478 type: exitcode-stdio-1.0

467 type: exitcode-stdio-1.0

479− main-is: test/TransactionGraph/Automerge.hs

468+ main-is: TransactionGraph/Automerge.hs

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

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

481− Default-Extensions: OverloadedStrings

482− GHC-Options: -Wall

483− Hs-Source-Dirs: ./src/bin, ., test/

484

470

485Test-Suite test-tupleable

471Test-Suite test-tupleable

486− Default-Language: Haskell2010

472+ import: commontest

487 type: exitcode-stdio-1.0

473 type: exitcode-stdio-1.0

488− main-is: test/Relation/Tupleable.hs

474+ main-is: Relation/Tupleable.hs

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

490− Default-Extensions: OverloadedStrings

491− GHC-Options: -Wall

492− Hs-Source-Dirs: ./src/bin, ., test/

493

475

494Test-Suite test-client-simple

476Test-Suite test-client-simple

495− Default-Language: Haskell2010

477+ import: commontest

496− Main-Is: test/Client/Simple.hs

478+ Main-Is: Client/Simple.hs

497 type: exitcode-stdio-1.0

479 type: exitcode-stdio-1.0

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

499− Default-Extensions: OverloadedStrings

500− GHC-Options: -Wall

501− Hs-Source-Dirs: ./src/bin, ., test/

502

480

503-- test for file handle leaks

481-- test for file handle leaks

504Executable handles

482Executable handles

505 Default-Language: Haskell2010

483 Default-Language: Haskell2010

506 Default-Extensions: OverloadedStrings

484 Default-Extensions: OverloadedStrings

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

485+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, 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, modern-uri, http-types, http-conduit, base16-bytestring, cryptohash-sha256

508 main-is: benchmark/Handles.hs

486 main-is: benchmark/Handles.hs

509 Other-Modules: TutorialD.Interpreter,

487 Other-Modules: TutorialD.Interpreter,

510 TutorialD.Interpreter.Base,

488 TutorialD.Interpreter.Base,

@@ -523,9 +501,14 @@ Executable handles

523 TutorialD.Interpreter.TransGraphRelationalOperator,

501 TutorialD.Interpreter.TransGraphRelationalOperator,

524 TutorialD.Interpreter.TransactionGraphOperator,

502 TutorialD.Interpreter.TransactionGraphOperator,

525 TutorialD.Interpreter.Types

503 TutorialD.Interpreter.Types

504+ TutorialD.Printer

526 GHC-Options: -Wall -threaded -rtsopts

505 GHC-Options: -Wall -threaded -rtsopts

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

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

528 if flag(profiler)

507 if flag(profiler)

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

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

530−

509+

531−

510+Test-Suite test-dataframe

511+ import: commontest

512+ type: exitcode-stdio-1.0

513+ Main-Is: DataFrame.hs

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

release.nixnew file+36

@@ -0,0 +1,36 @@

1+{ compiler ? "ghc8104"

2+, sources ? import ./nix/sources.nix

3+, pkgs ? import sources.nixpkgs { }

4+}:

5+let

6+ doJailbreak = pkgs.haskell.lib.doJailbreak;

7+ needsCocoa = drv:

8+ if pkgs.stdenv.isDarwin

9+ then drv.overrideDerivation (old:

10+ { buildInputs = [ pkgs.darwin.apple_sdk.frameworks.Cocoa ] ++ old.buildInputs; }

11+ )

12+ else drv;

13+

14+ haskellPackages = pkgs.haskell.packages.${compiler}.override {

15+ overrides = self: super: {

16+ curryer-rpc = self.callCabal2nix "curryer-rpc" sources.curryer { };

17+ streamly = doJailbreak (needsCocoa (self.callCabal2nix "streamly" sources.streamly { }));

18+ project-m36 = ((self.callCabal2nixWithOptions "project-m36" ./. "-f-haskell-scripting" { }));

19+ };

20+ };

21+in

22+{

23+ project = haskellPackages.project-m36;

24+

25+ shell = haskellPackages.shellFor {

26+ packages = p: [

27+ p.project-m36

28+ ];

29+ buildInputs = [

30+ haskellPackages.ghcid

31+ haskellPackages.hlint

32+ pkgs.docker

33+ ];

34+ withHoogle = true;

35+ };

36+}

runghcid.sh+1−1

@@ -1,2 +1,2 @@

1#!/bin/sh

2−./.cabal-sandbox/bin/ghcid --command="cabal repl $1"

2+~/.cabal/bin/ghcid --command="cabal new-repl $1"

scripts/DateExamples.tutd+4−2

@@ -20,5 +20,7 @@ sp := relation{tuple{s# "S1",p# "P1",qty 300},

20 tuple{s# "S3",p# "P2",qty 200},

21 tuple{s# "S4",p# "P4",qty 300},

22 tuple{s# "S4",p# "P5",qty 400}};

23+key s_pkey {s#} s;

24+key p_key {p#} p;

23−foreign key sp2s sp{s#} in s{s#};

25+foreign key s_sp_fk sp{s#} in s{s#};

24−foreign key sp2p sp{p#} in p{p#};

26+foreign key p_sp_fk sp{p#} in p{p#};

scripts/multiline.tutdnew file+2

@@ -0,0 +1,2 @@

1+x:=relation{

2+tuple{ x 2}} -- nice

shell.nixnew file+1

@@ -0,0 +1 @@

1+(import ./release.nix { }).shell

src/bin/ProjectM36/Client/Json.hs+4−1

@@ -3,6 +3,7 @@ module ProjectM36.Client.Json where

3import Data.Aeson

4import ProjectM36.Server.RemoteCallTypes.Json ()

5import ProjectM36.Client

6+import ProjectM36.TransactionGraph

6import Control.Exception (IOException)

7import Control.Exception (IOException)

8instance ToJSON EvaluatedNotification

9instance ToJSON EvaluatedNotification

@@ -11,4 +12,6 @@ instance FromJSON EvaluatedNotification

11instance ToJSON ConnectionError

12instance ToJSON ConnectionError

13instance ToJSON IOException where

14instance ToJSON IOException where

14− toJSON err = object ["IOException" .= show err]

15+ toJSON err = object ["IOException" .= show err]

16+

17+instance ToJSON MerkleValidationError

src/bin/ProjectM36/Server/RemoteCallTypes/Json.hs+51−21

@@ -1,14 +1,17 @@

1--create a bunch of orphan instances for use with the websocket server

2−{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

2+{-# LANGUAGE FlexibleInstances #-}

3{-# OPTIONS_GHC -fno-warn-orphans #-}

4module ProjectM36.Server.RemoteCallTypes.Json where

5import ProjectM36.AtomFunctionError

6import ProjectM36.Base

7+import ProjectM36.DataFrame

7import ProjectM36.DatabaseContextFunctionError

8import ProjectM36.DatabaseContextFunctionError

8import ProjectM36.DataTypes.Primitive

9import ProjectM36.DataTypes.Primitive

9import ProjectM36.Error

10import ProjectM36.Error

10import ProjectM36.IsomorphicSchema

11import ProjectM36.IsomorphicSchema

11import ProjectM36.Server.RemoteCallTypes

12import ProjectM36.Server.RemoteCallTypes

13+import ProjectM36.MerkleHash

14+import ProjectM36.Attribute as A

13import Data.Aeson

16import Data.Aeson

14import Data.ByteString.Base64 as B64

17import Data.ByteString.Base64 as B64

@@ -21,6 +24,9 @@ instance FromJSON RelationalExpr

21instance ToJSON TupleExpr

24instance ToJSON TupleExpr

22instance FromJSON TupleExpr

25instance FromJSON TupleExpr

27+instance ToJSON TupleExprs

28+instance FromJSON TupleExprs

29+

24instance ToJSON RestrictionPredicateExpr

30instance ToJSON RestrictionPredicateExpr

25instance FromJSON RestrictionPredicateExpr

31instance FromJSON RestrictionPredicateExpr

@@ -39,8 +45,11 @@ instance FromJSON ExecuteRelationalExpr

39instance ToJSON Relation

45instance ToJSON Relation

40instance FromJSON Relation

46instance FromJSON Relation

42−instance ToJSON Attribute

48+instance ToJSON Attribute where

49+ toJSON (Attribute attrName aType) = object [ "name" .= attrName

50+ , "type" .= toJSON aType ]

43−instance FromJSON Attribute

51+instance FromJSON Attribute where

52+ parseJSON = withObject "Attribute" $ \v -> Attribute <$> v .: "name" <*> v .: "type"

45instance ToJSON ExtendTupleExpr

54instance ToJSON ExtendTupleExpr

46instance FromJSON ExtendTupleExpr

55instance FromJSON ExtendTupleExpr

@@ -63,6 +72,18 @@ instance FromJSON SchemaExpr

63instance ToJSON SchemaIsomorph

72instance ToJSON SchemaIsomorph

64instance FromJSON SchemaIsomorph

73instance FromJSON SchemaIsomorph

75+instance ToJSON DataFrame

76+instance FromJSON DataFrame

77+

78+instance ToJSON DataFrameTuple

79+instance FromJSON DataFrameTuple

80+

81+instance ToJSON AttributeOrder

82+instance FromJSON AttributeOrder

83+

84+instance ToJSON Order

85+instance FromJSON Order

86+

66instance ToJSON Atom where

87instance ToJSON Atom where

67 toJSON atom@(IntegerAtom i) = object [ "type" .= atomTypeForAtom atom,

88 toJSON atom@(IntegerAtom i) = object [ "type" .= atomTypeForAtom atom,

68 "val" .= i ]

89 "val" .= i ]

@@ -80,17 +101,10 @@ instance ToJSON Atom where

80 "val" .= decodeUtf8 (B64.encode i) ]

101 "val" .= decodeUtf8 (B64.encode i) ]

81 toJSON atom@(BoolAtom i) = object [ "type" .= atomTypeForAtom atom,

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

82 "val" .= i ]

103 "val" .= i ]

83−

84− toJSON atom@(IntervalAtom b e i1 i2) = object [ "type" .= atomTypeForAtom atom,

85− "val" .= object [

86− "begin" .= toJSON b,

87− "end" .= toJSON e,

88− "beginopen" .= i1,

89− "endopen" .= i2

90− ]

91− ]

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

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

93 "val" .= i ]

105 "val" .= i ]

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

107+ "val" .= i ]

94 toJSON (ConstructedAtom dConsName atomtype atomlist) = object [

108 toJSON (ConstructedAtom dConsName atomtype atomlist) = object [

95 "dataconstructorname" .= dConsName,

109 "dataconstructorname" .= dConsName,

96 "type" .= toJSON atomtype,

110 "type" .= toJSON atomtype,

@@ -103,9 +117,7 @@ instance FromJSON Atom where

103 case atype of

117 case atype of

104 TypeVariableType _ -> fail "cannot pass TypeVariableType over the wire"

118 TypeVariableType _ -> fail "cannot pass TypeVariableType over the wire"

105 caType@(ConstructedAtomType _ _) -> ConstructedAtom <$> o .: "dataconstructorname" <*> pure caType <*> o .: "atom"

119 caType@(ConstructedAtomType _ _) -> ConstructedAtom <$> o .: "dataconstructorname" <*> pure caType <*> o .: "atom"

106− RelationAtomType _ -> do

120+ RelationAtomType _ -> RelationAtom <$> o .: "val"

107− rel <- o .: "val"

108− pure $ RelationAtom rel

109 IntAtomType -> IntAtom <$> o .: "val"

121 IntAtomType -> IntAtom <$> o .: "val"

110 IntegerAtomType -> IntegerAtom <$> o .: "val"

122 IntegerAtomType -> IntegerAtom <$> o .: "val"

111 DoubleAtomType -> DoubleAtom <$> o .: "val"

123 DoubleAtomType -> DoubleAtom <$> o .: "val"

@@ -120,12 +132,7 @@ instance FromJSON Atom where

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

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

121 Right bs -> pure (ByteStringAtom bs)

133 Right bs -> pure (ByteStringAtom bs)

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

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

123− IntervalAtomType _ -> IntervalAtom <$>

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

124− ((o .: "val") >>= (.: "begin")) <*>

125− ((o .: "val") >>= (.: "end")) <*>

126− ((o .: "val") >>= (.: "beginopen")) <*>

127− ((o .: "val") >>= (.: "endopen"))

128−

129

136

130instance ToJSON Notification

137instance ToJSON Notification

131instance FromJSON Notification

138instance FromJSON Notification

@@ -133,6 +140,21 @@ instance FromJSON Notification

133instance ToJSON ScriptCompilationError

140instance ToJSON ScriptCompilationError

134instance FromJSON ScriptCompilationError

141instance FromJSON ScriptCompilationError

135

142

143+instance ToJSON MerkleHash where

144+ toJSON h = object [ "merklehash" .= decodeUtf8 (B64.encode (_unMerkleHash h))]

145+instance FromJSON MerkleHash where

146+ parseJSON = withObject "merklehash" $ \o -> do

147+ b64bs <- encodeUtf8 <$> o .: "merklehash"

148+ case B64.decode b64bs of

149+ Left err -> fail ("Failed to parse merkle hash: " ++ err)

150+ Right bs -> pure (MerkleHash bs)

151+

152+instance ToJSON Attributes where

153+ toJSON attrs = object ["attributes" .= map toJSON (A.toList attrs)]

154+instance FromJSON Attributes where

155+ parseJSON = withObject "Attributes" $ \o ->

156+ A.attributesFromList <$> o .: "attributes"

157+

136instance ToJSON RelationalError

158instance ToJSON RelationalError

137instance FromJSON RelationalError

159instance FromJSON RelationalError

138

160

@@ -142,6 +164,9 @@ instance FromJSON SchemaError

142instance ToJSON MergeError

164instance ToJSON MergeError

143instance FromJSON MergeError

165instance FromJSON MergeError

144

166

167+instance ToJSON ImportError'

168+instance FromJSON ImportError'

169+

145instance ToJSON DatabaseContextFunctionError

170instance ToJSON DatabaseContextFunctionError

146instance FromJSON DatabaseContextFunctionError

171instance FromJSON DatabaseContextFunctionError

147

172

@@ -153,3 +178,8 @@ instance FromJSON PersistenceError

153

178

154instance ToJSON AtomFunctionError

179instance ToJSON AtomFunctionError

155instance FromJSON AtomFunctionError

180instance FromJSON AtomFunctionError

181+

182+instance ToJSON WithNameExpr

183+instance FromJSON WithNameExpr

184+

185+

src/bin/ProjectM36/Server/WebSocket.hs+86−34

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

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

1module ProjectM36.Server.WebSocket where

2module ProjectM36.Server.WebSocket where

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

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

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

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

@@ -9,14 +10,26 @@ import qualified Data.Text as T

9import qualified Network.WebSockets as WS

10import qualified Network.WebSockets as WS

10import ProjectM36.Server.RemoteCallTypes.Json ()

11import ProjectM36.Server.RemoteCallTypes.Json ()

11import ProjectM36.Client.Json ()

12import ProjectM36.Client.Json ()

13+import ProjectM36.DataFrame

14+import ProjectM36.Relation.Show.Term

15+import ProjectM36.Relation.Show.HTML

12import Data.Aeson

16import Data.Aeson

13import TutorialD.Interpreter

17import TutorialD.Interpreter

14−import TutorialD.Interpreter.Base

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

15import ProjectM36.Client

19import ProjectM36.Client

16import Control.Exception

20import Control.Exception

21+import Data.Attoparsec.Text

22+import Control.Applicative

23+import Text.Megaparsec.Error

24+import Data.Functor

25+import Data.Either (fromRight)

26+

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

28+import Data.List.NonEmpty as NE

29+#endif

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

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

19−websocketProxyServer port host pending = do

32+websocketProxyServer port host pending = do

20 conn <- WS.acceptRequest pending

33 conn <- WS.acceptRequest pending

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

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

22 --phase 1- accept database name for connection

35 --phase 1- accept database name for connection

@@ -25,11 +38,10 @@ websocketProxyServer port host pending = do

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

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

26 else do

39 else do

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

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

28− bracket (createConnection conn dbname port host)

41+ bracket (createConnection conn dbname port host)

29− (\eDBconn -> case eDBconn of

42+ (\case

30− Right dbconn -> close dbconn

43+ Right dbconn -> close dbconn

31− Left _ -> pure ()) $ \eDBconn ->

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

32− case eDBconn of

33 Left err -> sendError conn err

45 Left err -> sendError conn err

34 Right dbconn -> do

46 Right dbconn -> do

35 eSessionId <- createSessionAtHead dbconn "master"

47 eSessionId <- createSessionAtHead dbconn "master"

@@ -40,55 +52,95 @@ websocketProxyServer port host pending = do

40 _ <- forever $ do

52 _ <- forever $ do

41 pInfo <- promptInfo sessionId dbconn

53 pInfo <- promptInfo sessionId dbconn

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

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

43− sendPromptInfo pInfo conn

55+ sendPromptInfo pInfo conn

44 sendPromptInfo pInfo conn

56 sendPromptInfo pInfo conn

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

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

46− let tutdprefix = "executetutd:"

58+ case parseOnly parseExecuteMessage msg of

47− case msg of

59+ Left _ -> unexpectedMsg

48− _ | tutdprefix `T.isPrefixOf` msg -> do

60+ Right (presentation, tutdString) ->

49− let tutdString = T.drop (T.length tutdprefix) msg

50 case parseTutorialD tutdString of

61 case parseTutorialD tutdString of

62+ Left err -> handleOpResult conn dbconn presentation

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

64+ (DisplayErrorResult

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

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

67+#else

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

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

69+#endif

52 Right parsed -> do

70 Right parsed -> do

53− let timeoutFilter exc = if exc == RequestTimeoutException

71+ let timeoutFilter exc = if exc == RequestTimeoutException

54− then Just exc

72+ then Just exc

55 else Nothing

73 else Nothing

56 responseHandler = do

74 responseHandler = do

57 result <- evalTutorialD sessionId dbconn SafeEvaluation parsed

75 result <- evalTutorialD sessionId dbconn SafeEvaluation parsed

58 pInfo' <- promptInfo sessionId dbconn

76 pInfo' <- promptInfo sessionId dbconn

59− sendPromptInfo pInfo' conn

77+ sendPromptInfo pInfo' conn

60− handleOpResult conn dbconn result

78+ handleOpResult conn dbconn presentation result

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

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

62− _ -> unexpectedMsg

63 pure ()

80 pure ()

64−

81+

65−notificationCallback :: WS.Connection -> NotificationCallback

82+notificationCallback :: WS.Connection -> NotificationCallback

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

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

67 "evaldnotification" .= evaldNotif

84 "evaldnotification" .= evaldNotif

68 ]))

85 ]))

69−

86+

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

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

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

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

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

89+createConnection wsconn dbname port host = connectProjectM36 (RemoteConnectionInfo dbname host (show port) (notificationCallback wsconn))

74sendError :: (ToJSON a) => WS.Connection -> a -> IO ()

91sendError :: (ToJSON a) => WS.Connection -> a -> IO ()

75sendError conn err = WS.sendTextData conn (encode (object ["displayerror" .= err]))

92sendError conn err = WS.sendTextData conn (encode (object ["displayerror" .= err]))

77−handleOpResult :: WS.Connection -> Connection -> TutorialDOperatorResult -> IO ()

94+handleOpResult :: WS.Connection -> Connection -> Presentation -> TutorialDOperatorResult -> IO ()

78−handleOpResult conn db QuitResult = WS.sendClose conn ("close" :: T.Text) >> close db

95+handleOpResult conn db _ QuitResult = WS.sendClose conn ("close" :: T.Text) >> close db

79−handleOpResult conn _ (DisplayResult out) = WS.sendTextData conn (encode (object ["display" .= out]))

96+handleOpResult conn _ _ (DisplayResult out) = WS.sendTextData conn (encode (object ["display" .= out]))

80−handleOpResult _ _ (DisplayIOResult ioout) = ioout

97+handleOpResult _ _ _ (DisplayIOResult ioout) = ioout

81−handleOpResult conn _ (DisplayErrorResult err) = WS.sendTextData conn (encode (object ["displayerror" .= err]))

98+handleOpResult conn _ presentation (DisplayErrorResult err) = do

99+ let jsono = ["json" .= err | jsonPresentation presentation]

100+ texto = ["text" .= err | textPresentation presentation]

101+ htmlo = ["html" .= err | htmlPresentation presentation]

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

82−handleOpResult conn _ (DisplayParseErrorResult _ err) = WS.sendTextData conn (encode (object ["displayparseerrorresult" .= show err]))

103+handleOpResult conn _ _ (DisplayParseErrorResult _ err) = WS.sendTextData conn (encode (object ["displayparseerrorresult" .= show err]))

83−handleOpResult conn _ QuietSuccessResult = WS.sendTextData conn (encode (object ["acknowledged" .= True]))

104+handleOpResult conn _ _ QuietSuccessResult = WS.sendTextData conn (encode (object ["acknowledged" .= True]))

84−handleOpResult conn _ (DisplayRelationResult rel) = WS.sendTextData conn (encode (object ["displayrelation" .= rel]))

105+handleOpResult conn _ presentation (DisplayRelationResult rel) = do

106+ let jsono = ["json" .= rel | jsonPresentation presentation]

107+ texto = ["text" .= showRelation rel | textPresentation presentation]

108+ htmlo = ["html" .= relationAsHTML rel | htmlPresentation presentation]

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

110+handleOpResult conn _ presentation (DisplayDataFrameResult df) = do

111+ let jsono = ["json" .= df | jsonPresentation presentation]

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

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

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

115

86-- get current schema and head name for client

116-- get current schema and head name for client

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

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

88promptInfo sessionId conn = do

118promptInfo sessionId conn = do

89− eHeadName <- headName sessionId conn

119+ eHeadName <- headName sessionId conn

90 eSchemaName <- currentSchemaName sessionId conn

120 eSchemaName <- currentSchemaName sessionId conn

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

121+ pure (fromRight "<unknown>" eHeadName, fromRight "<no schema>" eSchemaName)

92−

122+

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

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

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

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

125+

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

127+data Presentation = Presentation {

128+ jsonPresentation :: Bool,

129+ textPresentation :: Bool,

130+ htmlPresentation :: Bool }

131+

132+data PresentationFlag = JSONFlag | TextFlag | HTMLFlag

133+

134+parseExecuteMessage :: Parser (Presentation, T.Text)

135+parseExecuteMessage = do

136+ _ <- string "executetutd/"

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

138+ (string "text" $> TextFlag) <|>

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

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

141+ JSONFlag -> acc {jsonPresentation = True}

142+ TextFlag -> acc {textPresentation = True}

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

144+ _ <- char ':'

145+ tutd <- T.pack <$> manyTill anyChar endOfInput

146+ pure (presentation, tutd)

src/bin/ProjectM36/Server/WebSocket/project-m36.js+46−7

@@ -55,9 +55,10 @@ var ProjectM36Connection = function (protocol, host, port, path, dbname, openCal

55* @param {Object} acknowledgementresult - The status update containing an acknowledgement that the query was executed or null.

56* @param {Object} errorResult - The status update containing the error information or null.

57*/

58−var ProjectM36Status = function (relationResult, acknowledgementResult, errorResult)

58+var ProjectM36Status = function (relationResult, dataFrameResult, acknowledgementResult, errorResult)

59{

60 this.relation = relationResult;

61+ this.dataframe = dataFrameResult;

61 this.acknowledgement = acknowledgementResult;

62 this.acknowledgement = acknowledgementResult;

62 this.error = errorResult;

63 this.error = errorResult;

63}

64}

@@ -75,6 +76,7 @@ ProjectM36Connection.prototype.readyState = function()

75ProjectM36Connection.prototype.handleResponse = function(message)

76ProjectM36Connection.prototype.handleResponse = function(message)

76{

77{

77 var relation = message["displayrelation"];

78 var relation = message["displayrelation"];

79+ var dataframe = message["displaydataframe"];

78 var acknowledged = message["acknowledged"];

80 var acknowledged = message["acknowledged"];

79 var error = message["displayerror"];

81 var error = message["displayerror"];

80 var prompt = message["promptInfo"];

82 var prompt = message["promptInfo"];

@@ -82,12 +84,17 @@ ProjectM36Connection.prototype.handleResponse = function(message)

83 if(relation)

85 if(relation)

84 {

86 {

85− this.statuscallback(new ProjectM36Status(relation, null, null));

87+ this.statuscallback(new ProjectM36Status(relation['json'], null, null, null));

88+ }

89+

90+ if(dataframe)

91+ {

92+ this.statuscallback(new ProjectM36Status(null, dataframe['json'], null, null));

86 }

93 }

88 if(acknowledged)

95 if(acknowledged)

89 {

96 {

90− this.statuscallback(new ProjectM36Status(null, true, null));

97+ this.statuscallback(new ProjectM36Status(null, null, true, null));

91 }

98 }

93 if(error)

100 if(error)

@@ -96,7 +103,7 @@ ProjectM36Connection.prototype.handleResponse = function(message)

96 {

103 {

97 error=error.tag; // for error objects

104 error=error.tag; // for error objects

98 }

105 }

99− this.statuscallback(new ProjectM36Status(null, null, error));

106+ this.statuscallback(new ProjectM36Status(null, null, null, error['json']));

100 }

107 }

101

108

102 if(prompt)

109 if(prompt)

@@ -117,7 +124,7 @@ ProjectM36Connection.prototype.handleResponse = function(message)

117*/

124*/

118ProjectM36Connection.prototype.executeTutorialD = function(tutd)

125ProjectM36Connection.prototype.executeTutorialD = function(tutd)

119{

126{

120− this.socket.send("executetutd:" + tutd);

127+ this.socket.send("executetutd/json:" + tutd);

121}

128}

122

129

123/**

130/**

@@ -161,6 +168,7 @@ ProjectM36Connection.prototype.generateAtomType = function(attr)

161{

168{

162 var atomType = attr[1]["tag"];

169 var atomType = attr[1]["tag"];

163 var attrName = attr[0];

170 var attrName = attr[0];

171+ var accessory = attr[2];

164 var element = document.createElement("span");

172 var element = document.createElement("span");

165 element.textContent = attrName + "::";

173 element.textContent = attrName + "::";

166 if (atomType == "RelationAtomType")

174 if (atomType == "RelationAtomType")

@@ -185,7 +193,11 @@ ProjectM36Connection.prototype.generateAtomType = function(attr)

185 var readableType = atomType.slice(0,-8);

193 var readableType = atomType.slice(0,-8);

186 element.textContent += readableType;

194 element.textContent += readableType;

187 }

195 }

196+ if(accessory)

197+ {

198+ element.textContent += accessory;

199+ }

188− return element

200+ return element;

189}

201}

190

202

191ProjectM36Connection.prototype.generateRelationBody = function (body)

203ProjectM36Connection.prototype.generateRelationBody = function (body)

@@ -230,6 +242,33 @@ ProjectM36Connection.prototype.generateAtom = function(atom)

230 return element;

242 return element;

231}

243}

232

244

245+ProjectM36Connection.prototype.generateDataFrame = function(dataframe)

246+{

247+ for(var attrIndex=0; attrIndex < dataframe.attributes.length; attrIndex++)

248+ {

249+ var attr = dataframe.attributes[attrIndex];

250+ var ordering = "↕";

251+ for(var orderIndex=0; orderIndex < dataframe.orders.length; orderIndex++)

252+ {

253+ var order = dataframe.orders[orderIndex];

254+ if(order[0] == attr[0])

255+ {

256+ if(order[1] == "AscendingOrder")

257+ {

258+ ordering = "⬆";

259+ }

260+ else if(order[1] == "DescendingOrder")

261+ {

262+ ordering = "⬇";

263+ }

264+ }

265+ }

266+ dataframe.attributes[attrIndex].push(ordering);

267+ }

268+ return this.generateRelation([dataframe.attributes,

269+ {asList:dataframe.tuples}]);

270+}

271+

233//special case to make sure that a table appears for "true" and "false"

272//special case to make sure that a table appears for "true" and "false"

234function mungeEmptyRows()

273function mungeEmptyRows()

235{

274{

@@ -249,4 +288,4 @@ function mungeEmptyRows()

249 empty.appendChild(dudHeader);

288 empty.appendChild(dudHeader);

250 }

289 }

251 }

290 }

252−}

291+}

src/bin/ProjectM36/Server/WebSocket/websocket-client.html+2−2

@@ -108,7 +108,7 @@ margin-bottom: 5pt;

108 <option value="ws">ws://</option>

109 </select>

110 <input type="text" name="host" value="localhost" placeholder="Host"/>:

111− <input id="port" type="number" placeholder="Port" name="port" min="0" max="32767" value="8888"/>/

111+ <input id="port" type="number" placeholder="Port" name="port" min="0" max="65535" value="8888"/>/

112 <input type="text" name="path" placeholder="path" value=""/>

113 <label>database:</label><input type="text" placeholder="Database Name" name="dbname" value="test"/>

114 <input type="submit" name="connect" value="Connect"/>

@@ -126,7 +126,7 @@ margin-bottom: 5pt;

126 <li>:showrelvars</li>

127 <li>:showexpr true</li>

128 <li>:showexpr false</li>

129− <li>:importexample date</li>

129+ <li>:importexample cjdate</li>

130 <li>:showexpr s join sp</li>

131 <li>update s where city="Paris" (status:=10)</li>

132 <li>:showexpr s</li>

src/bin/ProjectM36/Server/WebSocket/websocket-client.js+7−1

@@ -30,6 +30,12 @@ function updateStatus(status)

30 appendResult(tutd, relastable);

31 mungeEmptyRows();

32 }

33+ if(status.dataframe)

34+ {

35+ var dataframeastable = conn.generateDataFrame(status.dataframe);

36+ appendResult(tutd, dataframeastable);

37+ mungeEmptyRows();

38+ }

33 if(status.acknowledgement)

39 if(status.acknowledgement)

34 {

40 {

35 var ok = document.createElement("span");

41 var ok = document.createElement("span");

@@ -253,4 +259,4 @@ function pageload()

253{

259{

254 installSampleHandlers();

260 installSampleHandlers();

255 setupDefaultConfig();

261 setupDefaultConfig();

256−}

262+}

src/bin/ProjectM36/Server/WebSocket/websocket-server.hs+49−12

@@ -1,26 +1,63 @@

1−import ProjectM36.Server.WebSocket

1+{-# LANGUAGE CPP #-}

2−import ProjectM36.Server.Config

3−import ProjectM36.Server.ParseArgs

4−import ProjectM36.Server

5import Control.Concurrent

3import Control.Concurrent

6−import qualified Network.WebSockets as WS

7−import Network.Transport.TCP (decodeEndPointAddress)

8import Control.Exception

4import Control.Exception

5+import Control.Monad (when)

6+import Data.Maybe (isJust)

7+import Data.String (fromString)

8+import Network.HTTP.Types (status400)

9+import Network.Socket

10+import Network.Wai (Application, responseLBS)

11+import Network.Wai.Handler.Warp

12+import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)

13+import qualified Network.Wai.Handler.WebSockets as WS

14+import Network.WebSockets (defaultConnectionOptions)

15+import ProjectM36.Server

16+import ProjectM36.Server.Config

17+import ProjectM36.Server.ParseArgs

18+import ProjectM36.Server.WebSocket

10main :: IO ()

20main :: IO ()

11main = do

21main = do

12 -- launch normal project-m36-server

22 -- launch normal project-m36-server

13 addressMVar <- newEmptyMVar

23 addressMVar <- newEmptyMVar

14− serverConfig <- parseConfigWithDefaults (defaultServerConfig { bindPort = 8000, bindHost = "127.0.0.1" })

24+ wsConfig <- parseWSConfigWithDefaults (defaultServerConfig {bindPort = 8000, bindHost = "127.0.0.1"})

25+

15 --usurp the serverConfig for our websocket server and make the proxied server run locally

26 --usurp the serverConfig for our websocket server and make the proxied server run locally

27+ let serverConfig = wsServerConfig wsConfig

16− let wsHost = bindHost serverConfig

28+ wsHost = bindHost serverConfig

17 wsPort = bindPort serverConfig

29 wsPort = bindPort serverConfig

18 serverHost = "127.0.0.1"

30 serverHost = "127.0.0.1"

19 serverConfig' = serverConfig {bindPort = 0, bindHost = serverHost}

31 serverConfig' = serverConfig {bindPort = 0, bindHost = serverHost}

32+ configCertificateFile = tlsCertificatePath wsConfig

33+ configKeyFile = tlsKeyPath wsConfig

34+

35+ when (isJust configCertificateFile /= isJust configKeyFile) $

36+ throwIO $ ErrorCall "TLS_CERTIFICATE_PATH and TLS_KEY_PATH must be set in tandem"

37+

20 _ <- forkFinally (launchServer serverConfig' (Just addressMVar) >> pure ()) (either throwIO pure)

38 _ <- forkFinally (launchServer serverConfig' (Just addressMVar) >> pure ()) (either throwIO pure)

21 --wait for server to be listening

39 --wait for server to be listening

22− address <- takeMVar addressMVar

40+ addr <- takeMVar addressMVar

23− let Just (_, serverPort, _) = decodeEndPointAddress address

41+ let port =

24− --this built-in server is apparently not meant for production use, but it's easier to test than starting up the wai or snap interfaces

42+ case addr of

25− WS.runServer wsHost (fromIntegral wsPort) (websocketProxyServer (read serverPort) serverHost)

43+ SockAddrInet port' _ -> fromIntegral port'

44+ _ -> error "unsupported socket address (IPv4 only currently)"

45+ wsApp = websocketProxyServer port serverHost

46+ waiApp = WS.websocketsOr defaultConnectionOptions wsApp backupApp

47+ settings = warpSettings wsHost (fromIntegral wsPort)

48+

49+ case (configCertificateFile, configKeyFile) of

50+ (Just certificate, Just key) -> runTLS (tlsSettings certificate key) settings waiApp

51+ _ -> runSettings settings waiApp

52+

53+backupApp :: Application

54+backupApp _ respond = respond $ responseLBS status400 [] "Not a WebSocket request"

56+warpSettings :: HostName -> Port -> Settings

57+warpSettings host port =

58+ setHost (fromString host)

59+ . setPort port

60+ . setServerName "project-m36"

61+ . setTimeout 3600

62+ . setGracefulShutdownTimeout (Just 5)

63+ $ defaultSettings

src/bin/TutorialD/Interpreter.hs+35−33

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

1−{-# LANGUAGE GADTs #-}

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

2module TutorialD.Interpreter where

3import TutorialD.Interpreter.Base

4import TutorialD.Interpreter.RODatabaseContextOperator

@@ -24,16 +24,17 @@ import ProjectM36.TransactionGraph

24import qualified ProjectM36.Client as C

25import ProjectM36.Relation (attributes)

27−import Text.Megaparsec

28−import Text.Megaparsec.Text

29import System.Console.Haskeline

27import System.Console.Haskeline

30import System.Directory (getHomeDirectory)

28import System.Directory (getHomeDirectory)

31import qualified Data.Text as T

29import qualified Data.Text as T

32import System.IO (hPutStrLn, stderr)

30import System.IO (hPutStrLn, stderr)

31+#if __GLASGOW_HASKELL__ < 804

33import Data.Monoid

32import Data.Monoid

33+#endif

34import Data.List (isPrefixOf)

35import Control.Exception

36import System.Exit

37+import Data.Either (fromRight)

38{-

39{-

39context ops are read-only operations which only operate on the database context (relvars and constraints)

40context ops are read-only operations which only operate on the database context (relvars and constraints)

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

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

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

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

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

63 fmap DatabaseContextIOExprOp (dbContextIOExprP <* eof)

64 fmap DatabaseContextIOExprOp (dbContextIOExprP <* eof)

64−

65+

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

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

66safeInterpreterParserP :: Parser ParsedOperation

67safeInterpreterParserP :: Parser ParsedOperation

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

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

@@ -77,13 +78,13 @@ safeInterpreterParserP = fmap RODatabaseContextOp (roDatabaseContextOperatorP <*

77promptText :: Either RelationalError HeadName -> Either RelationalError SchemaName -> StringType

78promptText :: Either RelationalError HeadName -> Either RelationalError SchemaName -> StringType

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

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

79 where

80 where

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

81+ transInfo = fromRight "<unknown>" eHeadName <> "/" <> fromRight "<no schema>" eSchemaName

81−

82+

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

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

83parseTutorialD = parse interpreterParserP ""

84parseTutorialD = parse interpreterParserP ""

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

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

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

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

87safeParseTutorialD = parse safeInterpreterParserP ""

88safeParseTutorialD = parse safeInterpreterParserP ""

89data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)

90data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)

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

106 else

107 else

107 pure res

108 pure res

108 _ -> pure res

109 _ -> pure res

109−

110+

110− (DatabaseContextExprOp execOp) ->

111+ (DatabaseContextExprOp execOp) ->

111− eHandler $ C.executeDatabaseContextExpr sessionId conn execOp

112+ eHandler $ C.executeDatabaseContextExpr sessionId conn execOp

112−

113+

113− (DatabaseContextIOExprOp execOp) ->

114+ (DatabaseContextIOExprOp execOp) ->

114 if needsSafe then

115 if needsSafe then

115 unsafeError

116 unsafeError

116 else

117 else

117 eHandler $ C.executeDatabaseContextIOExpr sessionId conn execOp

118 eHandler $ C.executeDatabaseContextIOExpr sessionId conn execOp

118−

119+

119 (GraphOp execOp) -> do

120 (GraphOp execOp) -> do

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

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

121 eIsDirty <- C.disconnectedTransactionIsDirty sessionId conn

122 eIsDirty <- C.disconnectedTransactionIsDirty sessionId conn

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

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

123 settings = Settings {complete = noCompletion,

124 settings = Settings {complete = noCompletion,

124 historyFile = Nothing,

125 historyFile = Nothing,

125 autoAddHistory = False}

126 autoAddHistory = False}

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

143 pure (DisplayErrorResult "Graph operation cancelled.")

144 pure (DisplayErrorResult "Graph operation cancelled.")

144 else

145 else

145 runGraphOp

146 runGraphOp

146−

147+

147 (ConvenienceGraphOp execOp) ->

148 (ConvenienceGraphOp execOp) ->

148 eHandler $ evalConvenienceGraphOp sessionId conn execOp

149 eHandler $ evalConvenienceGraphOp sessionId conn execOp

149

150

150 (ROGraphOp execOp) -> do

151 (ROGraphOp execOp) -> do

151 opResult <- evalROGraphOp sessionId conn execOp

152 opResult <- evalROGraphOp sessionId conn execOp

152− case opResult of

153+ case opResult of

153 Left err -> barf err

154 Left err -> barf err

154 Right rel -> pure (DisplayRelationResult rel)

155 Right rel -> pure (DisplayRelationResult rel)

155−

156+

156 (SchemaOp execOp) ->

157 (SchemaOp execOp) ->

157 eHandler $ evalSchemaOperator sessionId conn execOp

158 eHandler $ evalSchemaOperator sessionId conn execOp

158−

159+

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

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

160 if needsSafe then

161 if needsSafe then

161 unsafeError

162 unsafeError

162 else do

163 else do

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

174 case exprErr of

175 case exprErr of

175 Left err -> barf err

176 Left err -> barf err

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

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

177−

178+

178− (ImportDBContextOp execOp) ->

179+ (ImportDBContextOp execOp) ->

179 if needsSafe then

180 if needsSafe then

180 unsafeError

181 unsafeError

181 else do

182 else do

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

183 case eErr of

184 case eErr of

184 Left err -> barf err

185 Left err -> barf err

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

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

186−

187+

187− (InfoOp execOp) ->

188+ (InfoOp execOp) ->

188 if needsSafe then

189 if needsSafe then

189 unsafeError

190 unsafeError

190 else

191 else

191 case evalInformationOperator execOp of

192 case evalInformationOperator execOp of

192 Left err -> pure (DisplayErrorResult err)

193 Left err -> pure (DisplayErrorResult err)

193 Right info -> pure (DisplayResult info)

194 Right info -> pure (DisplayResult info)

194−

195+

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

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

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

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

197 if needsSafe then

198 if needsSafe then

@@ -215,19 +216,20 @@ evalTutorialDInteractive sessionId conn safe interactive expr = case expr of

215 unsafeError = pure $ DisplayErrorResult "File I/O operation prohibited."

216 unsafeError = pure $ DisplayErrorResult "File I/O operation prohibited."

216 barf :: RelationalError -> IO TutorialDOperatorResult

217 barf :: RelationalError -> IO TutorialDOperatorResult

217 barf (ScriptError (OtherScriptCompilationError errStr)) = pure (DisplayErrorResult (T.pack errStr))

218 barf (ScriptError (OtherScriptCompilationError errStr)) = pure (DisplayErrorResult (T.pack errStr))

219+ barf (ParseError err) = pure (DisplayErrorResult err)

218 barf err = return $ DisplayErrorResult (T.pack (show err))

220 barf err = return $ DisplayErrorResult (T.pack (show err))

219 eHandler io = do

221 eHandler io = do

220 eErr <- io

222 eErr <- io

221 case eErr of

223 case eErr of

222 Left err -> barf err

224 Left err -> barf err

223 Right () -> return QuietSuccessResult

225 Right () -> return QuietSuccessResult

224−

226+

225−type GhcPkgPath = String

227+type GhcPkgPath = String

226type TutorialDExec = String

228type TutorialDExec = String

227type CheckFS = Bool

229type CheckFS = Bool

228−

230+

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

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

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

232+ RemoteInterpreterConfig C.Hostname C.Port C.DatabaseName HeadName (Maybe TutorialDExec) CheckFS

231

233

232outputNotificationCallback :: C.NotificationCallback

234outputNotificationCallback :: C.NotificationCallback

233outputNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received " ++ show notName ++ ":\n" ++ "\n" ++ prettyEvaluatedNotification evaldNot

235outputNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received " ++ show notName ++ ":\n" ++ "\n" ++ prettyEvaluatedNotification evaldNot

@@ -245,7 +247,7 @@ reprLoop config sessionId conn = do

245 eHeadName <- C.headName sessionId conn

247 eHeadName <- C.headName sessionId conn

246 eSchemaName <- C.currentSchemaName sessionId conn

248 eSchemaName <- C.currentSchemaName sessionId conn

247 let prompt = promptText eHeadName eSchemaName

249 let prompt = promptText eHeadName eSchemaName

248− catchInterrupt = handleJust (\exc -> case exc of

250+ catchInterrupt = handleJust (\case

249 UserInterrupt -> Just Nothing

251 UserInterrupt -> Just Nothing

250 _ -> Nothing) (\_ -> do

252 _ -> Nothing) (\_ -> do

251 hPutStrLn stderr "Statement cancelled. Use \":quit\" to exit tutd."

253 hPutStrLn stderr "Statement cancelled. Use \":quit\" to exit tutd."

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

256 Just line -> do

258 Just line -> do

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

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

258 reprLoop config sessionId conn

260 reprLoop config sessionId conn

259−

261+

260

262

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

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

262−runTutorialD sessionId conn mPromptLength tutd =

264+runTutorialD sessionId conn mPromptLength tutd =

263 case parseTutorialD tutd of

265 case parseTutorialD tutd of

264− Left err ->

266+ Left err ->

265 displayOpResult $ DisplayParseErrorResult mPromptLength err

267 displayOpResult $ DisplayParseErrorResult mPromptLength err

266 Right parsed ->

268 Right parsed ->

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

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

src/bin/TutorialD/Interpreter/Base.hs+115−40

@@ -1,33 +1,61 @@

1{-# 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

3import ProjectM36.Base

13import ProjectM36.Base

4import ProjectM36.AtomType

14import ProjectM36.AtomType

15+import ProjectM36.Attribute as A

5import ProjectM36.Relation

16import ProjectM36.Relation

17+import ProjectM36.DataFrame

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

20+import Text.Megaparsec.Char

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

7import Text.Megaparsec

22import Text.Megaparsec

23+import Data.Void

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

25+#else

8import Text.Megaparsec.Text

26import Text.Megaparsec.Text

9import qualified Text.Megaparsec.Lexer as Lex

27import qualified Text.Megaparsec.Lexer as Lex

28+#endif

29+

10import Data.Text hiding (count)

30import Data.Text hiding (count)

11import System.Random

31import System.Random

12import qualified Data.Text as T

32import qualified Data.Text as T

13import qualified Data.List as L

33import qualified Data.List as L

14−import qualified Data.Vector as V

15import qualified Data.Text.IO as TIO

34import qualified Data.Text.IO as TIO

16import System.IO

35import System.IO

17import ProjectM36.Relation.Show.Term

36import ProjectM36.Relation.Show.Term

18import GHC.Generics

37import GHC.Generics

38+#if __GLASGOW_HASKELL__ < 804

19import Data.Monoid

39import Data.Monoid

40+#endif

20import qualified Data.UUID as U

41import qualified Data.UUID as U

21import Control.Monad.Random

42import Control.Monad.Random

22import Data.List.NonEmpty as NE

43import Data.List.NonEmpty as NE

23import Data.Time.Clock

44import Data.Time.Clock

24import Data.Time.Format

45import Data.Time.Format

46+import Control.Monad (void)

47+import Data.Char

48+

49+#if !MIN_VERSION_megaparsec(7,0,0)

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

51+anySingle = anyChar

52+#endif

26displayOpResult :: TutorialDOperatorResult -> IO ()

54displayOpResult :: TutorialDOperatorResult -> IO ()

27displayOpResult QuitResult = return ()

55displayOpResult QuitResult = return ()

28displayOpResult (DisplayResult out) = TIO.putStrLn out

56displayOpResult (DisplayResult out) = TIO.putStrLn out

29displayOpResult (DisplayIOResult ioout) = ioout

57displayOpResult (DisplayIOResult ioout) = ioout

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

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

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

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

32displayOpResult QuietSuccessResult = return ()

60displayOpResult QuietSuccessResult = return ()

33displayOpResult (DisplayRelationResult rel) = do

61displayOpResult (DisplayRelationResult rel) = do

@@ -35,22 +63,36 @@ displayOpResult (DisplayRelationResult rel) = do

35 let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen

63 let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen

36 TIO.putStrLn (showRelation randomlySortedRel)

64 TIO.putStrLn (showRelation randomlySortedRel)

37displayOpResult (DisplayParseErrorResult mPromptLength err) = do

65displayOpResult (DisplayParseErrorResult mPromptLength err) = do

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

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

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

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

69+#else

39− errorIndent = unPos (sourceColumn (NE.head (errorPos err)))

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

71+ errString = T.pack (parseErrorPretty err)

72+#endif

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

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

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

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

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

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

76+displayOpResult (DisplayDataFrameResult dFrame) = TIO.putStrLn (showDataFrame dFrame)

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

79+type Parser = Parsec Void Text

80+type ParseStr = Text

81+#else

82+type ParseStr = String

83+#endif

84+

85+-- consumes only horizontal spaces

44spaceConsumer :: Parser ()

86spaceConsumer :: Parser ()

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

87+spaceConsumer = Lex.space space1 (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")

46−

88+

47opChar :: Parser Char

89opChar :: Parser Char

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

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

50−reserved :: String -> Parser ()

92+reserved :: ParseStr -> Parser ()

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

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

53−reservedOp :: String -> Parser ()

95+reservedOp :: ParseStr -> Parser ()

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

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

56parens :: Parser a -> Parser a

98parens :: Parser a -> Parser a

@@ -62,12 +104,20 @@ braces = between (symbol "{") (symbol "}")

62identifier :: Parser Text

104identifier :: Parser Text

63identifier = do

105identifier = do

64 istart <- letterChar <|> char '_'

106 istart <- letterChar <|> char '_'

107+ identifierRemainder istart

108+

109+identifierRemainder :: Char -> Parser Text

110+identifierRemainder c = do

65− irest <- many (alphaNumChar <|> char '_' <|> char '#')

111+ rest <- many (alphaNumChar <|> char '_' <|> char '#')

66 spaceConsumer

112 spaceConsumer

67− pure (pack (istart:irest))

113+ pure (pack (c:rest))

114

69−symbol :: String -> Parser Text

115+symbol :: ParseStr -> Parser Text

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

117+symbol sym = Lex.symbol spaceConsumer sym

118+#else

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

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

120+#endif

121

72comma :: Parser Text

122comma :: Parser Text

73comma = symbol ","

123comma = symbol ","

@@ -87,67 +137,80 @@ arrow = symbol "->"

87semi :: Parser Text

137semi :: Parser Text

88semi = symbol ";"

138semi = symbol ";"

139

90−{-

140+nline :: Parser Text

91−whiteSpace :: Parser ()

141+nline = (T.singleton <$> newline) <|> crlf

92−whiteSpace = Token.whiteSpace lexer

93−-}

142

95integer :: Parser Integer

143integer :: Parser Integer

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

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

146+#else

96−integer = Lex.integer

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

148+#endif

149+

150+natural :: Parser Integer

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

152+natural = Lex.decimal <* spaceConsumer

153+#else

154+natural = Lex.integer <* spaceConsumer

155+#endif

156

98float :: Parser Double

157float :: Parser Double

99−float = Lex.float

158+float = Lex.float <* spaceConsumer

100

159

101capitalizedIdentifier :: Parser Text

160capitalizedIdentifier :: Parser Text

102−capitalizedIdentifier = do

161+capitalizedIdentifier =

103− fletter <- upperChar

162+ upperChar >>= identifierRemainder

104− restOfIdentifier_ fletter

163+

105−

106−restOfIdentifier_ :: Char -> Parser Text

107−restOfIdentifier_ fletter = do

108− rest <- option "" identifier

109− spaceConsumer

110− pure (T.cons fletter rest)

111−

112uncapitalizedIdentifier :: Parser Text

164uncapitalizedIdentifier :: Parser Text

113−uncapitalizedIdentifier = do

165+uncapitalizedIdentifier =

114− fletter <- lowerChar

166+ lowerChar >>= identifierRemainder

115− restOfIdentifier_ fletter

116

167

117showRelationAttributes :: Attributes -> Text

168showRelationAttributes :: Attributes -> Text

118showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ L.map showAttribute attrsL) <> "}"

169showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ L.map showAttribute attrsL) <> "}"

119 where

170 where

120− showAttribute (Attribute name atomType) = name <> " " <> prettyAtomType atomType

171+ showAttribute (Attribute name atomType') = name <> " " <> prettyAtomType atomType'

121− attrsL = V.toList attrs

172+ attrsL = A.toList attrs

173+

174+type PromptLength = Int

122

175

123−type PromptLength = Int

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

177+type ParserError = ParseErrorBundle T.Text Void

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

179+type ParserError = ParseError Char Void

180+#else

181+type ParserError = ParseError Char Dec

182+#endif

124

183

125data TutorialDOperatorResult = QuitResult |

184data TutorialDOperatorResult = QuitResult |

126 DisplayResult StringType |

185 DisplayResult StringType |

127 DisplayIOResult (IO ()) |

186 DisplayIOResult (IO ()) |

128 DisplayRelationResult Relation |

187 DisplayRelationResult Relation |

188+ DisplayDataFrameResult DataFrame |

129 DisplayErrorResult StringType |

189 DisplayErrorResult StringType |

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

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

131 QuietSuccessResult

191 QuietSuccessResult

132 deriving (Generic)

192 deriving (Generic)

133−

193+

134type TransactionGraphWasUpdated = Bool

194type TransactionGraphWasUpdated = Bool

135

195

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

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

137tripleQuotedString :: Parser Text

197tripleQuotedString :: Parser Text

138tripleQuotedString = do

198tripleQuotedString = do

139 _ <- tripleQuote

199 _ <- tripleQuote

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

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

141−

201+

142normalQuotedString :: Parser Text

202normalQuotedString :: Parser Text

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

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

144

204

145quotedString :: Parser Text

205quotedString :: Parser Text

146quotedString = try tripleQuotedString <|> normalQuotedString

206quotedString = try tripleQuotedString <|> normalQuotedString

147

207

208+quoted :: Parser a -> Parser a

209+quoted = between quote quote

210+

148uuidP :: Parser U.UUID

211uuidP :: Parser U.UUID

149uuidP = do

212uuidP = do

150− uuidStart <- count 8 hexDigitChar

213+ uuidStart <- count 8 hexDigitChar

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

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

152 uuidMid1 <- count 4 hexDigitChar

215 uuidMid1 <- count 4 hexDigitChar

153 _ <- char '-'

216 _ <- char '-'

@@ -166,5 +229,17 @@ utcTimeP = do

166 timeStr <- quotedString

229 timeStr <- quotedString

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

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

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

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

169− Just stamp -> pure stamp

232+ Just stamp' -> pure stamp'

233+

234+

235+colonOp :: Text -> Parser ()

236+colonOp opStr = do

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

238+ pure ()

239+

240+hex :: Parser Text

241+hex = takeWhileP (Just "hexadecimal")

242+ (\c ->

243+ isDigit c

244+ || (c >= 'a' && c <= 'f'))

170

245

src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs+35−36

@@ -1,20 +1,21 @@

1+{-# LANGUAGE CPP #-}

1module TutorialD.Interpreter.DatabaseContextExpr where

2module TutorialD.Interpreter.DatabaseContextExpr where

2−import Text.Megaparsec

3−import Text.Megaparsec.Text

4import ProjectM36.Base

3import ProjectM36.Base

5import TutorialD.Interpreter.Base

4import TutorialD.Interpreter.Base

6import qualified Data.Text as T

5import qualified Data.Text as T

7import TutorialD.Interpreter.RelationalExpr

6import TutorialD.Interpreter.RelationalExpr

8import TutorialD.Interpreter.Types

7import TutorialD.Interpreter.Types

9import qualified Data.Map as M

8import qualified Data.Map as M

10−import Control.Monad.State

11import ProjectM36.StaticOptimizer

9import ProjectM36.StaticOptimizer

12import qualified ProjectM36.Error as PM36E

10import qualified ProjectM36.Error as PM36E

13import ProjectM36.Error

11import ProjectM36.Error

14import qualified ProjectM36.RelationalExpression as RE

12import qualified ProjectM36.RelationalExpression as RE

15import ProjectM36.Key

13import ProjectM36.Key

16import ProjectM36.FunctionalDependency

14import ProjectM36.FunctionalDependency

15+#if __GLASGOW_HASKELL__ < 804

17import Data.Monoid

16import Data.Monoid

17+#endif

18+import Data.Functor

19--parsers which create "database expressions" which modify the database context (such as relvar assignment)

20--parsers which create "database expressions" which modify the database context (such as relvar assignment)

20databaseContextExprP :: Parser DatabaseContextExpr

21databaseContextExprP :: Parser DatabaseContextExpr

@@ -43,53 +44,47 @@ nothingP = spaceConsumer >> pure NoOperation

43assignP :: Parser DatabaseContextExpr

44assignP :: Parser DatabaseContextExpr

44assignP = do

45assignP = do

45 relVarName <- try $ do

46 relVarName <- try $ do

46− relVarName <- identifier

47+ relVarName <- relVarNameP

47 reservedOp ":="

48 reservedOp ":="

48 return relVarName

49 return relVarName

49− expr <- relExprP

50− pure $ Assign relVarName expr

50+ Assign relVarName <$> relExprP

52multilineSep :: Parser T.Text

53multilineSep = newline >> pure "\n"

55multipleDatabaseContextExprP :: Parser DatabaseContextExpr

56multipleDatabaseContextExprP = do

57− exprs <- sepBy1 databaseContextExprP semi

57+ exprs <- filter (/= NoOperation) <$> sepBy1 databaseContextExprP semi

58− pure $ MultipleExpr exprs

58+ pure (MultipleExpr exprs)

60insertP :: Parser DatabaseContextExpr

61insertP = do

62 reservedOp "insert"

63− relvar <- identifier

63+ relvar <- relVarNameP

64− expr <- relExprP

65− pure $ Insert relvar expr

64+ Insert relvar <$> relExprP

67defineP :: Parser DatabaseContextExpr

66defineP :: Parser DatabaseContextExpr

68defineP = do

67defineP = do

69 relVarName <- try $ do

68 relVarName <- try $ do

70− relVarName <- identifier

69+ relVarName <- relVarNameP

71 reservedOp "::"

70 reservedOp "::"

72 return relVarName

71 return relVarName

73− attributeSet <- makeAttributeExprsP

74− pure $ Define relVarName attributeSet

72+ Define relVarName <$> makeAttributeExprsP

76undefineP :: Parser DatabaseContextExpr

74undefineP :: Parser DatabaseContextExpr

77undefineP = do

75undefineP = do

78 reservedOp "undefine"

76 reservedOp "undefine"

79− relVarName <- identifier

77+ Undefine <$> relVarNameP

80− return $ Undefine relVarName

82deleteP :: Parser DatabaseContextExpr

79deleteP :: Parser DatabaseContextExpr

83deleteP = do

80deleteP = do

84 reservedOp "delete"

81 reservedOp "delete"

85− relVarName <- identifier

86− predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP)

82+ Delete <$> relVarNameP <*> option TruePredicate (reservedOp "where" *> restrictionPredicateP)

87− return $ Delete relVarName predicate

89updateP :: Parser DatabaseContextExpr

84updateP :: Parser DatabaseContextExpr

90updateP = do

85updateP = do

91 reservedOp "update"

86 reservedOp "update"

92− relVarName <- identifier

87+ relVarName <- relVarNameP

93 predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP <* spaceConsumer)

88 predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP <* spaceConsumer)

94 attributeAssignments <- M.fromList <$> parens (sepBy attributeAssignmentP comma)

89 attributeAssignments <- M.fromList <$> parens (sepBy attributeAssignmentP comma)

95 return $ Update relVarName attributeAssignments predicate

90 return $ Update relVarName attributeAssignments predicate

@@ -101,7 +96,7 @@ addConstraintP = do

101 reservedOp "constraint" <|> reservedOp "foreign key"

96 reservedOp "constraint" <|> reservedOp "foreign key"

102 constraintName <- identifier

97 constraintName <- identifier

103 subset <- relExprP

98 subset <- relExprP

104− op <- (reservedOp "in" *> pure SubsetOp) <|> (reservedOp "equals" *> pure EqualityOp)

99+ op <- (reservedOp "in" $> SubsetOp) <|> (reservedOp "equals" $> EqualityOp)

105 superset <- relExprP

100 superset <- relExprP

106 let subsetA = incDepSet constraintName subset superset

101 let subsetA = incDepSet constraintName subset superset

107 subsetB = incDepSet (constraintName <> "_eqInvert") superset subset --inverted args for equality constraint

102 subsetB = incDepSet (constraintName <> "_eqInvert") superset subset --inverted args for equality constraint

@@ -113,8 +108,7 @@ addConstraintP = do

113deleteConstraintP :: Parser DatabaseContextExpr

108deleteConstraintP :: Parser DatabaseContextExpr

114deleteConstraintP = do

109deleteConstraintP = do

115 reserved "deleteconstraint"

110 reserved "deleteconstraint"

116− constraintName <- identifier

111+ RemoveInclusionDependency <$> identifier

117− pure $ RemoveInclusionDependency constraintName

118

112

119-- key <constraint name> {<uniqueness attributes>} <uniqueness relexpr>

113-- key <constraint name> {<uniqueness attributes>} <uniqueness relexpr>

120keyP :: Parser DatabaseContextExpr

114keyP :: Parser DatabaseContextExpr

@@ -154,14 +148,12 @@ addNotificationP = do

154 notName <- identifier

148 notName <- identifier

155 triggerExpr <- relExprP

149 triggerExpr <- relExprP

156 resultOldExpr <- relExprP

150 resultOldExpr <- relExprP

157− resultNewExpr <- relExprP

158− pure $ AddNotification notName triggerExpr resultOldExpr resultNewExpr

151+ AddNotification notName triggerExpr resultOldExpr <$> relExprP

159

152

160removeNotificationP :: Parser DatabaseContextExpr

153removeNotificationP :: Parser DatabaseContextExpr

161removeNotificationP = do

154removeNotificationP = do

162 reserved "unnotify"

155 reserved "unnotify"

163− notName <- identifier

156+ RemoveNotification <$> identifier

164− pure $ RemoveNotification notName

165

157

166-- | data Hair = Bald | Color Text

158-- | data Hair = Bald | Color Text

167addTypeConstructorP :: Parser DatabaseContextExpr

159addTypeConstructorP :: Parser DatabaseContextExpr

@@ -175,7 +167,7 @@ addTypeConstructorP = do

175removeTypeConstructorP :: Parser DatabaseContextExpr

167removeTypeConstructorP :: Parser DatabaseContextExpr

176removeTypeConstructorP = do

168removeTypeConstructorP = do

177 reserved "undata"

169 reserved "undata"

178− RemoveTypeConstructor <$> identifier

170+ RemoveTypeConstructor <$> typeConstructorNameP

179

171

180removeAtomFunctionP :: Parser DatabaseContextExpr

172removeAtomFunctionP :: Parser DatabaseContextExpr

181removeAtomFunctionP = do

173removeAtomFunctionP = do

@@ -187,28 +179,35 @@ removeDatabaseContextFunctionP = do

187 reserved "removedatabasecontextfunction"

179 reserved "removedatabasecontextfunction"

188 RemoveDatabaseContextFunction <$> quotedString

180 RemoveDatabaseContextFunction <$> quotedString

189

181

182+functionNameP :: Parser AtomFunctionName

183+functionNameP = uncapitalizedIdentifier

184+

190executeDatabaseContextFunctionP :: Parser DatabaseContextExpr

185executeDatabaseContextFunctionP :: Parser DatabaseContextExpr

191executeDatabaseContextFunctionP = do

186executeDatabaseContextFunctionP = do

192 reserved "execute"

187 reserved "execute"

193− funcName <- identifier

188+ funcName <- functionNameP

194 args <- parens (sepBy atomExprP comma)

189 args <- parens (sepBy atomExprP comma)

195 pure (ExecuteDatabaseContextFunction funcName args)

190 pure (ExecuteDatabaseContextFunction funcName args)

196

191

197databaseExprOpP :: Parser DatabaseContextExpr

192databaseExprOpP :: Parser DatabaseContextExpr

198databaseExprOpP = multipleDatabaseContextExprP

193databaseExprOpP = multipleDatabaseContextExprP

199

194

195+{-

200evalDatabaseContextExpr :: Bool -> DatabaseContext -> DatabaseContextExpr -> Either RelationalError DatabaseContext

196evalDatabaseContextExpr :: Bool -> DatabaseContext -> DatabaseContextExpr -> Either RelationalError DatabaseContext

201evalDatabaseContextExpr useOptimizer context expr = do

197evalDatabaseContextExpr useOptimizer context expr = do

202 optimizedExpr <- evalState (applyStaticDatabaseOptimization expr) (RE.freshDatabaseState context)

198 optimizedExpr <- evalState (applyStaticDatabaseOptimization expr) (RE.freshDatabaseState context)

203 case runState (RE.evalDatabaseContextExpr (if useOptimizer then optimizedExpr else expr)) (RE.freshDatabaseState context) of

199 case runState (RE.evalDatabaseContextExpr (if useOptimizer then optimizedExpr else expr)) (RE.freshDatabaseState context) of

204− (Nothing, (context',_, _)) -> Right context'

200+ (Right (), (context',_, _)) -> Right context'

205− (Just err, _) -> Left err

201+ (Left err, _) -> Left err

206−

202+-}

207

203

208−interpretDatabaseContextExpr :: DatabaseContext -> T.Text -> Either RelationalError DatabaseContext

204+interpretDatabaseContextExpr :: DatabaseContext -> TransactionId -> TransactionGraph -> T.Text -> Either RelationalError DatabaseContext

209−interpretDatabaseContextExpr context tutdstring = case parse databaseExprOpP "" tutdstring of

205+interpretDatabaseContextExpr context transId graph tutdstring =

206+ case parse databaseExprOpP "" tutdstring of

210− Left err -> Left $ PM36E.ParseError (T.pack (show err))

207+ Left err -> Left $ PM36E.ParseError (T.pack (show err))

211− Right parsed -> evalDatabaseContextExpr True context parsed

208+ Right parsed -> do

209+ let env = RE.mkDatabaseContextEvalEnv transId graph

210+ RE.dbc_context <$> RE.runDatabaseContextEvalMonad context env (optimizeAndEvalDatabaseContextExpr True parsed)

212

211

213{-

212{-

214--no optimization

213--no optimization

src/bin/TutorialD/Interpreter/DatabaseContextIOOperator.hs+27−8

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

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

2module TutorialD.Interpreter.DatabaseContextIOOperator where

3import ProjectM36.Base

4−

5import TutorialD.Interpreter.Base

4import TutorialD.Interpreter.Base

6import TutorialD.Interpreter.Types

5import TutorialD.Interpreter.Types

7−import Text.Megaparsec

8−import Text.Megaparsec.Text

9import Data.Text

6import Data.Text

11addAtomFunctionExprP :: Parser DatabaseContextIOExpr

8addAtomFunctionExprP :: Parser DatabaseContextIOExpr

@@ -13,19 +10,41 @@ addAtomFunctionExprP = dbioexprP "addatomfunction" AddAtomFunction

14addDatabaseContextFunctionExprP :: Parser DatabaseContextIOExpr

11addDatabaseContextFunctionExprP :: Parser DatabaseContextIOExpr

15addDatabaseContextFunctionExprP = dbioexprP "adddatabasecontextfunction" AddDatabaseContextFunction

12addDatabaseContextFunctionExprP = dbioexprP "adddatabasecontextfunction" AddDatabaseContextFunction

13+

14+createArbitraryRelationP :: Parser DatabaseContextIOExpr

15+createArbitraryRelationP = do

16+ reserved "createarbitraryrelation"

17+ relVarName <- identifier

18+ attrExprs <- makeAttributeExprsP :: Parser [AttributeExpr]

19+ min' <- fromInteger <$> integer

20+ _ <- symbol "-"

21+ max' <- fromInteger <$> integer

22+ pure $ CreateArbitraryRelation relVarName attrExprs (min',max')

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

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

18dbioexprP res adt = do

25dbioexprP res adt = do

19 reserved res

26 reserved res

20 funcName <- quotedString

27 funcName <- quotedString

21 funcType <- atomTypeSignatureP

28 funcType <- atomTypeSignatureP

22− funcScript <- quotedString

23− pure $ adt funcName funcType funcScript

29+ adt funcName funcType <$> quotedString

25atomTypeSignatureP :: Parser [TypeConstructor]

31atomTypeSignatureP :: Parser [TypeConstructor]

26atomTypeSignatureP = sepBy typeConstructorP arrow

32atomTypeSignatureP = sepBy typeConstructorP arrow

28dbContextIOExprP :: Parser DatabaseContextIOExpr

34dbContextIOExprP :: Parser DatabaseContextIOExpr

29−dbContextIOExprP = addAtomFunctionExprP <|> addDatabaseContextFunctionExprP

35+dbContextIOExprP = addAtomFunctionExprP <|>

30−

36+ addDatabaseContextFunctionExprP <|>

37+ loadAtomFunctionsP <|>

38+ loadDatabaseContextFunctionsP <|>

39+ createArbitraryRelationP

40+

41+loadAtomFunctionsP :: Parser DatabaseContextIOExpr

42+loadAtomFunctionsP = do

43+ reserved "loadatomfunctions"

44+ LoadAtomFunctions <$> quotedString <*> quotedString <*> fmap unpack quotedString

45+

46+loadDatabaseContextFunctionsP :: Parser DatabaseContextIOExpr

47+loadDatabaseContextFunctionsP = do

48+ reserved "loaddatabasecontextfunctions"

49+ LoadDatabaseContextFunctions <$> quotedString <*> quotedString <*> fmap unpack quotedString

src/bin/TutorialD/Interpreter/Export/Base.hs+3

@@ -1,7 +1,10 @@

1+{-# LANGUAGE CPP #-}

1module TutorialD.Interpreter.Export.Base where

2module TutorialD.Interpreter.Export.Base where

2import ProjectM36.Base

3import ProjectM36.Base

3import ProjectM36.Error

4import ProjectM36.Error

5+#if __GLASGOW_HASKELL__ < 804

4import Data.Monoid

6import Data.Monoid

7+#endif

6data RelVarDataExportOperator = RelVarDataExportOperator RelationalExpr FilePath (RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError))

9data RelVarDataExportOperator = RelVarDataExportOperator RelationalExpr FilePath (RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError))

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

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

2import ProjectM36.Relation.Show.CSV

3import TutorialD.Interpreter.Export.Base

4import TutorialD.Interpreter.RelationalExpr

5−import TutorialD.Interpreter.Base

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

6import ProjectM36.Base

7import ProjectM36.Error

8−import Text.Megaparsec.Text

9import qualified Data.ByteString.Lazy as BS

8import qualified Data.ByteString.Lazy as BS

10import Control.Exception (try)

9import Control.Exception (try)

11import qualified Data.Text as T

10import qualified Data.Text as T

src/bin/TutorialD/Interpreter/Import/Base.hs+11−3

@@ -1,7 +1,12 @@

1+{-# LANGUAGE CPP #-}

1module TutorialD.Interpreter.Import.Base where

2module TutorialD.Interpreter.Import.Base where

2import ProjectM36.Base

3import ProjectM36.Base

3import ProjectM36.Error

4import ProjectM36.Error

5+import Text.URI (URI)

6+import Data.Text (Text)

7+#if __GLASGOW_HASKELL__ < 804

4import Data.Monoid

8import Data.Monoid

9+#endif

6-- | import data into a relation variable

11-- | import data into a relation variable

7data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> TypeConstructorMapping -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr))

12data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> TypeConstructorMapping -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr))

@@ -9,11 +14,14 @@ data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (Re

9instance Show RelVarDataImportOperator where

14instance Show RelVarDataImportOperator where

10 show (RelVarDataImportOperator rv path _) = "RelVarDataImportOperator " <> show rv <> " " <> path

15 show (RelVarDataImportOperator rv path _) = "RelVarDataImportOperator " <> show rv <> " " <> path

17+type HashVerification = Maybe Text

18+

12-- | import data into a database context

19-- | import data into a database context

13−data DatabaseContextDataImportOperator = DatabaseContextDataImportOperator FilePath (FilePath -> IO (Either RelationalError DatabaseContextExpr))

20+data DatabaseContextDataImportOperator = DatabaseContextDataImportOperator URI HashVerification (URI -> HashVerification -> IO (Either RelationalError DatabaseContextExpr))

15instance Show DatabaseContextDataImportOperator where

22instance Show DatabaseContextDataImportOperator where

16− show (DatabaseContextDataImportOperator path _) = "DatabaseContextDataImportOperator " <> path

23+ show (DatabaseContextDataImportOperator uri hash _) =

24+ "DatabaseContextDataImportOperator " <> show uri <> " " <> show hash

18-- perhaps create a structure to import a whole transaction graph section in the future

26-- perhaps create a structure to import a whole transaction graph section in the future

@@ -21,4 +29,4 @@ evalRelVarDataImportOperator :: RelVarDataImportOperator -> TypeConstructorMappi

21evalRelVarDataImportOperator (RelVarDataImportOperator relVarName path importFunc) tConsMap attrs = importFunc relVarName tConsMap attrs path

29evalRelVarDataImportOperator (RelVarDataImportOperator relVarName path importFunc) tConsMap attrs = importFunc relVarName tConsMap attrs path

23evalDatabaseContextDataImportOperator :: DatabaseContextDataImportOperator -> IO (Either RelationalError DatabaseContextExpr)

31evalDatabaseContextDataImportOperator :: DatabaseContextDataImportOperator -> IO (Either RelationalError DatabaseContextExpr)

24−evalDatabaseContextDataImportOperator (DatabaseContextDataImportOperator path importFunc) = importFunc path

32+evalDatabaseContextDataImportOperator (DatabaseContextDataImportOperator uri hash importFunc) = importFunc uri hash

src/bin/TutorialD/Interpreter/Import/BasicExamples.hs+6−2

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

1+{-# LANGUAGE CPP #-}

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

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

2module TutorialD.Interpreter.Import.BasicExamples where

3module TutorialD.Interpreter.Import.BasicExamples where

3import ProjectM36.DateExamples

4import ProjectM36.DateExamples

4import ProjectM36.Base

5import ProjectM36.Base

5import ProjectM36.DatabaseContext

6import ProjectM36.DatabaseContext

6import TutorialD.Interpreter.Base

7import TutorialD.Interpreter.Base

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

7import Text.Megaparsec.Text

10import Text.Megaparsec.Text

11+#endif

9data ImportBasicExampleOperator = ImportBasicDateExampleOperator

13data ImportBasicExampleOperator = ImportBasicDateExampleOperator

10 deriving (Show)

14 deriving (Show)

@@ -16,8 +20,8 @@ importBasicExampleOperatorP :: Parser ImportBasicExampleOperator

16importBasicExampleOperatorP = do

20importBasicExampleOperatorP = do

17 reservedOp ":importexample"

21 reservedOp ":importexample"

18 example <- identifier

22 example <- identifier

19− if example == "date" then

23+ if example == "cjdate" then

20 pure ImportBasicDateExampleOperator

24 pure ImportBasicDateExampleOperator

21 else

25 else

22 fail "Unknown example name"

26 fail "Unknown example name"

23−

27+

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

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

1+{-# LANGUAGE CPP #-}

1module TutorialD.Interpreter.Import.CSV where

2module TutorialD.Interpreter.Import.CSV where

2import TutorialD.Interpreter.Import.Base

3import TutorialD.Interpreter.Import.Base

3import ProjectM36.Base

4import ProjectM36.Base

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

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

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

6import qualified Data.ByteString.Lazy as BS

7import qualified Data.ByteString.Lazy as BS

7import qualified Data.Text as T

8import qualified Data.Text as T

8−import Text.Megaparsec.Text

9−import TutorialD.Interpreter.Base

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

10import Control.Exception

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

@@ -14,10 +14,10 @@ importCSVRelation relVarName tConsMap attrs pathIn = do

14 --TODO: handle filesystem errors

15 csvData <- try (BS.readFile pathIn) :: IO (Either IOError BS.ByteString)

16 case csvData of

17− Left err -> return $ Left (ImportError $ T.pack (show err))

17+ Left err -> pure $ Left (ImportError (ImportFileError (T.pack (show err))))

18 Right csvData' -> case csvAsRelation attrs tConsMap csvData' of

19− Left err -> return $ Left (ParseError $ T.pack (show err))

19+ Left err -> pure $ Left (ParseError $ T.pack (show err))

20− Right csvRel -> return $ Right (Insert relVarName (ExistingRelation csvRel))

20+ Right csvRel -> pure $ Right (Insert relVarName (ExistingRelation csvRel))

22importCSVP :: Parser RelVarDataImportOperator

23importCSVP = do

src/bin/TutorialD/Interpreter/Import/TutorialD.hs+70−15

@@ -1,31 +1,86 @@

1module TutorialD.Interpreter.Import.TutorialD where

2import ProjectM36.Base

3import TutorialD.Interpreter.Import.Base

4−import TutorialD.Interpreter.Base

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

5import TutorialD.Interpreter.DatabaseContextExpr

6−import Text.Megaparsec.Text

7−import Text.Megaparsec hiding (try)

8import ProjectM36.Error

6import ProjectM36.Error

9import qualified ProjectM36.Error as PM36E

7import qualified ProjectM36.Error as PM36E

10import qualified Data.Text as T

8import qualified Data.Text as T

11import Control.Exception

9import Control.Exception

12−import qualified Data.Text.IO as TIO

10+import qualified Data.ByteString as BS

11+import qualified Data.Text.Encoding as TE

12+import qualified Text.URI as URI

13+import Text.URI (URI)

14+import Crypto.Hash.SHA256

15+import Data.ByteString.Base16 as B16

16+import Network.HTTP.Simple

17+import Network.HTTP.Types

13−--import a file containing TutorialD database context expressions

18+--import a file containing TutorialD database context expressions via local files or HTTP/HTTPS

15−importTutorialD :: FilePath -> IO (Either RelationalError DatabaseContextExpr)

20+importTutorialDFromFile :: URI -> HashVerification -> IO (Either RelationalError DatabaseContextExpr)

16−importTutorialD pathIn = do

21+importTutorialDFromFile fileURI mHash = do

22+ case URI.uriPath fileURI of

23+ Just (False, _) -> do

17− tutdData <- try (TIO.readFile pathIn) :: IO (Either IOError T.Text)

24+ eTutdBytes <- try (BS.readFile filePath) :: IO (Either IOError BS.ByteString)

18− case tutdData of

25+ case eTutdBytes of

26+ Left err -> pure $ Left (ImportError (ImportFileError (T.pack (show err))))

27+ Right tutdBytes ->

28+ case validateBytes tutdBytes mHash of

29+ Left err -> pure (Left err)

30+ Right tutdBytes' -> importTutorialDBytes tutdBytes'

31+ _ -> pure (Left (ImportError (InvalidFileURIError (URI.render fileURI))))

32+ where

33+ filePath = drop (length ("file://" :: String)) (URI.renderStr fileURI)

34+

35+

36+importTutorialDBytes :: BS.ByteString -> IO (Either RelationalError DatabaseContextExpr)

37+importTutorialDBytes tutdBytes =

38+ case TE.decodeUtf8' tutdBytes of

19− Left err -> return $ Left (ImportError $ T.pack (show err))

39+ Left err -> pure (Left (ImportError (ImportFileDecodeError (T.pack (show err)))))

20− Right tutdData' ->

40+ Right tutdUtf8 ->

21− case parse multipleDatabaseContextExprP "import" tutdData' of

41+ case parse (multipleDatabaseContextExprP <* eof) "import" tutdUtf8 of

22 --parseErrorPretty is new in megaparsec 5

42 --parseErrorPretty is new in megaparsec 5

23− Left err -> pure (Left (PM36E.ParseError (T.pack (show err))))

43+ Left err -> pure (Left (PM36E.ParseError (T.pack (errorBundlePretty err))))

24 Right expr -> pure (Right expr)

44 Right expr -> pure (Right expr)

46+importTutorialDViaHTTP :: URI -> HashVerification -> IO (Either RelationalError DatabaseContextExpr)

47+importTutorialDViaHTTP uri mHash = do

48+ reqURI <- parseRequest (URI.renderStr uri)

49+ response <- httpBS reqURI

50+ let scode = getResponseStatus response

51+ if scode == ok200 then

52+ let byteBody = getResponseBody response in

53+ case validateBytes byteBody mHash of

54+ Right byteBody' -> do

55+ importTutorialDBytes byteBody'

56+ Left err -> pure (Left err)

57+ else

58+ pure (Left (ImportError (ImportDownloadError (T.pack ("download failed: " <> show scode)))))

59+

60+validateBytes :: BS.ByteString -> HashVerification -> Either RelationalError BS.ByteString

61+validateBytes tutdBytes mHash =

62+ case mHash of

63+ Nothing -> pure tutdBytes

64+ Just expectedHashText ->

65+ case B16.decode (TE.encodeUtf8 expectedHashText) of

66+ Left _ -> Left (ImportError (InvalidSHA256Error expectedHashText))

67+ Right expectedHash | hashBytes == expectedHash -> pure tutdBytes

68+ | otherwise ->

69+ let p = TE.decodeUtf8 . B16.encode in

70+ Left (ImportError (SHA256MismatchError (p expectedHash) (p hashBytes)))

71+ where

72+ hashBytes = hash tutdBytes

73+

74+

26tutdImportP :: Parser DatabaseContextDataImportOperator

75tutdImportP :: Parser DatabaseContextDataImportOperator

27tutdImportP = do

76tutdImportP = do

28 reserved ":importtutd"

77 reserved ":importtutd"

29− path <- quotedString

78+ uri <- quoted URI.parser

30 spaceConsumer

79 spaceConsumer

80+ mhash <- optional (quoted hex)

81+ handler <- case URI.unRText <$> URI.uriScheme uri of

82+ Nothing -> fail "URI scheme missing"

83+ Just "file" -> pure importTutorialDFromFile

84+ Just scheme | scheme `elem` ["http", "https"] -> pure importTutorialDViaHTTP

85+ | otherwise -> fail ( "unsupported URI scheme: " <> show scheme)

31− return $ DatabaseContextDataImportOperator (T.unpack path) importTutorialD

86+ pure $ DatabaseContextDataImportOperator uri mhash handler

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

@@ -2,8 +2,12 @@

2module TutorialD.Interpreter.InformationOperator where

3import Data.Text

4import Text.Megaparsec

5−import Text.Megaparsec.Text

6import TutorialD.Interpreter.Base

5import TutorialD.Interpreter.Base

6+-- older versions of stack fail to

7+#if !defined(VERSION_project_m36)

8+# warning Failed to discover proper version from cabal_macros.h

9+# define VERSION_project_m36 "<unknown>"

10+#endif

8-- this module provides information about the current interpreter

12-- this module provides information about the current interpreter

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

@@ -1,14 +1,16 @@

1{-# LANGUAGE GADTs #-}

2module TutorialD.Interpreter.RODatabaseContextOperator where

3import ProjectM36.Base

4+import ProjectM36.Relation

5+import qualified ProjectM36.DataFrame as DF

4import ProjectM36.Error

6import ProjectM36.Error

7+import ProjectM36.Tuple

5import ProjectM36.InclusionDependency

8import ProjectM36.InclusionDependency

6import qualified ProjectM36.Client as C

9import qualified ProjectM36.Client as C

7−import Text.Megaparsec

8−import Text.Megaparsec.Text

9import TutorialD.Interpreter.Base

10import TutorialD.Interpreter.Base

10import TutorialD.Interpreter.RelationalExpr

11import TutorialD.Interpreter.RelationalExpr

11import TutorialD.Interpreter.DatabaseContextExpr

12import TutorialD.Interpreter.DatabaseContextExpr

13+import TutorialD.Printer

12import Control.Monad.State

14import Control.Monad.State

13import qualified Data.Text as T

15import qualified Data.Text as T

14import ProjectM36.Relation.Show.Gnuplot

16import ProjectM36.Relation.Show.Gnuplot

@@ -20,53 +22,57 @@ data RODatabaseContextOperator where

20 ShowRelation :: RelationalExpr -> RODatabaseContextOperator

22 ShowRelation :: RelationalExpr -> RODatabaseContextOperator

21 PlotRelation :: RelationalExpr -> RODatabaseContextOperator

23 PlotRelation :: RelationalExpr -> RODatabaseContextOperator

22 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator

24 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator

23− ShowConstraint :: StringType -> RODatabaseContextOperator

25+ ShowConstraints :: StringType -> RODatabaseContextOperator

24 ShowPlan :: DatabaseContextExpr -> RODatabaseContextOperator

26 ShowPlan :: DatabaseContextExpr -> RODatabaseContextOperator

25 ShowTypes :: RODatabaseContextOperator

27 ShowTypes :: RODatabaseContextOperator

26 ShowRelationVariables :: RODatabaseContextOperator

28 ShowRelationVariables :: RODatabaseContextOperator

29+ ShowAtomFunctions :: RODatabaseContextOperator

30+ ShowDatabaseContextFunctions :: RODatabaseContextOperator

31+ ShowDataFrame :: DF.DataFrameExpr -> RODatabaseContextOperator

27 Quit :: RODatabaseContextOperator

32 Quit :: RODatabaseContextOperator

28 deriving (Show)

33 deriving (Show)

30typeP :: Parser RODatabaseContextOperator

35typeP :: Parser RODatabaseContextOperator

31typeP = do

36typeP = do

32− reservedOp ":type"

37+ colonOp ":type"

33− expr <- relExprP

34− return $ ShowRelationType expr

38+ ShowRelationType <$> relExprP

36showRelP :: Parser RODatabaseContextOperator

40showRelP :: Parser RODatabaseContextOperator

37showRelP = do

41showRelP = do

38− reservedOp ":showexpr"

42+ colonOp ":showexpr"

39− expr <- relExprP

40− return $ ShowRelation expr

43+ ShowRelation <$> relExprP

42showPlanP :: Parser RODatabaseContextOperator

45showPlanP :: Parser RODatabaseContextOperator

43showPlanP = do

46showPlanP = do

44− reservedOp ":showplan"

47+ colonOp ":showplan"

45− expr <- databaseContextExprP

48+ ShowPlan <$> databaseContextExprP

46− return $ ShowPlan expr

48showTypesP :: Parser RODatabaseContextOperator

50showTypesP :: Parser RODatabaseContextOperator

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

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

51showRelationVariables :: Parser RODatabaseContextOperator

53showRelationVariables :: Parser RODatabaseContextOperator

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

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

55+

56+showAtomFunctionsP :: Parser RODatabaseContextOperator

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

58+

59+showDatabaseContextFunctionsP :: Parser RODatabaseContextOperator

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

54quitP :: Parser RODatabaseContextOperator

62quitP :: Parser RODatabaseContextOperator

55quitP = do

63quitP = do

56− reservedOp ":quit"

64+ colonOp ":quit"

57 return Quit

65 return Quit

59showConstraintsP :: Parser RODatabaseContextOperator

67showConstraintsP :: Parser RODatabaseContextOperator

60showConstraintsP = do

68showConstraintsP = do

61− reservedOp ":constraints"

69+ colonOp ":constraints"

62− constraintName <- option "" identifier

70+ ShowConstraints <$> option "" identifier

63− return $ ShowConstraint constraintName

65plotRelExprP :: Parser RODatabaseContextOperator

72plotRelExprP :: Parser RODatabaseContextOperator

66plotRelExprP = do

73plotRelExprP = do

67− reserved ":plotexpr"

74+ colonOp ":plotexpr"

68− expr <- relExprP

69− return $ PlotRelation expr

75+ PlotRelation <$> relExprP

71roDatabaseContextOperatorP :: Parser RODatabaseContextOperator

77roDatabaseContextOperatorP :: Parser RODatabaseContextOperator

72roDatabaseContextOperatorP = typeP

78roDatabaseContextOperatorP = typeP

@@ -76,6 +82,9 @@ roDatabaseContextOperatorP = typeP

76 <|> showConstraintsP

82 <|> showConstraintsP

77 <|> showPlanP

83 <|> showPlanP

78 <|> showTypesP

84 <|> showTypesP

85+ <|> showAtomFunctionsP

86+ <|> showDatabaseContextFunctionsP

87+ <|> showDataFrameP

79 <|> quitP

88 <|> quitP

81--logically, these read-only operations could happen purely, but not if a remote call is required

90--logically, these read-only operations could happen purely, but not if a remote call is required

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

100 err <- plotRelation rel

109 err <- plotRelation rel

101 when (isJust err) $ print err

110 when (isJust err) $ print err

102

111

103−evalRODatabaseContextOp sessionId conn (ShowConstraint name) = do

112+evalRODatabaseContextOp sessionId conn (ShowConstraints name) = do

104 eIncDeps <- C.inclusionDependencies sessionId conn

113 eIncDeps <- C.inclusionDependencies sessionId conn

105 let val = case eIncDeps of

114 let val = case eIncDeps of

106 Left err -> Left err

115 Left err -> Left err

107 Right incDeps -> case name of

116 Right incDeps -> case name of

108− "" -> inclusionDependenciesAsRelation incDeps

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

109 depName -> case M.lookup depName incDeps of

118 depName -> case M.lookup depName incDeps of

110 Nothing -> Left (InclusionDependencyNameNotInUseError depName)

119 Nothing -> Left (InclusionDependencyNameNotInUseError depName)

120+ Just dep ->

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

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

112 pure $ case val of

122 pure $ case val of

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

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

114 Right rel -> DisplayRelationResult rel

124 Right rel -> DisplayRelationResult rel

@@ -130,7 +140,25 @@ evalRODatabaseContextOp sessionId conn ShowRelationVariables = do

130 case eRel of

140 case eRel of

131 Left err -> pure $ DisplayErrorResult (T.pack (show err))

141 Left err -> pure $ DisplayErrorResult (T.pack (show err))

132 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))

142 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))

143+

144+evalRODatabaseContextOp sessionId conn ShowAtomFunctions = do

145+ eRel <- C.atomFunctionsAsRelation sessionId conn

146+ case eRel of

147+ Left err -> pure $ DisplayErrorResult (T.pack (show err))

148+ Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))

149+

150+evalRODatabaseContextOp sessionId conn ShowDatabaseContextFunctions = do

151+ eRel <- C.databaseContextFunctionsAsRelation sessionId conn

152+ case eRel of

153+ Left err -> pure $ DisplayErrorResult (T.pack (show err))

154+ Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))

133

155

156+evalRODatabaseContextOp sessionId conn (ShowDataFrame dfExpr) = do

157+ eDataFrame <- C.executeDataFrameExpr sessionId conn dfExpr

158+ case eDataFrame of

159+ Left err -> pure (DisplayErrorResult (T.pack (show err)))

160+ Right dframe -> pure (DisplayDataFrameResult dframe)

161+

134evalRODatabaseContextOp _ _ Quit = pure QuitResult

162evalRODatabaseContextOp _ _ Quit = pure QuitResult

135

163

136interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> T.Text -> IO TutorialDOperatorResult

164interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> T.Text -> IO TutorialDOperatorResult

@@ -138,4 +166,45 @@ interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseCo

138 Left err -> pure $ DisplayErrorResult (T.pack (show err))

166 Left err -> pure $ DisplayErrorResult (T.pack (show err))

139 Right parsed -> evalRODatabaseContextOp sessionId conn parsed

167 Right parsed -> evalRODatabaseContextOp sessionId conn parsed

140

168

141−

169+showDataFrameP :: Parser RODatabaseContextOperator

170+showDataFrameP = do

171+ colonOp ":showdataframe"

172+ relExpr <- relExprP

173+ reservedOp "orderby"

174+ attrOrdersExpr <- attrOrdersExprP

175+ mbOffset <- optional offsetP

176+ mbLimit <- optional limitP

177+ pure $ ShowDataFrame (DF.DataFrameExpr relExpr attrOrdersExpr mbOffset mbLimit)

178+

179+

180+offsetP :: Parser Integer

181+offsetP = do

182+ reservedOp "offset"

183+ natural

184+

185+limitP :: Parser Integer

186+limitP = do

187+ reservedOp "limit"

188+ natural

189+

190+attrOrdersExprP :: Parser [DF.AttributeOrderExpr]

191+attrOrdersExprP = braces (sepBy attrOrderExprP comma)

192+

193+attrOrderExprP :: Parser DF.AttributeOrderExpr

194+attrOrderExprP = DF.AttributeOrderExpr <$> identifier <*> orderP

195+

196+orderP :: Parser DF.Order

197+orderP = 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+110−71

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

1+{-# LANGUAGE CPP #-}

1module TutorialD.Interpreter.RelationalExpr where

2module TutorialD.Interpreter.RelationalExpr where

2import Text.Megaparsec

3import Text.Megaparsec

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

5+import Control.Monad.Combinators.Expr

6+#else

3import Text.Megaparsec.Expr

7import Text.Megaparsec.Expr

8+#endif

4import ProjectM36.Base

9import ProjectM36.Base

5−import Text.Megaparsec.Text

6import TutorialD.Interpreter.Base

10import TutorialD.Interpreter.Base

7import TutorialD.Interpreter.Types

11import TutorialD.Interpreter.Types

8import qualified Data.Text as T

12import qualified Data.Text as T

@@ -11,39 +15,38 @@ import qualified Data.Map as M

11import Data.List (sort)

15import Data.List (sort)

12import ProjectM36.MiscUtils

16import ProjectM36.MiscUtils

18+--used in projection

14−class RelationalMarkerExpr a where

19+attributeListP :: RelationalMarkerExpr a => Parser (AttributeNamesBase a)

15− parseMarkerP :: Parser a

20+attributeListP =

21+ (reservedOp "all but" >>

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

17−instance RelationalMarkerExpr () where

24+ (reservedOp "all from" >>

18− parseMarkerP = pure ()

25+ RelationalExprAttributeNames <$> relExprP) <|>

20−--used in projection

27+ (reservedOp "union of" >>

21−attributeListP :: Parser AttributeNames

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

22−attributeListP = do

29+

23− but <- try (string "all but " <* spaceConsumer) <|> string ""

30+ (reservedOp "intersection of" >>

24− let constructor = if but == "" then AttributeNames else InvertedAttributeNames

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

25− attrs <- sepBy identifier comma

32+

26− pure $ constructor (S.fromList attrs)

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

34+

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

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

29makeRelationP = do

37makeRelationP = do

30 reserved "relation"

38 reserved "relation"

31 attrExprs <- try (fmap Just makeAttributeExprsP) <|> pure Nothing

39 attrExprs <- try (fmap Just makeAttributeExprsP) <|> pure Nothing

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

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

41+ marker <- parseMarkerP

33− pure $ MakeRelationFromExprs attrExprs tupleExprs

42+ pure $ MakeRelationFromExprs attrExprs (TupleExprs marker tupleExprs)

35−--used in relation creation

36−makeAttributeExprsP :: RelationalMarkerExpr a => Parser [AttributeExprBase a]

37−makeAttributeExprsP = braces (sepBy attributeAndTypeNameP comma)

39−attributeAndTypeNameP :: RelationalMarkerExpr a => Parser (AttributeExprBase a)

40−attributeAndTypeNameP = AttributeAndTypeNameExpr <$> identifier <*> typeConstructorP <*> parseMarkerP

41−

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

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

43--Either Text Int

46--Either Text Int

44adTypeConstructorP :: Parser TypeConstructor

47adTypeConstructorP :: Parser TypeConstructor

45adTypeConstructorP = do

48adTypeConstructorP = do

46− tConsName <- capitalizedIdentifier

49+ tConsName <- typeConstructorNameP

47 tConsArgs <- many typeConstructorP

50 tConsArgs <- many typeConstructorP

48 pure $ ADTypeConstructor tConsName tConsArgs

51 pure $ ADTypeConstructor tConsName tConsArgs

@@ -53,27 +56,25 @@ tupleExprP = do

53 attrAssocs <- braces (sepBy tupleAtomExprP comma)

56 attrAssocs <- braces (sepBy tupleAtomExprP comma)

54 --detect duplicate attribute names

57 --detect duplicate attribute names

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

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

56− if not (null dupAttrNames) then

59+ if not (null dupAttrNames) then

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

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

58 else

61 else

59 pure (TupleExpr (M.fromList attrAssocs))

62 pure (TupleExpr (M.fromList attrAssocs))

61tupleAtomExprP :: RelationalMarkerExpr a => Parser (AttributeName, AtomExprBase a)

64tupleAtomExprP :: RelationalMarkerExpr a => Parser (AttributeName, AtomExprBase a)

62tupleAtomExprP = do

65tupleAtomExprP = do

63− attributeName <- identifier

66+ attributeName <- attributeNameP

64 atomExpr <- atomExprP

67 atomExpr <- atomExprP

65 pure (attributeName, atomExpr)

68 pure (attributeName, atomExpr)

66−

69+

67−projectP :: Parser (RelationalExprBase a -> RelationalExprBase a)

70+projectP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

68−projectP = do

69− attrs <- braces attributeListP

71+projectP = Project <$> braces attributeListP

70− pure $ Project attrs

72renameClauseP :: Parser (T.Text, T.Text)

73renameClauseP :: Parser (T.Text, T.Text)

73renameClauseP = do

74renameClauseP = do

74− oldAttr <- identifier

75+ oldAttr <- attributeNameP

75 reservedOp "as"

76 reservedOp "as"

76− newAttr <- identifier

77+ newAttr <- attributeNameP

77 pure (oldAttr, newAttr)

78 pure (oldAttr, newAttr)

79renameP :: Parser (RelationalExprBase a -> RelationalExprBase a)

80renameP :: Parser (RelationalExprBase a -> RelationalExprBase a)

@@ -82,20 +83,20 @@ renameP = do

82 renameList <- braces (sepBy renameClauseP comma)

83 renameList <- braces (sepBy renameClauseP comma)

83 case renameList of

84 case renameList of

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

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

85− renames ->

86+ renames ->

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

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

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

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

89whereClauseP = reservedOp "where" *> (Restrict <$> restrictionPredicateP)

90whereClauseP = reservedOp "where" *> (Restrict <$> restrictionPredicateP)

91−groupClauseP :: Parser (AttributeNames, T.Text)

92+groupClauseP :: RelationalMarkerExpr a => Parser (AttributeNamesBase a, T.Text)

92groupClauseP = do

93groupClauseP = do

93 attrs <- braces attributeListP

94 attrs <- braces attributeListP

94 reservedOp "as"

95 reservedOp "as"

95− newAttrName <- identifier

96+ newAttrName <- attributeNameP

96 pure (attrs, newAttrName)

97 pure (attrs, newAttrName)

98−groupP :: Parser (RelationalExprBase a -> RelationalExprBase a)

99+groupP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

99groupP = do

100groupP = do

100 reservedOp "group"

101 reservedOp "group"

101 (groupAttrList, groupAttrName) <- parens groupClauseP

102 (groupAttrList, groupAttrName) <- parens groupClauseP

@@ -105,14 +106,29 @@ groupP = do

105ungroupP :: Parser (RelationalExprBase a -> RelationalExprBase a)

106ungroupP :: Parser (RelationalExprBase a -> RelationalExprBase a)

106ungroupP = do

107ungroupP = do

107 reservedOp "ungroup"

108 reservedOp "ungroup"

108− rvaAttrName <- identifier

109+ Ungroup <$> attributeNameP

109− pure $ Ungroup rvaAttrName

110

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

112extendP = do

113 reservedOp ":"

114− tupleExpr <- braces extendTupleExpressionP

114+ extends <- braces (sepBy extendTupleExpressionP comma)

115− return $ Extend tupleExpr

115+ case extends of

116+ [] -> pure (Restrict TruePredicate)

117+ extends' ->

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

119+

120+semijoinP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a)

121+semijoinP = do

122+ reservedOp "semijoin" <|> reservedOp "matching"

123+ pure (\exprA exprB ->

124+ Project (RelationalExprAttributeNames exprA) (Join exprA exprB))

125+

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

127+antijoinP = do

128+ reservedOp "not matching" <|> reservedOp "antijoin"

129+ pure (\exprA exprB ->

130+ Difference exprA (

131+ Project (RelationalExprAttributeNames exprA) (Join exprA exprB)))

116

132

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

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

118relOperators = [

134relOperators = [

@@ -122,17 +138,27 @@ relOperators = [

122 [Postfix groupP],

138 [Postfix groupP],

123 [Postfix ungroupP],

139 [Postfix ungroupP],

124 [InfixL (reservedOp "join" >> return Join)],

140 [InfixL (reservedOp "join" >> return Join)],

141+ [InfixL semijoinP],

142+ [InfixL antijoinP],

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

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

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

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

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

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

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

128 [Postfix extendP]

147 [Postfix extendP]

129 ]

148 ]

130

149

131relExprP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

150relExprP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

132−relExprP = makeExprParser relTerm relOperators

151+relExprP = try withMacroExprP <|> makeExprParser relTerm relOperators

152+

153+--allow for additional characters

154+attributeNameP :: Parser AttributeName

155+attributeNameP = uncapitalizedIdentifier

156+

157+relVarNameP :: Parser RelVarName

158+relVarNameP = uncapitalizedIdentifier

133

159

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

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

135−relVarP = RelationVariable <$> identifier <*> parseMarkerP

161+relVarP = RelationVariable <$> relVarNameP <*> parseMarkerP

136

162

137relTerm :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

163relTerm :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

138relTerm = parens relExprP

164relTerm = parens relExprP

@@ -153,17 +179,15 @@ restrictionPredicateP = makeExprParser predicateTerm predicateOperators

153 <|> relationalBooleanExprP

179 <|> relationalBooleanExprP

154

180

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

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

156−relationalBooleanExprP = do

182+relationalBooleanExprP =

157− relexpr <- parens relExprP <|> relTerm

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

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

159− return $ RelationalExprPredicate relexpr

184+ RelationalExprPredicate <$> (parens relExprP <|> relTerm)

160−

185+

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

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

162restrictionAttributeEqualityP = do

187restrictionAttributeEqualityP = do

163− attributeName <- identifier

188+ attributeName <- attributeNameP

164 reservedOp "="

189 reservedOp "="

165− atomexpr <- atomExprP

166− return $ AttributeEqualityPredicate attributeName atomexpr

190+ AttributeEqualityPredicate attributeName <$> atomExprP

167

191

168restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"

192restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"

169restrictionAtomExprP = do

193restrictionAtomExprP = do

@@ -178,10 +202,9 @@ extendTupleExpressionP = attributeExtendTupleExpressionP

178

202

179attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)

203attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)

180attributeExtendTupleExpressionP = do

204attributeExtendTupleExpressionP = do

181− newAttr <- identifier

205+ newAttr <- attributeNameP

182 reservedOp ":="

206 reservedOp ":="

183− atom <- atomExprP

184− return $ AttributeExtendTupleExpr newAttr atom

207+ AttributeExtendTupleExpr newAttr <$> atomExprP

185

208

186atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

209atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

187atomExprP = consumeAtomExprP True

210atomExprP = consumeAtomExprP True

@@ -191,38 +214,34 @@ consumeAtomExprP consume = try functionAtomExprP <|>

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

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

192 constructedAtomExprP consume <|>

215 constructedAtomExprP consume <|>

193 attributeAtomExprP <|>

216 attributeAtomExprP <|>

194− nakedAtomExprP <|>

217+ try nakedAtomExprP <|>

195 relationalAtomExprP

218 relationalAtomExprP

219+

196

220

197attributeAtomExprP :: Parser (AtomExprBase a)

221attributeAtomExprP :: Parser (AtomExprBase a)

198attributeAtomExprP = do

222attributeAtomExprP = do

199 _ <- string "@"

223 _ <- string "@"

200− attrName <- identifier

224+ AttributeAtomExpr <$> attributeNameP

201− return $ AttributeAtomExpr attrName

202

225

203nakedAtomExprP :: Parser (AtomExprBase a)

226nakedAtomExprP :: Parser (AtomExprBase a)

204nakedAtomExprP = NakedAtomExpr <$> atomP

227nakedAtomExprP = NakedAtomExpr <$> atomP

205

228

206constructedAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)

229constructedAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)

207constructedAtomExprP consume = do

230constructedAtomExprP consume = do

208− dConsName <- capitalizedIdentifier

231+ dConsName <- dataConstructorNameP

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

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

210− marker <- parseMarkerP

211− pure $ ConstructedAtomExpr dConsName dConsArgs marker

233+ ConstructedAtomExpr dConsName dConsArgs <$> parseMarkerP

212−

234+

213-- used only for primitive type parsing ?

235-- used only for primitive type parsing ?

214atomP :: Parser Atom

236atomP :: Parser Atom

215−atomP = stringAtomP <|>

237+atomP = stringAtomP <|>

216− doubleAtomP <|>

238+ try doubleAtomP <|>

217− integerAtomP <|>

239+ integerAtomP <|>

218 boolAtomP

240 boolAtomP

219−

241+

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

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

221−functionAtomExprP = do

243+functionAtomExprP =

222− funcName <- identifier

223− argList <- parens (sepBy atomExprP comma)

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

224− marker <- parseMarkerP

225− return $ FunctionAtomExpr funcName argList marker

226

245

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

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

228relationalAtomExprP = RelationAtomExpr <$> relExprP

247relationalAtomExprP = RelationAtomExpr <$> relExprP

@@ -230,16 +249,36 @@ relationalAtomExprP = RelationAtomExpr <$> relExprP

230stringAtomP :: Parser Atom

249stringAtomP :: Parser Atom

231stringAtomP = TextAtom <$> quotedString

250stringAtomP = TextAtom <$> quotedString

232

251

233−doubleAtomP :: Parser Atom

252+doubleAtomP :: Parser Atom

234−doubleAtomP = DoubleAtom <$> try float

253+doubleAtomP = DoubleAtom <$> float

235

254

236integerAtomP :: Parser Atom

255integerAtomP :: Parser Atom

237integerAtomP = IntegerAtom <$> integer

256integerAtomP = IntegerAtom <$> integer

238

257

239boolAtomP :: Parser Atom

258boolAtomP :: Parser Atom

240boolAtomP = do

259boolAtomP = do

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

260+ v <- identifier

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

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

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

243−

263+ else

264+ fail "invalid boolAtom"

265+

266+

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

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

245relationAtomExprP = RelationAtomExpr <$> makeRelationP

268relationAtomExprP = RelationAtomExpr <$> makeRelationP

269+

270+withMacroExprP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)

271+withMacroExprP = do

272+ reservedOp "with"

273+ views <- parens (sepBy1 createMacroP comma)

274+ With views <$> relExprP

275+

276+createMacroP :: RelationalMarkerExpr a => Parser (WithNameExprBase a, RelationalExprBase a)

277+createMacroP = do

278+ name <- identifier

279+ reservedOp "as"

280+ expr <- relExprP

281+ marker <- parseMarkerP

282+ pure (WithNameExpr name marker, expr)

283+

284+

src/bin/TutorialD/Interpreter/SchemaOperator.hs+3−5

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

1module TutorialD.Interpreter.SchemaOperator where

2import Text.Megaparsec

3−import Text.Megaparsec.Text

4−

5import ProjectM36.Base

3import ProjectM36.Base

6import ProjectM36.IsomorphicSchema

4import ProjectM36.IsomorphicSchema

7import ProjectM36.Session

5import ProjectM36.Session

@@ -44,7 +42,7 @@ isoRestrictP = do

44 reserved "isorestrict"

42 reserved "isorestrict"

45 relVarIn <- qrelVarP

43 relVarIn <- qrelVarP

46 relvarsOut <- isoRestrictOutRelVarsP

44 relvarsOut <- isoRestrictOutRelVarsP

47− IsoRestrict <$> pure relVarIn <*> restrictionPredicateP <*> pure relvarsOut

45+ IsoRestrict relVarIn <$> restrictionPredicateP <*> pure relvarsOut

49isoRestrictOutRelVarsP :: Parser (RelVarName, RelVarName)

47isoRestrictOutRelVarsP :: Parser (RelVarName, RelVarName)

50isoRestrictOutRelVarsP = (,) <$> qrelVarP <*> qrelVarP

48isoRestrictOutRelVarsP = (,) <$> qrelVarP <*> qrelVarP

@@ -57,7 +55,7 @@ isoUnionP = do

57 reserved "isounion"

55 reserved "isounion"

58 relVarsIn <- isoUnionInRelVarsP

56 relVarsIn <- isoUnionInRelVarsP

59 relVarsOut <- qrelVarP

57 relVarsOut <- qrelVarP

60− IsoUnion <$> pure relVarsIn <*> restrictionPredicateP <*> pure relVarsOut

58+ IsoUnion relVarsIn <$> restrictionPredicateP <*> pure relVarsOut

62isoRenameP :: Parser SchemaIsomorph

60isoRenameP :: Parser SchemaIsomorph

63isoRenameP = do

61isoRenameP = do

@@ -76,4 +74,4 @@ isoUnionInRelVarsP = (,) <$> qrelVarP <*> qrelVarP

76evalSchemaOperator :: SessionId -> Connection -> SchemaOperator -> IO (Either RelationalError ())

74evalSchemaOperator :: SessionId -> Connection -> SchemaOperator -> IO (Either RelationalError ())

77evalSchemaOperator sessionId conn (ModifySchemaExpr expr) = executeSchemaExpr sessionId conn expr

75evalSchemaOperator sessionId conn (ModifySchemaExpr expr) = executeSchemaExpr sessionId conn expr

78evalSchemaOperator sessionId conn (SetCurrentSchema sname) = setCurrentSchemaName sessionId conn sname

76evalSchemaOperator sessionId conn (SetCurrentSchema sname) = setCurrentSchemaName sessionId conn sname

79−

77+

src/bin/TutorialD/Interpreter/TransGraphRelationalOperator.hs+5−9

@@ -1,21 +1,19 @@

1−{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

1+{-# LANGUAGE FlexibleInstances #-}

2{-# OPTIONS_GHC -fno-warn-orphans #-}

3module TutorialD.Interpreter.TransGraphRelationalOperator where

4import ProjectM36.TransGraphRelationalExpression

5import ProjectM36.TransactionGraph

6+import TutorialD.Interpreter.Types

6import qualified ProjectM36.Client as C

7import qualified ProjectM36.Client as C

8import TutorialD.Interpreter.Base

9import TutorialD.Interpreter.Base

9import TutorialD.Interpreter.RelationalExpr

10import TutorialD.Interpreter.RelationalExpr

11−import Text.Megaparsec

12−import Text.Megaparsec.Text

13−

14import qualified Data.Text as T

12import qualified Data.Text as T

16instance RelationalMarkerExpr TransactionIdLookup where

14instance RelationalMarkerExpr TransactionIdLookup where

17 parseMarkerP = string "@" *> transactionIdLookupP

15 parseMarkerP = string "@" *> transactionIdLookupP

18−

16+

19newtype TransGraphRelationalOperator = ShowTransGraphRelation TransGraphRelationalExpr

17newtype TransGraphRelationalOperator = ShowTransGraphRelation TransGraphRelationalExpr

20 deriving Show

18 deriving Show

@@ -29,9 +27,7 @@ transactionIdHeadBacktrackP = (string "~" *> (TransactionIdHeadParentBacktrack <

29 (string "@" *> (TransactionStampHeadBacktrack <$> utcTimeP))

27 (string "@" *> (TransactionStampHeadBacktrack <$> utcTimeP))

31backtrackP :: Parser Int

29backtrackP :: Parser Int

32−backtrackP = do

33− steps <- integer <|> pure 1

30+backtrackP = fromIntegral <$> integer <|> pure 1

34− pure (fromIntegral steps)

36transGraphRelationalOpP :: Parser TransGraphRelationalOperator

32transGraphRelationalOpP :: Parser TransGraphRelationalOperator

37transGraphRelationalOpP = showTransGraphRelationalOpP

33transGraphRelationalOpP = showTransGraphRelationalOpP

@@ -47,4 +43,4 @@ evalTransGraphRelationalOp sessionId conn (ShowTransGraphRelation expr) = do

47 case res of

43 case res of

48 Left err -> pure $ DisplayErrorResult $ T.pack (show err)

44 Left err -> pure $ DisplayErrorResult $ T.pack (show err)

49 Right rel -> pure $ DisplayRelationResult rel

45 Right rel -> pure $ DisplayRelationResult rel

50−

46+

src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+20−20

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

1{-# LANGUAGE GADTs #-}

2module TutorialD.Interpreter.TransactionGraphOperator where

3import TutorialD.Interpreter.Base

4−import Text.Megaparsec.Text

5−import Text.Megaparsec

6import ProjectM36.TransactionGraph hiding (autoMergeToHead)

4import ProjectM36.TransactionGraph hiding (autoMergeToHead)

7−import ProjectM36.Client

5+import ProjectM36.Client as C

8import ProjectM36.Base

6import ProjectM36.Base

7+import ProjectM36.Relation (relationTrue)

8+import Data.Functor

10data ConvenienceTransactionGraphOperator = AutoMergeToHead MergeStrategy HeadName

11 deriving (Show)

@@ -21,14 +21,12 @@ autoMergeToHeadP = do

21jumpToHeadP :: Parser TransactionGraphOperator

22jumpToHeadP = do

23 reservedOp ":jumphead"

24− headid <- identifier

24+ JumpToHead <$> identifier

25− return $ JumpToHead headid

27jumpToTransactionP :: Parser TransactionGraphOperator

26jumpToTransactionP :: Parser TransactionGraphOperator

28jumpToTransactionP = do

27jumpToTransactionP = do

29 reservedOp ":jump"

28 reservedOp ":jump"

30− uuid <- uuidP

29+ JumpToTransaction <$> uuidP

31− return $ JumpToTransaction uuid

33walkBackToTimeP :: Parser TransactionGraphOperator

31walkBackToTimeP :: Parser TransactionGraphOperator

34walkBackToTimeP = do

32walkBackToTimeP = do

@@ -38,8 +36,7 @@ walkBackToTimeP = do

38branchTransactionP :: Parser TransactionGraphOperator

36branchTransactionP :: Parser TransactionGraphOperator

39branchTransactionP = do

37branchTransactionP = do

40 reservedOp ":branch"

38 reservedOp ":branch"

41− branchName <- identifier

39+ Branch <$> identifier

42− return $ Branch branchName

44deleteBranchP :: Parser TransactionGraphOperator

41deleteBranchP :: Parser TransactionGraphOperator

45deleteBranchP = do

42deleteBranchP = do

@@ -62,23 +59,21 @@ showGraphP = do

62 return ShowGraph

59 return ShowGraph

64mergeTransactionStrategyP :: Parser MergeStrategy

61mergeTransactionStrategyP :: Parser MergeStrategy

65−mergeTransactionStrategyP = (reserved "union" *> pure UnionMergeStrategy) <|>

62+mergeTransactionStrategyP = (reserved "union" $> UnionMergeStrategy) <|>

66 (do

63 (do

67 reserved "selectedbranch"

64 reserved "selectedbranch"

68− branch <- identifier

69− pure (SelectedBranchMergeStrategy branch)) <|>

65+ SelectedBranchMergeStrategy <$> identifier) <|>

70 (do

66 (do

71 reserved "unionpreferbranch"

67 reserved "unionpreferbranch"

72− branch <- identifier

73− pure (UnionPreferMergeStrategy branch))

68+ UnionPreferMergeStrategy <$> identifier)

75mergeTransactionsP :: Parser TransactionGraphOperator

70mergeTransactionsP :: Parser TransactionGraphOperator

76mergeTransactionsP = do

71mergeTransactionsP = do

77 reservedOp ":mergetrans"

72 reservedOp ":mergetrans"

78− strategy <- mergeTransactionStrategyP

73+ MergeTransactions <$> mergeTransactionStrategyP <*> identifier <*> identifier

79− headA <- identifier

74+

80− headB <- identifier

75+validateMerkleHashesP :: Parser ROTransactionGraphOperator

81− pure (MergeTransactions strategy headA headB)

76+validateMerkleHashesP = reservedOp ":validatemerklehashes" $> ValidateMerkleHashes

83transactionGraphOpP :: Parser TransactionGraphOperator

78transactionGraphOpP :: Parser TransactionGraphOperator

84transactionGraphOpP =

79transactionGraphOpP =

@@ -92,7 +87,7 @@ transactionGraphOpP =

92 <|> mergeTransactionsP

87 <|> mergeTransactionsP

94roTransactionGraphOpP :: Parser ROTransactionGraphOperator

89roTransactionGraphOpP :: Parser ROTransactionGraphOperator

95−roTransactionGraphOpP = showGraphP

90+roTransactionGraphOpP = showGraphP <|> validateMerkleHashesP

@@ -110,6 +105,11 @@ interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instri

110

105

111evalROGraphOp :: SessionId -> Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)

106evalROGraphOp :: SessionId -> Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)

112evalROGraphOp sessionId conn ShowGraph = transactionGraphAsRelation sessionId conn

107evalROGraphOp sessionId conn ShowGraph = transactionGraphAsRelation sessionId conn

108+evalROGraphOp sessionId conn ValidateMerkleHashes = do

109+ eVal <- C.validateMerkleHashes sessionId conn

110+ case eVal of

111+ Left err -> pure (Left err)

112+ Right _ -> pure (Right relationTrue)

113

114evalConvenienceGraphOp :: SessionId -> Connection -> ConvenienceTransactionGraphOperator -> IO (Either RelationalError ())

115−evalConvenienceGraphOp sessionId conn (AutoMergeToHead strat head') = autoMergeToHead sessionId conn strat head'

115+evalConvenienceGraphOp sessionId conn (AutoMergeToHead strat head') = autoMergeToHead sessionId conn strat head'

src/bin/TutorialD/Interpreter/Types.hs+32−21

@@ -1,49 +1,60 @@

1--parse type and data constructors

2module TutorialD.Interpreter.Types where

3import ProjectM36.Base

4−import Text.Megaparsec.Text

5import Text.Megaparsec

4import Text.Megaparsec

6import TutorialD.Interpreter.Base

5import TutorialD.Interpreter.Base

7−import ProjectM36.DataTypes.Primitive

8−import qualified Data.Text as T

7+class RelationalMarkerExpr a where

8+ parseMarkerP :: Parser a

10+instance RelationalMarkerExpr () where

11+ parseMarkerP = pure ()

12+

13+typeConstructorNameP :: Parser TypeConstructorName

14+typeConstructorNameP = capitalizedIdentifier

15+

16+dataConstructorNameP :: Parser DataConstructorName

17+dataConstructorNameP = capitalizedIdentifier

10-- | Upper case names are type names while lower case names are polymorphic typeconstructor arguments.

19-- | Upper case names are type names while lower case names are polymorphic typeconstructor arguments.

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

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

12typeConstructorDefP :: Parser TypeConstructorDef

21typeConstructorDefP :: Parser TypeConstructorDef

13−typeConstructorDefP = ADTypeConstructorDef <$> capitalizedIdentifier <*> typeVarNamesP

22+typeConstructorDefP = ADTypeConstructorDef <$> typeConstructorNameP <*> typeVarNamesP

15typeVarNamesP :: Parser [TypeVarName]

24typeVarNamesP :: Parser [TypeVarName]

16typeVarNamesP = many uncapitalizedIdentifier

25typeVarNamesP = many uncapitalizedIdentifier

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

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

19dataConstructorDefP :: Parser DataConstructorDef

28dataConstructorDefP :: Parser DataConstructorDef

20−dataConstructorDefP = DataConstructorDef <$> capitalizedIdentifier <*> many dataConstructorDefArgP

29+dataConstructorDefP = DataConstructorDef <$> typeConstructorNameP <*> many dataConstructorDefArgP

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

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

23dataConstructorDefArgP :: Parser DataConstructorDefArg

32dataConstructorDefArgP :: Parser DataConstructorDefArg

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

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

25− DataConstructorDefTypeConstructorArg <$> typeConstructorP <|>

26 DataConstructorDefTypeVarNameArg <$> uncapitalizedIdentifier

34 DataConstructorDefTypeVarNameArg <$> uncapitalizedIdentifier

28−--built-in, nullary type constructors

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

29−-- Int, Text, etc.

30−primitiveTypeConstructorP :: Parser TypeConstructor

37+relationTypeConstructorP :: Parser TypeConstructor

31−primitiveTypeConstructorP = choice (map (\(PrimitiveTypeConstructorDef name typ, _) -> do

38+relationTypeConstructorP = do

32− tName <- try $ symbol (T.unpack name)

39+ reserved "relation"

33− pure $ PrimitiveTypeConstructor tName typ)

40+ RelationAtomTypeConstructor <$> makeAttributeExprsP

34− primitiveTypeConstructorMapping)

41+

42+--used in relation creation

43+makeAttributeExprsP :: RelationalMarkerExpr a => Parser [AttributeExprBase a]

44+makeAttributeExprsP = braces (sepBy attributeAndTypeNameP comma)

45+

46+attributeAndTypeNameP :: RelationalMarkerExpr a => Parser (AttributeExprBase a)

47+attributeAndTypeNameP = AttributeAndTypeNameExpr <$> identifier <*> typeConstructorP <*> parseMarkerP

36-- *Either Int Text*, *Int*

49-- *Either Int Text*, *Int*

37typeConstructorP :: Parser TypeConstructor

50typeConstructorP :: Parser TypeConstructor

38−typeConstructorP = primitiveTypeConstructorP <|>

51+typeConstructorP = relationTypeConstructorP <|>

39− TypeVariable <$> uncapitalizedIdentifier <|>

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

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

41− monoTypeConstructorP)

53+ monoTypeConstructorP

43monoTypeConstructorP :: Parser TypeConstructor

55monoTypeConstructorP :: Parser TypeConstructor

44−monoTypeConstructorP = primitiveTypeConstructorP <|>

45− ADTypeConstructor <$> capitalizedIdentifier <*> pure [] <|>

56+monoTypeConstructorP = ADTypeConstructor <$> typeConstructorNameP <*> pure [] <|>

46− TypeVariable <$> uncapitalizedIdentifier

57+ TypeVariable <$> uncapitalizedIdentifier

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 as A 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 == mempty && null (asList tupSet) = "false"

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

65+ pretty (Relation attrs tupSet) = "relation" <> prettyBracesList (A.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 (A.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 (A.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/bin/TutorialD/tutd.hs+24−17

@@ -5,58 +5,58 @@ import ProjectM36.Client

5import ProjectM36.Server.ParseArgs

6import ProjectM36.Server

7import System.IO

8+import GHC.IO.Encoding

8import Options.Applicative

9import Options.Applicative

9import System.Exit

10import System.Exit

11+import Control.Monad

12+#if __GLASGOW_HASKELL__ < 804

10import Data.Monoid

13import Data.Monoid

14+#endif

11import Data.Maybe

15import Data.Maybe

12import qualified Data.Text as T

16import qualified Data.Text as T

18+#if !defined(VERSION_project_m36)

19+# warning Failed to discover proper version from cabal_macros.h

20+# define VERSION_project_m36 "<unknown>"

21+#endif

22+

14parseArgs :: Parser InterpreterConfig

23parseArgs :: Parser InterpreterConfig

15parseArgs = LocalInterpreterConfig <$> parsePersistenceStrategy <*> parseHeadName <*> parseTutDExec <*> many parseGhcPkgPath <*> parseCheckFS <|>

24parseArgs = LocalInterpreterConfig <$> parsePersistenceStrategy <*> parseHeadName <*> parseTutDExec <*> many parseGhcPkgPath <*> parseCheckFS <|>

16− RemoteInterpreterConfig <$> parseNodeId <*> parseDatabaseName <*> parseHeadName <*> parseTutDExec <*> parseCheckFS

25+ RemoteInterpreterConfig <$> parseHostname "127.0.0.1" <*> parsePort defaultServerPort <*> parseDatabaseName <*> parseHeadName <*> parseTutDExec <*> parseCheckFS

18parseHeadName :: Parser HeadName

27parseHeadName :: Parser HeadName

19parseHeadName = option auto (long "head" <>

28parseHeadName = option auto (long "head" <>

20 help "Start session at head name." <>

29 help "Start session at head name." <>

30+ metavar "GRAPH HEAD NAME" <>

21 value "master"

31 value "master"

22 )

32 )

24−parseNodeId :: Parser NodeId

25−parseNodeId = createNodeId <$>

26− strOption (long "host" <>

27− short 'h' <>

28− help "Remote host name" <>

29− value "127.0.0.1") <*>

30− option auto (long "port" <>

31− short 'p' <>

32− help "Remote port" <>

33− value defaultServerPort)

34−

35--just execute some tutd and exit

34--just execute some tutd and exit

36parseTutDExec :: Parser (Maybe TutorialDExec)

35parseTutDExec :: Parser (Maybe TutorialDExec)

37parseTutDExec = optional $ strOption (long "exec-tutd" <>

36parseTutDExec = optional $ strOption (long "exec-tutd" <>

38 short 'e' <>

37 short 'e' <>

38+ metavar "TUTORIALD" <>

39 help "Execute TutorialD expression and exit"

40 )

42opts :: ParserInfo InterpreterConfig

43−opts = info parseArgs idm

43+opts = info (parseArgs <**> helpOption) idm

45connectionInfoForConfig :: InterpreterConfig -> ConnectionInfo

46connectionInfoForConfig (LocalInterpreterConfig pStrategy _ _ ghcPkgPaths _) = InProcessConnectionInfo pStrategy outputNotificationCallback ghcPkgPaths

47−connectionInfoForConfig (RemoteInterpreterConfig remoteNodeId remoteDBName _ _ _) = RemoteProcessConnectionInfo remoteDBName remoteNodeId outputNotificationCallback

47+connectionInfoForConfig (RemoteInterpreterConfig remoteHost remotePort remoteDBName _ _ _) = RemoteConnectionInfo remoteDBName remoteHost (show remotePort) outputNotificationCallback

49headNameForConfig :: InterpreterConfig -> HeadName

50headNameForConfig (LocalInterpreterConfig _ headn _ _ _) = headn

51−headNameForConfig (RemoteInterpreterConfig _ _ headn _ _) = headn

51+headNameForConfig (RemoteInterpreterConfig _ _ _ headn _ _) = headn

53execTutDForConfig :: InterpreterConfig -> Maybe String

54execTutDForConfig (LocalInterpreterConfig _ _ t _ _) = t

55−execTutDForConfig (RemoteInterpreterConfig _ _ _ t _) = t

55+execTutDForConfig (RemoteInterpreterConfig _ _ _ _ t _) = t

57checkFSForConfig :: InterpreterConfig -> Bool

58checkFSForConfig (LocalInterpreterConfig _ _ _ _ c) = c

59−checkFSForConfig (RemoteInterpreterConfig _ _ _ _ c) = c

59+checkFSForConfig (RemoteInterpreterConfig _ _ _ _ _ c) = c

61persistenceStrategyForConfig :: InterpreterConfig -> Maybe PersistenceStrategy

62persistenceStrategyForConfig (LocalInterpreterConfig strat _ _ _ _) = Just strat

@@ -75,8 +75,15 @@ printWelcome = do

75 putStrLn "A full tutorial is available at:"

76 putStrLn "https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown"

78+-- | If the locale is set to ASCII, upgrade it to UTF-8 because tutd outputs UTF-8-encoded attributes. This is especially important in light docker images where the locale data may be missing.

79+setLocaleIfNecessary :: IO ()

80+setLocaleIfNecessary = do

81+ l <- getLocaleEncoding

82+ when (textEncodingName l == "ASCII") (setLocaleEncoding utf8)

83+

78main :: IO ()

84main :: IO ()

79main = do

85main = do

86+ setLocaleIfNecessary

80 interpreterConfig <- execParser opts

87 interpreterConfig <- execParser opts

81 let connInfo = connectionInfoForConfig interpreterConfig

88 let connInfo = connectionInfoForConfig interpreterConfig

82 fscheck <- checkFSType (checkFSForConfig interpreterConfig) (fromMaybe NoPersistence (persistenceStrategyForConfig interpreterConfig))

89 fscheck <- checkFSType (checkFSForConfig interpreterConfig) (fromMaybe NoPersistence (persistenceStrategyForConfig interpreterConfig))

src/bin/benchmark/Basic.hsnew file+106

@@ -0,0 +1,106 @@

1+import ProjectM36.Base

2+import Criterion.Main

3+import qualified ProjectM36.Attribute as A

4+import ProjectM36.Relation

5+import ProjectM36.Persist

6+import ProjectM36.RelationalExpression

7+import ProjectM36.Error

8+import ProjectM36.Transaction.Persist

9+import qualified Data.Text as T

10+import qualified Data.Vector as V

11+import Control.Monad.Trans.Reader

12+import qualified ProjectM36.DatabaseContext as DBC

13+import qualified Data.Set as S

14+import Data.Monoid

15+import System.IO.Temp

16+import System.FilePath

17+import System.Directory

18+

19+{-

20+* create a relation

21+* restrict a relation

22+* project a relation

23+* join two relations

24+-}

25+

26+validate :: Either RelationalError a -> a

27+validate (Left err) = error (show err)

28+validate (Right x) = x

29+

30+createRelation :: Int -> Int -> Either RelationalError Relation

31+createRelation attributeCount tupleCount = do

32+ let attrs = A.attributesFromList $ map (\c-> Attribute (T.pack $ "a" ++ show c) IntAtomType) [0 .. attributeCount-1]

33+ tuple tupleX = RelationTuple attrs (V.generate attributeCount (\_ -> IntAtom (fromIntegral tupleX)))

34+ tuples = map tuple [0 .. tupleCount]

35+ mkRelationDeferVerify attrs (RelationTupleSet tuples)

36+

37+createRelation' :: Int -> Int -> Relation

38+createRelation' x y = validate (createRelation x y)

39+

40+restrictRelationToOneTuple :: Int -> Relation -> Relation

41+restrictRelationToOneTuple match rel = validate (runReader (evalRelationalExpr restriction) exprState)

42+ where

43+ exprState = mkRelationalExprState DBC.empty

44+ restriction = Restrict predicateMatch (ExistingRelation rel)

45+ predicateMatch = AttributeEqualityPredicate "a0" (NakedAtomExpr (IntAtom match))

46+

47+restrictRelationToHalfRelation :: Int -> Relation -> Relation

48+restrictRelationToHalfRelation cutoff rel = validate (runReader (evalRelationalExpr restriction) exprState)

49+ where

50+ exprState = mkRelationalExprState DBC.basicDatabaseContext

51+ restriction = Restrict predicateMatch (ExistingRelation rel)

52+ predicateMatch = AtomExprPredicate (FunctionAtomExpr "lte" [AttributeAtomExpr "a0", NakedAtomExpr (IntAtom cutoff)] ())

53+

54+projectRelationToAttributes :: AttributeNames -> Relation -> Relation

55+projectRelationToAttributes attrNames rel = validate (runReader (evalRelationalExpr projection) exprState)

56+ where

57+ exprState = mkRelationalExprState DBC.empty

58+ projection = Project attrNames (ExistingRelation rel)

59+

60+unionRelations :: Relation -> Relation -> Relation

61+unionRelations relA relB = validate (relA `union` relB)

62+

63+joinRelations :: Relation -> Relation -> Relation

64+joinRelations relA relB = validate (join relA relB)

65+

66+groupRelation :: AttributeNames -> Relation -> Relation

67+groupRelation attrNames rel = validate (runReader (evalRelationalExpr (Group attrNames "x" (ExistingRelation rel))) exprState)

68+ where

69+ exprState = mkRelationalExprState DBC.empty

70+

71+bigRelAttrNames :: Int -> Int -> AttributeNames

72+bigRelAttrNames start end = AttributeNames (S.fromList (map (\i -> "a" <> T.pack (show i)) [start .. end]))

73+

74+main :: IO ()

75+main = do

76+ tmpDir <- getCanonicalTemporaryDirectory

77+ createDirectoryIfMissing False (tmpDir </> "relvars")

78+ defaultMain [createRel, restrictRel, projectRel, unionRel, joinRel, groupRel, writeRel tmpDir]

79+ where

80+ createRel = bgroup "create" $ map (\tupCount -> bench ("relation 10x" ++ show tupCount) (nf (createRelation' 10) tupCount)) [100, 1000, 10000]

81+ bigrel10000 = createRelation' 10 10000

82+ bigrel1000 = createRelation' 10 1000

83+ bigrel100 = createRelation' 10 100

84+

85+ restrictRel = bgroup "restrict" [restrictOneTupleRel, restrictHalfTuplesRel]

86+ restrictOneTupleRel = bench "restrict relation 10x10000 to 10x1" (nf (restrictRelationToOneTuple 5000) bigrel10000)

87+ restrictHalfTuplesRel = bench "restrict relation 10x10000 to 10x5000" (nf (restrictRelationToHalfRelation 5000) bigrel10000)

88+

89+ projectRel = bgroup "project" [projectOneAttr, projectHalfAttrs]

90+ projectOneAttr = bench "project 10x1000 to 1x1000" (nf (projectRelationToAttributes (bigRelAttrNames 0 0)) bigrel1000)

91+ projectHalfAttrs = bench "project 10x1000 to 5x1000" (nf (projectRelationToAttributes (bigRelAttrNames 0 4)) bigrel1000)

92+

93+ unionRel = bgroup "union" [unionIdenticalRelations1000, unionIdenticalRelations10000]

94+ unionIdenticalRelations1000 = bench "union identical 10x1000" (nf (unionRelations bigrel1000) bigrel1000)

95+ unionIdenticalRelations10000 = bench "union identical 10x10000" (nf (unionRelations bigrel10000) bigrel10000)

96+

97+ joinRel = bgroup "join" [joinIdenticalRelations100]

98+ joinIdenticalRelations100 = bench "join identical 10x100" (nf (joinRelations bigrel100) bigrel100)

99+

100+ groupRel = bgroup "group" [group100]

101+ group100 = bench "group 10x100" (nf (groupRelation (bigRelAttrNames 1 9)) bigrel100)

102+

103+ writeRel tmpDir = bgroup "write" [writeRel10000 tmpDir]

104+ writeRel10000 tmpDir = bench "write 10x1000" $ nfIO (writeRelVar FsyncDiskSync tmpDir ("x", bigrel10000))

105+

106+

src/bin/benchmark/Handles.hs+27−38

@@ -1,19 +1,20 @@

1{-# LANGUAGE CPP #-}

2--benchmark test for file handle leaks

3import ProjectM36.Client

4+import ProjectM36.Persist

4import Options.Applicative

5import Options.Applicative

5import TutorialD.Interpreter

6import TutorialD.Interpreter

6−import TutorialD.Interpreter.Base

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

7import qualified Data.Text as T

8import qualified Data.Text as T

8−import Text.Megaparsec hiding (option)

9+#if __GLASGOW_HASKELL__ < 804

9import Data.Monoid

10import Data.Monoid

10−import System.Directory

11+#endif

11import Control.Monad

12import Control.Monad

13data HandlesArgs = HandlesArgs {

14data HandlesArgs = HandlesArgs {

14 openCloseCount :: Int,

15 openCloseCount :: Int,

15 transactionCount :: Int,

16 transactionCount :: Int,

16− dbdir :: FilePath,

17+ dbdir :: FilePath,

17 tutdSetup :: String,

18 tutdSetup :: String,

18 tutdIterate :: String

19 tutdIterate :: String

19 }

20 }

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

39main :: IO ()

40main :: IO ()

40main = do

41main = do

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

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

42− replicateM_ (openCloseCount args) (runOpenClose

43+ replicateM_ (openCloseCount args) (runOpenClose

43 (T.pack (tutdSetup args))

44 (T.pack (tutdSetup args))

44 (T.pack (tutdIterate args))

45 (T.pack (tutdIterate args))

45− (transactionCount args)

46+ (transactionCount args)

46 (dbdir args))

47 (dbdir args))

47−

48+

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

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

49runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do

50runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do

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

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

51 eConn <- connectProjectM36 connInfo

52 eConn <- connectProjectM36 connInfo

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

55 eSess <- createSessionAtHead conn "master"

56 eSess <- createSessionAtHead conn "master"

56 case eSess of

57 case eSess of

57 Left err -> error (show err)

58 Left err -> error (show err)

58− Right session ->

59+ Right session ->

59 --database setup

60 --database setup

60 case parseTutorialD tutdSetup' of

61 case parseTutorialD tutdSetup' of

61 Left err -> error (show err)

62 Left err -> error (show err)

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

63 res <- evalTutorialD session conn UnsafeEvaluation parsed

64 res <- evalTutorialD session conn UnsafeEvaluation parsed

64 case res of

65 case res of

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

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

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

67+ DisplayParseErrorResult _ err ->

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

69+ error (errorBundlePretty err)

70+#else

71+ error (parseErrorPretty err)

72+#endif

67− _ -> do

73+ _ -> do

68 replicateM_ tCount (runTransaction tutdIterate' session conn)

74 replicateM_ tCount (runTransaction tutdIterate' session conn)

69 close conn

75 close conn

70 printFdCount

76 printFdCount

71−

77+

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

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

73−runTransaction tutdIterate' sess conn =

79+runTransaction tutdIterate' sess conn =

74 --run tutd on every iteration

80 --run tutd on every iteration

75 case parseTutorialD tutdIterate' of

81 case parseTutorialD tutdIterate' of

76 Left err -> error (show err)

82 Left err -> error (show err)

@@ -78,31 +84,14 @@ runTransaction tutdIterate' sess conn =

78 res <- evalTutorialD sess conn UnsafeEvaluation parsed

84 res <- evalTutorialD sess conn UnsafeEvaluation parsed

79 case res of

85 case res of

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

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

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

87+ DisplayParseErrorResult _ err ->

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

89+ error (errorBundlePretty err)

90+#else

91+ error (parseErrorPretty err)

92+#endif

82− _ -> do

93+ _ -> do

83− eErr <- commit sess conn

94+ eErr <- commit sess conn

84 case eErr of

95 case eErr of

85 Left err -> error (show err)

96 Left err -> error (show err)

86 Right _ -> printFdCount

97 Right _ -> printFdCount

87−

88−--prints out number of consumed file descriptors

89−printFdCount :: IO ()

90−#if defined(linux_HOST_OS)

91−printFdCount = do

92− fdc <- fdCount

93− putStrLn ("Fd count: " ++ show fdc)

94− --getLine >> pure ()

95−#else

96−printFdCount = putStrLn "Fd count not supported on this OS."

97−#endif

98−

99−

100−fdCount :: IO Int

101−#if defined(linux_HOST_OS)

102−fdCount = do

103− fds <- getDirectoryContents "/proc/self/fd"

104− pure ((length fds) - 2)

105−#else

106−--not supported on non-linux

107−fdCount = pure 0

108−#endif

src/bin/benchmark/bigrel.hs+42−19

@@ -1,33 +1,39 @@

1−{-# LANGUAGE FlexibleInstances #-}

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

2{-# OPTIONS_GHC -fno-warn-orphans #-}

3import ProjectM36.Base

4import ProjectM36.Relation

5import ProjectM36.DateExamples

6import ProjectM36.Error

7+import ProjectM36.StaticOptimizer

7import qualified ProjectM36.Attribute as A

8import qualified ProjectM36.Attribute as A

8import qualified Data.Text as T

9import qualified Data.Text as T

9−import ProjectM36.Relation.Show.CSV

10+--import ProjectM36.Relation.Show.CSV

10import ProjectM36.Relation.Show.HTML

11import ProjectM36.Relation.Show.HTML

11−import TutorialD.Interpreter.DatabaseContextExpr (interpretDatabaseContextExpr)

12import ProjectM36.RelationalExpression

13+import ProjectM36.TransactionGraph

13−import qualified Data.HashSet as HS

14+--import qualified Data.HashSet as HS

14−import qualified Data.ByteString.Lazy.Char8 as BS

15+--import qualified Data.ByteString.Lazy.Char8 as BS

15−import qualified Data.IntMap as IM

16+--import qualified Data.IntMap as IM

16−import qualified Data.Hashable as Hash

17+--import qualified Data.Hashable as Hash

17import qualified Data.Vector as V

18import qualified Data.Vector as V

18import Options.Applicative

19import Options.Applicative

19−import qualified Data.Map as M

20import qualified Data.Text.IO as TIO

21import System.IO

22−import Control.Monad.State

23import Control.DeepSeq

22import Control.DeepSeq

24import Data.Text hiding (map)

23import Data.Text hiding (map)

24+import Data.Time.Clock

25+import Data.UUID.V4

26+#if __GLASGOW_HASKELL__ < 804

25import Data.Monoid

27import Data.Monoid

28+#endif

30+

31+{-

27dumpcsv :: Relation -> IO ()

32dumpcsv :: Relation -> IO ()

28dumpcsv rel = case relationAsCSV rel of

33dumpcsv rel = case relationAsCSV rel of

29 Left err -> hPrint stderr err

34 Left err -> hPrint stderr err

30 Right bsData -> BS.putStrLn bsData

35 Right bsData -> BS.putStrLn bsData

36+-}

32data BigrelArgs = BigrelArgs Int Int Text

38data BigrelArgs = BigrelArgs Int Int Text

@@ -58,46 +64,63 @@ matrixRun (BigrelArgs attributeCount tupleCount tutd) =

58 Right rel -> if tutd == "" then

64 Right rel -> if tutd == "" then

59 putStrLn "Done."

65 putStrLn "Done."

60 else do

66 else do

67+ now <- getCurrentTime

68+ tid <- nextRandom

61 let setx = Assign "x" (ExistingRelation (force rel))

69 let setx = Assign "x" (ExistingRelation (force rel))

62− (context,_,_) = execState (evalDatabaseContextExpr setx) (freshDatabaseState dateExamples)

70+ graph = bootstrapTransactionGraph now tid dateExamples

63− interpreted = interpretDatabaseContextExpr context tutd

71+ env = mkDatabaseContextEvalEnv tid graph

72+ eNewState = runDatabaseContextEvalMonad dateExamples env (optimizeAndEvalDatabaseContextExpr True setx)

64 --plan = interpretRODatabaseContextOp context $ ":showplan " ++ tutd

73 --plan = interpretRODatabaseContextOp context $ ":showplan " ++ tutd

65 --displayOpResult plan

74 --displayOpResult plan

66− case interpreted of

75+ case eNewState of

76+ Right newState -> do

77+ let ctx = dbc_context newState

78+ Right x = optimizeAndEvalRelationalExpr env' (RelationVariable "x" ())

79+ env' = RelationalExprEnv ctx graph Nothing

67− Right context' -> TIO.putStrLn $ relationAsHTML (relationVariables context' M.! "x")

80+ TIO.putStrLn $ relationAsHTML x

68 Left err -> hPrint stderr err

81 Left err -> hPrint stderr err

70−

83+{-

71intmapMatrixRun :: IO ()

84intmapMatrixRun :: IO ()

72intmapMatrixRun = do

85intmapMatrixRun = do

73 let matrix = intmapMatrixRelation 100 100000

86 let matrix = intmapMatrixRelation 100 100000

74 print matrix

87 print matrix

88+-}

76--compare IntMap speed and size

90--compare IntMap speed and size

77--this is about 3 times faster (9 minutes) for 10x100000 and uses 800 MB

91--this is about 3 times faster (9 minutes) for 10x100000 and uses 800 MB

92+{-

78intmapMatrixRelation :: Int -> Int -> HS.HashSet (IM.IntMap Atom)

93intmapMatrixRelation :: Int -> Int -> HS.HashSet (IM.IntMap Atom)

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

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

80 where

95 where

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

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

97+-}

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

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

100

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

101+{-

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

85−

86vectorMatrixRun :: IO ()

102vectorMatrixRun :: IO ()

87vectorMatrixRun = do

103vectorMatrixRun = do

88 let matrix = vectorMatrixRelation 100 100000

104 let matrix = vectorMatrixRelation 100 100000

89 print matrix

105 print matrix

106+-}

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

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

109+{-

110+

111

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

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

92--with IntAtom wrapper: 1m12s 90 MB

113--with IntAtom wrapper: 1m12s 90 MB

114+{-

115+

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

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

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

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

95 where

118 where

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

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

97−

120+-}

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

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

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

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

100−

123+-}

101-- returns a relation with tupleCount tuples with a set of integer attributes attributesCount long

124-- returns a relation with tupleCount tuples with a set of integer attributes attributesCount long

102-- this is useful for performance and resource usage testing

125-- this is useful for performance and resource usage testing

103matrixRelation :: Int -> Int -> Either RelationalError Relation

126matrixRelation :: Int -> Int -> Either RelationalError Relation

src/lib/ProjectM36/Arbitrary.hsnew file+127

@@ -0,0 +1,127 @@

1+{-# LANGUAGE ExistentialQuantification,FlexibleInstances,OverloadedStrings #-}

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

4+module ProjectM36.Arbitrary where

5+import ProjectM36.Base

6+import ProjectM36.Error

7+import ProjectM36.AtomFunctionError

8+import ProjectM36.AtomType

9+import ProjectM36.Attribute (atomType)

10+import ProjectM36.DataConstructorDef as DCD

11+import ProjectM36.DataTypes.Interval

12+import ProjectM36.Relation

13+import qualified Data.Vector as V

14+import Data.Text (Text)

15+import Test.QuickCheck

16+import Test.QuickCheck.Instances ()

17+import qualified Data.ByteString.Char8 as B

18+import Data.Time

19+import Control.Monad.Reader

20+

21+arbitrary' :: AtomType -> WithTCMap Gen (Either RelationalError Atom)

22+arbitrary' IntegerAtomType =

23+ Right . IntegerAtom <$> lift (arbitrary :: Gen Integer)

24+

25+arbitrary' (RelationAtomType attrs) = do

26+ tcMap <-ask

27+ maybeRel <- lift $ runReaderT (arbitraryRelation attrs (0,5)) tcMap

28+ case maybeRel of

29+ Left err -> pure $ Left err

30+ Right rel -> pure $ Right $ RelationAtom rel

31+

32+arbitrary' IntAtomType =

33+ Right . IntAtom <$> lift (arbitrary :: Gen Int)

34+

35+arbitrary' DoubleAtomType =

36+ Right . DoubleAtom <$> lift (arbitrary :: Gen Double)

37+

38+arbitrary' TextAtomType =

39+ Right . TextAtom <$> lift (arbitrary :: Gen Text)

40+

41+arbitrary' DayAtomType =

42+ Right . DayAtom <$> lift (arbitrary :: Gen Day)

43+

44+arbitrary' DateTimeAtomType =

45+ Right . DateTimeAtom <$> lift (arbitrary :: Gen UTCTime)

46+

47+arbitrary' ByteStringAtomType =

48+ Right . ByteStringAtom <$> lift (arbitrary :: Gen B.ByteString)

49+

50+arbitrary' BoolAtomType =

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

52+

53+arbitrary' RelationalExprAtomType =

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

55+

56+arbitrary' constructedAtomType@(ConstructedAtomType tcName tvMap)

57+ --special-casing for Interval type

58+ | isIntervalAtomType constructedAtomType = createArbitraryInterval (intervalSubType constructedAtomType)

59+ | otherwise = do

60+ tcMap <- ask

61+ let maybeTCons = findTypeConstructor tcName tcMap

62+ let eitherTCons = maybeToRight (NoSuchTypeConstructorName tcName) maybeTCons

63+ let eitherDCDefs = snd <$> eitherTCons

64+ let eitherGenDCDef = elements <$> eitherDCDefs

65+ case eitherGenDCDef of

66+ Left err -> pure $ Left err

67+ Right genDCDef -> do

68+ dcDef <- lift genDCDef

69+ case resolvedAtomTypesForDataConstructorDefArgs tcMap tvMap dcDef of

70+ Left err -> pure $ Left err

71+ Right atomTypes -> do

72+ let genListOfEitherAtom = mapM (\aTy->runReaderT (arbitrary' aTy) tcMap) atomTypes

73+ listOfEitherAtom <- lift genListOfEitherAtom

74+ let eitherListOfAtom = sequence listOfEitherAtom

75+ case eitherListOfAtom of

76+ Left err -> pure $ Left err

77+ Right listOfAtom -> pure $ Right $ ConstructedAtom (DCD.name dcDef) constructedAtomType listOfAtom

78+arbitrary' (TypeVariableType _) = error "arbitrary on type variable"

79+

80+maybeToRight :: b -> Maybe a -> Either b a

81+maybeToRight _ (Just x) = Right x

82+maybeToRight y Nothing = Left y

83+

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

85+arbitraryRelationTuple attris = do

86+ tcMap <- ask

87+ listOfMaybeAType <- lift $ mapM ((\aTy -> runReaderT (arbitrary' aTy) tcMap) . atomType) (V.toList (attributesVec attris))

88+ case sequence listOfMaybeAType of

89+ Left err -> pure $ Left err

90+ Right listOfAttr -> do

91+ let vectorOfAttr = V.fromList listOfAttr

92+ pure $ Right $ RelationTuple attris vectorOfAttr

93+

94+arbitraryWithRange :: Gen (Either RelationalError RelationTuple) -> Range -> Gen [Either RelationalError RelationTuple]

95+arbitraryWithRange genEitherTuple range = do

96+ num <- choose range

97+ vectorOf num genEitherTuple

98+

99+arbitraryRelation :: Attributes -> Range -> WithTCMap Gen (Either RelationalError Relation)

100+arbitraryRelation attris range = do

101+ tcMap <- ask

102+ let genEitherTuple = runReaderT (arbitraryRelationTuple attris) tcMap

103+ listOfEitherTuple <- lift $ arbitraryWithRange genEitherTuple range

104+ let eitherTupleList = sequence listOfEitherTuple

105+ case eitherTupleList of

106+ Left err -> pure $ Left err

107+ Right tupleList -> pure $ Right $ Relation attris $ RelationTupleSet tupleList

108+

109+type WithTCMap a = ReaderT TypeConstructorMapping a

110+

111+createArbitraryInterval :: AtomType -> WithTCMap Gen (Either RelationalError Atom)

112+createArbitraryInterval subType = if supportsInterval subType then do

113+ eBegin <- arbitrary' subType

114+ eEnd <- arbitrary' subType

115+ beginopen <- lift (arbitrary :: Gen Bool)

116+ endopen <- lift (arbitrary :: Gen Bool)

117+ case eBegin of

118+ Left err -> pure (Left err)

119+ Right begin ->

120+ case eEnd of

121+ Left err -> pure (Left err)

122+ Right end ->

123+ case createInterval begin end beginopen endopen of

124+ Left _ -> createArbitraryInterval subType

125+ Right val -> pure (Right val)

126+ else

127+ pure $ Left (ProjectM36.Error.AtomFunctionUserError (AtomTypeDoesNotSupportIntervalError (prettyAtomType subType)))

src/lib/ProjectM36/Atom.hs+15−10

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

1module ProjectM36.Atom where

2import ProjectM36.Base

3import ProjectM36.Error

4+import ProjectM36.DataTypes.Interval

4import qualified Data.Text as T

5import qualified Data.Text as T

5−--import Data.Time.Calendar

6+#if __GLASGOW_HASKELL__ < 804

6−--import Data.Time.Clock

7−--import Data.ByteString (ByteString)

8import Data.Monoid

7import Data.Monoid

8+#endif

10relationForAtom :: Atom -> Either RelationalError Relation

11relationForAtom (RelationAtom rel) = Right rel

@@ -15,19 +15,24 @@ atomToText :: Atom -> T.Text

15atomToText (IntegerAtom i) = (T.pack . show) i

16atomToText (IntAtom i) = (T.pack . show) i

17atomToText (DoubleAtom i) = (T.pack . show) i

18−atomToText (TextAtom i) = (T.pack . show) i --does this break quoting in CSV export?

18+atomToText (TextAtom i) = (T.pack . show) i --quotes necessary for ConstructedAtom subatoms

19atomToText (DayAtom i) = (T.pack . show) i

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

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

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

23−atomToText (IntervalAtom b e bo be) = beginp <> begin <> "," <> end <> endp

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

24− where beginp = if bo then "(" else "["

25− begin = atomToText b

26− end = atomToText e

27− endp = if be then ")" else "]"

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

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

30−atomToText (ConstructedAtom dConsName _ atoms) = dConsName <> dConsArgs

26+atomToText (ConstructedAtom dConsName typ atoms)

27+ | isIntervalAtomType typ = case atoms of --special handling for printing intervals

28+ [b, e, BoolAtom bo, BoolAtom be] ->

29+ let beginp = if bo then "(" else "["

30+ begin = atomToText b

31+ end = atomToText e

32+ endp = if be then ")" else "]" in

33+ beginp <> begin <> "," <> end <> endp

34+ _ -> "invalid interval"

35+ | otherwise = dConsName <> dConsArgs

31 where

36 where

32 parensAtomToText a@(ConstructedAtom _ _ []) = atomToText a

37 parensAtomToText a@(ConstructedAtom _ _ []) = atomToText a

33 parensAtomToText a@ConstructedAtom{} = "(" <> atomToText a <> ")"

38 parensAtomToText a@ConstructedAtom{} = "(" <> atomToText a <> ")"

src/lib/ProjectM36/AtomFunction.hs+35−1

@@ -1,11 +1,20 @@

1+{-# LANGUAGE CPP #-}

1module ProjectM36.AtomFunction where

2module ProjectM36.AtomFunction where

2import ProjectM36.Base

3import ProjectM36.Base

4+import ProjectM36.Serialise.Base ()

3import ProjectM36.Error

5import ProjectM36.Error

6+import ProjectM36.Relation

7+import ProjectM36.AtomType

4import ProjectM36.AtomFunctionError

8import ProjectM36.AtomFunctionError

9+import ProjectM36.ScriptSession

5import qualified ProjectM36.Attribute as A

10import qualified ProjectM36.Attribute as A

6import qualified Data.HashSet as HS

11import qualified Data.HashSet as HS

12+import qualified Data.Text as T

13+import qualified Data.ByteString.Lazy as BL

14+import Codec.Winery

8foldAtomFuncType :: AtomType -> AtomType -> [AtomType]

16foldAtomFuncType :: AtomType -> AtomType -> [AtomType]

17+--the underscore in the attribute name means that any attributes are acceptable

9foldAtomFuncType foldType returnType = [RelationAtomType (A.attributesFromList [Attribute "_" foldType]), returnType]

18foldAtomFuncType foldType returnType = [RelationAtomType (A.attributesFromList [Attribute "_" foldType]), returnType]

11atomFunctionForName :: AtomFunctionName -> AtomFunctions -> Either RelationalError AtomFunction

20atomFunctionForName :: AtomFunctionName -> AtomFunctions -> Either RelationalError AtomFunction

@@ -64,4 +73,29 @@ createScriptedAtomFunction funcName argsType retType = AddAtomFunction funcName

64 argsType ++ [ADTypeConstructor "Either" [

73 argsType ++ [ADTypeConstructor "Either" [

65 ADTypeConstructor "AtomFunctionError" [],

74 ADTypeConstructor "AtomFunctionError" [],

66 retType]])

75 retType]])

67−

76+

77+loadAtomFunctions :: ModName -> FuncName -> FilePath -> IO (Either LoadSymbolError [AtomFunction])

78+#ifdef PM36_HASKELL_SCRIPTING

79+loadAtomFunctions = loadFunction

80+#else

81+loadAtomFunctions _ _ _ = pure (Left LoadSymbolError)

82+#endif

83+

84+atomFunctionsAsRelation :: AtomFunctions -> Either RelationalError Relation

85+atomFunctionsAsRelation funcs = mkRelationFromList attrs tups

86+ where tups = map atomFuncToTuple (HS.toList funcs)

87+ attrs = A.attributesFromList [Attribute "name" TextAtomType,

88+ Attribute "arguments" TextAtomType]

89+ atomFuncToTuple aFunc = [TextAtom (atomFuncName aFunc),

90+ TextAtom (atomFuncTypeToText aFunc)]

91+ atomFuncTypeToText aFunc = T.intercalate " -> " (map prettyAtomType (atomFuncType aFunc))

92+

93+--for calculating the merkle hash

94+hashBytes :: AtomFunction -> BL.ByteString

95+hashBytes func = BL.fromChunks [serialise (atomFuncName func),

96+ serialise (atomFuncType func),

97+ bodyBin

98+ ]

99+ where

100+ bodyBin = case atomFuncBody func of

101+ AtomFunctionBody mScript _ -> serialise mScript

src/lib/ProjectM36/AtomFunctionError.hs+2−2

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

1{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}

2module ProjectM36.AtomFunctionError where

3−import Data.Binary

4import GHC.Generics

3import GHC.Generics

5import Control.DeepSeq

4import Control.DeepSeq

6import Data.Text

5import Data.Text

@@ -9,9 +8,10 @@ data AtomFunctionError = AtomFunctionUserError String |

9 AtomFunctionTypeMismatchError |

8 AtomFunctionTypeMismatchError |

10 InvalidIntervalOrderingError |

9 InvalidIntervalOrderingError |

11 InvalidIntervalBoundariesError |

10 InvalidIntervalBoundariesError |

11+ InvalidIntBoundError |

12 AtomFunctionEmptyRelationError |

13 AtomTypeDoesNotSupportOrderingError Text |

14 AtomTypeDoesNotSupportIntervalError Text |

15 AtomFunctionBytesDecodingError String

16− deriving(Generic, Eq, Show, Binary, NFData)

16+ deriving(Generic, Eq, Show, NFData)

src/lib/ProjectM36/AtomFunctions/Basic.hs+2

@@ -6,6 +6,7 @@ import ProjectM36.DataTypes.Either

6import ProjectM36.DataTypes.Maybe

7import ProjectM36.DataTypes.Interval

8import ProjectM36.DataTypes.ByteString

9+import ProjectM36.DataTypes.NonEmptyList

9import ProjectM36.AtomFunctions.Primitive

10import ProjectM36.AtomFunctions.Primitive

10import ProjectM36.AtomFunction

11import ProjectM36.AtomFunction

11import ProjectM36.DataTypes.List

12import ProjectM36.DataTypes.List

@@ -19,6 +20,7 @@ basicAtomFunctions = HS.unions [primitiveAtomFunctions,

19 eitherAtomFunctions,

20 eitherAtomFunctions,

20 maybeAtomFunctions,

21 maybeAtomFunctions,

21 listAtomFunctions,

22 listAtomFunctions,

23+ nonEmptyListAtomFunctions,

22 bytestringAtomFunctions,

24 bytestringAtomFunctions,

23 intervalAtomFunctions]

25 intervalAtomFunctions]

src/lib/ProjectM36/AtomFunctions/Primitive.hs+9−1

@@ -43,7 +43,15 @@ primitiveAtomFunctions = HS.fromList [

43 atomFuncBody = body $ integerAtomFuncLessThan True >=> boolAtomNot},

44 AtomFunction { atomFuncName = "not",

45 atomFuncType = [BoolAtomType, BoolAtomType],

46− atomFuncBody = body $ \(b:_) -> boolAtomNot b }

46+ atomFuncBody = body $ \(b:_) -> boolAtomNot b },

47+ AtomFunction { atomFuncName = "int",

48+ atomFuncType = [IntegerAtomType, IntAtomType],

49+ atomFuncBody = body $ \(IntegerAtom v:_) -> if v < fromIntegral (maxBound :: Int) then

50+ pure (IntAtom (fromIntegral v))

51+ else

52+ Left InvalidIntBoundError

53+ }

54+

47 ]

55 ]

48 where

56 where

49 body = AtomFunctionBody Nothing

57 body = AtomFunctionBody Nothing

src/lib/ProjectM36/AtomType.hs+212−66

@@ -6,6 +6,7 @@ import qualified ProjectM36.DataConstructorDef as DCD

6import ProjectM36.MiscUtils

7import ProjectM36.Error

8import ProjectM36.DataTypes.Primitive

9+import ProjectM36.AttributeExpr as AE

9import qualified ProjectM36.Attribute as A

10import qualified ProjectM36.Attribute as A

10import qualified Data.Vector as V

11import qualified Data.Vector as V

11import qualified Data.Set as S

12import qualified Data.Set as S

@@ -30,6 +31,7 @@ findDataConstructor dName = foldr tConsFolder Nothing

30 [dCons] -> Just dCons

31 [dCons] -> Just dCons

31 _ -> error "More than one data constructor with the same name found"

32 _ -> error "More than one data constructor with the same name found"

34+{-

33-- | Scan the atom types and return the resultant ConstructedAtomType or error.

35-- | Scan the atom types and return the resultant ConstructedAtomType or error.

34-- Used in typeFromAtomExpr to validate argument types.

36-- Used in typeFromAtomExpr to validate argument types.

35atomTypeForDataConstructorName :: DataConstructorName -> [AtomType] -> TypeConstructorMapping -> Either RelationalError AtomType

37atomTypeForDataConstructorName :: DataConstructorName -> [AtomType] -> TypeConstructorMapping -> Either RelationalError AtomType

@@ -38,28 +40,21 @@ atomTypeForDataConstructorName dConsName atomTypesIn tConsList =

38 case findDataConstructor dConsName tConsList of

40 case findDataConstructor dConsName tConsList of

39 Nothing -> Left (NoSuchDataConstructorError dConsName)

41 Nothing -> Left (NoSuchDataConstructorError dConsName)

40 Just (tCons, dCons) -> do

42 Just (tCons, dCons) -> do

41− typeVars <- resolveDataConstructorTypeVars dCons atomTypesIn tConsList

43+ dConsVars <- resolveDataConstructorTypeVars dCons atomTypesIn tConsList

44+ let tConsVars = M.fromList (map TypeVariableType (TCD.typeVars tCons))

45+ allVars = M.union dConsVars tConsVars

42− pure (ConstructedAtomType (TCD.name tCons) typeVars)

46+ ConstructedAtomType (TCD.name tCons) <$> allVars

47+-}

44atomTypeForDataConstructorDefArg :: DataConstructorDefArg -> AtomType -> TypeConstructorMapping -> Either RelationalError AtomType

49atomTypeForDataConstructorDefArg :: DataConstructorDefArg -> AtomType -> TypeConstructorMapping -> Either RelationalError AtomType

45−atomTypeForDataConstructorDefArg (DataConstructorDefTypeConstructorArg tCons) aType tConss =

50+atomTypeForDataConstructorDefArg (DataConstructorDefTypeConstructorArg tCons) aType tConss = do

46− case isValidAtomTypeForTypeConstructor aType tCons tConss of

51+ isValidAtomTypeForTypeConstructor aType tCons tConss

47− Just err -> Left err

52+ pure aType

48− Nothing -> Right aType

50atomTypeForDataConstructorDefArg (DataConstructorDefTypeVarNameArg _) aType _ = Right aType --any type is OK

54atomTypeForDataConstructorDefArg (DataConstructorDefTypeVarNameArg _) aType _ = Right aType --any type is OK

52−--reconcile the atom-in types with the type constructors

53−isValidAtomTypeForTypeConstructor :: AtomType -> TypeConstructor -> TypeConstructorMapping -> Maybe RelationalError

54−isValidAtomTypeForTypeConstructor aType (PrimitiveTypeConstructor _ expectedAType) _ = if expectedAType /= aType then Just (AtomTypeMismatchError expectedAType aType) else Nothing

55−

56−--lookup constructor name and check if the incoming atom types are valid

57−isValidAtomTypeForTypeConstructor (ConstructedAtomType tConsName _) (ADTypeConstructor expectedTConsName _) _ = if tConsName /= expectedTConsName then Just (TypeConstructorNameMismatch expectedTConsName tConsName) else Nothing

58−

59−isValidAtomTypeForTypeConstructor aType tCons _ = Just (AtomTypeTypeConstructorReconciliationError aType (TC.name tCons))

60−

61-- | Used to determine if the atom arguments can be used with the data constructor.

56-- | Used to determine if the atom arguments can be used with the data constructor.

62−-- | This is the entry point for type-checking from RelationalExpression.hs.

57+-- | This is the entry point for type-checking from RelationalExpression.hs

63atomTypeForDataConstructor :: TypeConstructorMapping -> DataConstructorName -> [AtomType] -> Either RelationalError AtomType

58atomTypeForDataConstructor :: TypeConstructorMapping -> DataConstructorName -> [AtomType] -> Either RelationalError AtomType

64atomTypeForDataConstructor tConss dConsName atomArgTypes =

59atomTypeForDataConstructor tConss dConsName atomArgTypes =

65 --lookup the data constructor

60 --lookup the data constructor

@@ -67,8 +62,12 @@ atomTypeForDataConstructor tConss dConsName atomArgTypes =

67 Nothing -> Left (NoSuchDataConstructorError dConsName)

62 Nothing -> Left (NoSuchDataConstructorError dConsName)

68 Just (tCons, dCons) -> do

63 Just (tCons, dCons) -> do

69 --validate that the type constructor arguments are fulfilled in the data constructor

64 --validate that the type constructor arguments are fulfilled in the data constructor

70− typeVars <- resolveDataConstructorTypeVars dCons atomArgTypes tConss

65+ dConsVars <- resolveDataConstructorTypeVars dCons atomArgTypes tConss

66+ let tConsVars = M.fromList (map (\v -> (v, TypeVariableType v)) (TCD.typeVars tCons))

67+ allVars = M.union dConsVars tConsVars

71− pure (ConstructedAtomType (TCD.name tCons) typeVars)

68+ unresolvedType = ConstructedAtomType (TCD.name tCons) allVars

69+ --validateAtomType unresolvedType tConss -- do not validate here because the type may not be fully resolved at this point

70+ pure unresolvedType

73-- | Walks the data and type constructors to extract the type variable map.

72-- | Walks the data and type constructors to extract the type variable map.

74resolveDataConstructorTypeVars :: DataConstructorDef -> [AtomType] -> TypeConstructorMapping -> Either RelationalError TypeVarMap

73resolveDataConstructorTypeVars :: DataConstructorDef -> [AtomType] -> TypeConstructorMapping -> Either RelationalError TypeVarMap

@@ -82,10 +81,11 @@ resolveDataConstructorTypeVars dCons@(DataConstructorDef _ defArgs) aTypeArgs tC

82 --if any two maps have the same key and different values, this indicates a type arg mismatch

81 --if any two maps have the same key and different values, this indicates a type arg mismatch

83 let typeVarMapFolder valMap acc = case acc of

82 let typeVarMapFolder valMap acc = case acc of

84 Left err -> Left err

83 Left err -> Left err

85− Right accMap -> if accMap `M.isSubmapOf` valMap then

84+ Right accMap ->

86− Right (M.union accMap valMap)

85+ case resolveAtomTypesInTypeVarMap valMap accMap of

87− else

88− Left (DataConstructorTypeVarsMismatch (DCD.name dCons) accMap valMap)

86+ Left (TypeConstructorTypeVarMissing _) -> Left (DataConstructorTypeVarsMismatch (DCD.name dCons) accMap valMap)

87+ Left err -> Left err

88+ Right ok -> pure ok

89 case foldr typeVarMapFolder (Right M.empty) maps of

90 Left err -> Left err

91 Right typeVarMaps -> pure typeVarMaps

@@ -116,36 +116,103 @@ resolveTypeConstructorTypeVars (ADTypeConstructor tConsName _) (ConstructedAtomT

116 Right pVarMap'

117 else

118 Left (TypeConstructorTypeVarsMismatch expectedPVarNames (M.keysSet pVarMap'))

119−resolveTypeConstructorTypeVars (TypeVariable tvName) typ _ = Right (M.singleton tvName typ)

119+resolveTypeConstructorTypeVars (TypeVariable tvName) typ _ = case typ of

120+ TypeVariableType nam -> Left (TypeConstructorTypeVarMissing nam)

121+ _ -> Right (M.singleton tvName typ)

122+resolveTypeConstructorTypeVars (ADTypeConstructor tConsName []) typ tConss = case findTypeConstructor tConsName tConss of

123+ Just (PrimitiveTypeConstructorDef _ _, _) -> Right M.empty

124+ _ -> Left (TypeConstructorAtomTypeMismatch tConsName typ)

125+

120resolveTypeConstructorTypeVars (ADTypeConstructor tConsName _) typ _ = Left (TypeConstructorAtomTypeMismatch tConsName typ)

126resolveTypeConstructorTypeVars (ADTypeConstructor tConsName _) typ _ = Left (TypeConstructorAtomTypeMismatch tConsName typ)

127+

128+resolveTypeConstructorTypeVars (RelationAtomTypeConstructor attrExprs) typ tConsMap =

129+ case typ of

130+ RelationAtomType attrs ->

131+ --resolve any typevars in the attrExprs

132+ M.unions <$> mapM (\(expectedAtomType, attrExpr) -> resolveAttributeExprTypeVars attrExpr expectedAtomType tConsMap) (zip (A.atomTypesList attrs) attrExprs)

133+ otherType -> Left (AtomTypeMismatchError typ otherType)

134+

135+--used when recursing down sub-relation type definition

136+resolveAttributeExprTypeVars :: AttributeExprBase a -> AtomType -> TypeConstructorMapping -> Either RelationalError TypeVarMap

137+resolveAttributeExprTypeVars (NakedAttributeExpr attr) aType _ = pure $ resolveTypeVariable (A.atomType attr) aType

138+resolveAttributeExprTypeVars (AttributeAndTypeNameExpr _ tCons _) aType tConsMap = resolveTypeConstructorTypeVars tCons aType tConsMap

121

139

122-- check that type vars on the right also appear on the left

140-- check that type vars on the right also appear on the left

123-- check that the data constructor names are unique

141-- check that the data constructor names are unique

124−validateTypeConstructorDef :: TypeConstructorDef -> [DataConstructorDef] -> [RelationalError]

142+validateTypeConstructorDef :: TypeConstructorDef -> [DataConstructorDef] -> TypeConstructorMapping -> Either RelationalError ()

125−validateTypeConstructorDef tConsDef dConsList = execWriter $ do

143+validateTypeConstructorDef tConsDef dConsList tConsMap = do

126 let duplicateDConsNames = dupes (L.sort (map DCD.name dConsList))

144 let duplicateDConsNames = dupes (L.sort (map DCD.name dConsList))

127− mapM_ tell [map DataConstructorNameInUseError duplicateDConsNames]

145+ unless (null duplicateDConsNames) (Left (someErrors (map DataConstructorNameInUseError duplicateDConsNames)))

128 let leftSideVars = S.fromList (TCD.typeVars tConsDef)

146 let leftSideVars = S.fromList (TCD.typeVars tConsDef)

129 rightSideVars = S.unions (map DCD.typeVars dConsList)

147 rightSideVars = S.unions (map DCD.typeVars dConsList)

130 varsDiff = S.difference leftSideVars rightSideVars

148 varsDiff = S.difference leftSideVars rightSideVars

131− mapM_ tell [map DataConstructorUsesUndeclaredTypeVariable (S.toList varsDiff)]

149+ when (S.size varsDiff > 0) (Left (someErrors (map DataConstructorUsesUndeclaredTypeVariable (S.toList varsDiff))))

132− pure ()

150+ mapM_ (\dConsDef -> validateDataConstructorDef dConsDef tConsDef tConsMap) dConsList

133−

151+

152+--check that the data constructor names are not in use (recursively)

153+validateDataConstructorDef :: DataConstructorDef -> TypeConstructorDef -> TypeConstructorMapping -> Either RelationalError ()

154+validateDataConstructorDef (DataConstructorDef dConsName dConsDefArgs) tConsDef tConsMap =

155+ case findDataConstructor dConsName tConsMap of

156+ Just _ -> Left (DataConstructorNameInUseError dConsName)

157+ Nothing ->

158+ mapM_ (\arg -> validateDataConstructorDefArg arg tConsDef tConsMap) dConsDefArgs

159+

160+

161+validateDataConstructorDefArg :: DataConstructorDefArg -> TypeConstructorDef -> TypeConstructorMapping -> Either RelationalError ()

162+validateDataConstructorDefArg (DataConstructorDefTypeConstructorArg (PrimitiveTypeConstructor _ _)) _ _ = Right ()

163+validateDataConstructorDefArg (DataConstructorDefTypeConstructorArg (TypeVariable _)) _ _ = Right ()

164+validateDataConstructorDefArg (DataConstructorDefTypeConstructorArg tCons) tConsDef tConsMap = case findTypeConstructor (TC.name tCons) tConsMap of

165+ Nothing ->

166+ when (TC.name tCons /= TCD.name tConsDef) (Left (NoSuchTypeConstructorName (TC.name tCons))) --allows for recursively-defined types

167+ Just (ADTypeConstructorDef _ tConsArgs, _) -> do --validate that the argument count matches- type matching can occur later

168+ let existingCount = length tConsArgs

169+ newCount = length (TC.arguments tCons)

170+ when (newCount /= existingCount) (Left (ConstructedAtomArgumentCountMismatchError existingCount newCount))

171+ Just (PrimitiveTypeConstructorDef _ _, _) -> pure ()

172+validateDataConstructorDefArg (DataConstructorDefTypeVarNameArg _) _ _ = Right ()

173+

174+atomTypeForTypeConstructor :: TypeConstructor -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType

175+atomTypeForTypeConstructor = atomTypeForTypeConstructorValidate False

134

176

135-- | Create an atom type iff all type variables are provided.

177-- | Create an atom type iff all type variables are provided.

136-- Either Int Text -> ConstructedAtomType "Either" {Int , Text}

178-- Either Int Text -> ConstructedAtomType "Either" {Int , Text}

137−atomTypeForTypeConstructor :: TypeConstructor -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType

179+atomTypeForTypeConstructorValidate :: Bool -> TypeConstructor -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType

138−atomTypeForTypeConstructor (PrimitiveTypeConstructor _ aType) _ _ = Right aType

180+atomTypeForTypeConstructorValidate _ (PrimitiveTypeConstructor _ aType) _ _ = Right aType

139−atomTypeForTypeConstructor (TypeVariable tvname) _ tvMap = case M.lookup tvname tvMap of

181+atomTypeForTypeConstructorValidate validate (TypeVariable tvname) _ tvMap = case M.lookup tvname tvMap of

182+ Nothing -> if validate then

183+ Left (TypeConstructorTypeVarMissing tvname)

184+ else

140− Nothing -> Right (TypeVariableType tvname)

185+ pure (TypeVariableType tvname)

141 Just typ -> Right typ

186 Just typ -> Right typ

187+atomTypeForTypeConstructorValidate _ (RelationAtomTypeConstructor attrExprs) tConsMap tvMap = do

188+ resolvedAtomTypes <- mapM (\expr -> atomTypeForAttributeExpr expr tConsMap tvMap) attrExprs

189+ let attrs = zipWith Attribute (map AE.attributeName attrExprs) resolvedAtomTypes

190+ pure (RelationAtomType (A.attributesFromList attrs))

142−atomTypeForTypeConstructor tCons tConss tvMap = case findTypeConstructor (TC.name tCons) tConss of

191+atomTypeForTypeConstructorValidate val tCons tConss tvMap = case findTypeConstructor (TC.name tCons) tConss of

143 Nothing -> Left (NoSuchTypeConstructorError (TC.name tCons))

192 Nothing -> Left (NoSuchTypeConstructorError (TC.name tCons))

193+ Just (PrimitiveTypeConstructorDef _ aType, _) -> Right aType

144 Just (tConsDef, _) -> do

194 Just (tConsDef, _) -> do

145− tConsArgTypes <- mapM (\tConsArg -> atomTypeForTypeConstructor tConsArg tConss tvMap) (TC.arguments tCons)

195+ tConsArgTypes <- mapM (\tConsArg -> atomTypeForTypeConstructorValidate val tConsArg tConss tvMap) (TC.arguments tCons)

146− let pVarNames = TCD.typeVars tConsDef

196+ let pVarNames = TCD.typeVars tConsDef

147− tConsArgs = M.fromList (zip pVarNames tConsArgTypes)

197+ tConsArgs = M.fromList (zip pVarNames tConsArgTypes)

148− Right (ConstructedAtomType (TC.name tCons) tConsArgs)

198+ Right (ConstructedAtomType (TC.name tCons) tConsArgs)

199+

200+

201+atomTypeForAttributeExpr :: AttributeExprBase a -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType

202+atomTypeForAttributeExpr (NakedAttributeExpr attr) _ _ = pure (A.atomType attr)

203+atomTypeForAttributeExpr (AttributeAndTypeNameExpr _ tCons _) tConsMap tvMap = atomTypeForTypeConstructorValidate True tCons tConsMap tvMap

204+

205+--reconcile the atom-in types with the type constructors

206+isValidAtomTypeForTypeConstructor :: AtomType -> TypeConstructor -> TypeConstructorMapping -> Either RelationalError ()

207+isValidAtomTypeForTypeConstructor aType (PrimitiveTypeConstructor _ expectedAType) _ = if expectedAType /= aType then Left (AtomTypeMismatchError expectedAType aType) else pure ()

208+

209+--lookup constructor name and check if the incoming atom types are valid

210+isValidAtomTypeForTypeConstructor (ConstructedAtomType tConsName _) (ADTypeConstructor expectedTConsName _) _ = if tConsName /= expectedTConsName then Left (TypeConstructorNameMismatch expectedTConsName tConsName) else pure ()

211+

212+isValidAtomTypeForTypeConstructor (RelationAtomType attrs) (RelationAtomTypeConstructor attrExprs) tConsMap = do

213+ evaldAtomTypes <- mapM (\expr -> atomTypeForAttributeExpr expr tConsMap M.empty) attrExprs

214+ mapM_ (uncurry resolveAtomType) (zip (A.atomTypesList attrs) evaldAtomTypes)

215+isValidAtomTypeForTypeConstructor aType tCons _ = Left (AtomTypeTypeConstructorReconciliationError aType (TC.name tCons))

149

216

150findTypeConstructor :: TypeConstructorName -> TypeConstructorMapping -> Maybe (TypeConstructorDef, [DataConstructorDef])

217findTypeConstructor :: TypeConstructorName -> TypeConstructorMapping -> Maybe (TypeConstructorDef, [DataConstructorDef])

151findTypeConstructor name = foldr tConsFolder Nothing

218findTypeConstructor name = foldr tConsFolder Nothing

@@ -154,17 +221,30 @@ findTypeConstructor name = foldr tConsFolder Nothing

154 Just (tCons, dConsList)

221 Just (tCons, dConsList)

155 else

222 else

156 accum

223 accum

157−

224+

225+resolveAttributes :: Attribute -> Attribute -> Either RelationalError Attribute

226+resolveAttributes attrA attrB =

227+ if A.attributeName attrA /= A.attributeName attrB then

228+ Left $ AttributeNamesMismatchError (S.fromList (map A.attributeName [attrA, attrB]))

229+ else

230+ Attribute (A.attributeName attrA) <$> resolveAtomType (A.atomType attrA) (A.atomType attrB)

231+

232+--given two atom types, try to resolve type variables

158resolveAtomType :: AtomType -> AtomType -> Either RelationalError AtomType

233resolveAtomType :: AtomType -> AtomType -> Either RelationalError AtomType

159−resolveAtomType (ConstructedAtomType tConsName resolvedTypeVarMap) (ConstructedAtomType _ unresolvedTypeVarMap) = do

234+resolveAtomType (ConstructedAtomType tConsName resolvedTypeVarMap) (ConstructedAtomType _ unresolvedTypeVarMap) =

160− tVarMap <- resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap

235+ ConstructedAtomType tConsName <$> resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap

161− pure (ConstructedAtomType tConsName tVarMap)

162resolveAtomType typeFromRelation unresolvedType = if typeFromRelation == unresolvedType then

236resolveAtomType typeFromRelation unresolvedType = if typeFromRelation == unresolvedType then

163 Right typeFromRelation

237 Right typeFromRelation

164 else

238 else

165 Left (AtomTypeMismatchError typeFromRelation unresolvedType)

239 Left (AtomTypeMismatchError typeFromRelation unresolvedType)

166

240

241+{-

242+--walk an `AtomType` and apply the type variables in the map

243+resolveAtomTypeVars :: TypeVarMap -> AtomType -> AtomType

244+resolveAtomTypeVars tvMap typ@(TypeVariableType nam) = fromMaybe typ (M.lookup nam tvMap)

245+resolveAtomTypeVars tvMap (RelationAtomType relAttrs) =

246+-}

167−-- this could be optimized to reduce new tuple creation- if anyatomtype does not appear, just return the original typevarmap

247+-- this could be optimized to reduce new tuple creation

168resolveAtomTypesInTypeVarMap :: TypeVarMap -> TypeVarMap -> Either RelationalError TypeVarMap

248resolveAtomTypesInTypeVarMap :: TypeVarMap -> TypeVarMap -> Either RelationalError TypeVarMap

169resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do

249resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do

170 {-

250 {-

@@ -180,29 +260,42 @@ resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do

180 let resolveTypePair resKey resType =

260 let resolveTypePair resKey resType =

181 -- if the key is missing in the unresolved type map, then fill it in with the value from the resolved map

261 -- if the key is missing in the unresolved type map, then fill it in with the value from the resolved map

182 case M.lookup resKey unresolvedTypeMap of

262 case M.lookup resKey unresolvedTypeMap of

183− Just unresType -> case unresType of

263+ Just unresType -> case unresType of

184 --do we need to recurse for RelationAtomType?

264 --do we need to recurse for RelationAtomType?

185 subType@(ConstructedAtomType _ _) -> do

265 subType@(ConstructedAtomType _ _) -> do

186 resSubType <- resolveAtomType resType subType

266 resSubType <- resolveAtomType resType subType

187 pure (resKey, resSubType)

267 pure (resKey, resSubType)

188− otherType -> pure (resKey, otherType)

268+ TypeVariableType _ -> pure (resKey, resType)

269+ typ -> if typ == resType then

270+ pure (resKey, resType)

271+ else

272+ Left $ AtomTypeMismatchError typ resType

189 Nothing ->

273 Nothing ->

190 pure (resKey, resType) --swipe the missing type var from the expected map

274 pure (resKey, resType) --swipe the missing type var from the expected map

191 tVarList <- mapM (uncurry resolveTypePair) (M.toList resolvedTypeMap)

275 tVarList <- mapM (uncurry resolveTypePair) (M.toList resolvedTypeMap)

192 pure (M.fromList tVarList)

276 pure (M.fromList tVarList)

193

277

194-- | See notes at `resolveTypesInTuple`. The typeFromRelation must not include any wildcards.

278-- | See notes at `resolveTypesInTuple`. The typeFromRelation must not include any wildcards.

195−resolveTypeInAtom :: AtomType -> Atom -> Either RelationalError Atom

279+resolveTypeInAtom :: AtomType -> Atom -> TypeConstructorMapping -> Either RelationalError Atom

196−resolveTypeInAtom typeFromRelation atomIn@(ConstructedAtom dConsName _ args) = do

280+resolveTypeInAtom typeFromRelation@(ConstructedAtomType _ tvMap) atomIn@(ConstructedAtom dConsName _ args) tConss = do

197 newType <- resolveAtomType typeFromRelation (atomTypeForAtom atomIn)

281 newType <- resolveAtomType typeFromRelation (atomTypeForAtom atomIn)

282+ case findDataConstructor dConsName tConss of

283+ Nothing -> -- the atom may have been constructed using a constructor function without a public data constructor, no further resolution is possible

284+ pure atomIn

285+ Just (_, dConsDef) -> do

286+ atomArgTypes <- resolvedAtomTypesForDataConstructorDefArgs tConss tvMap dConsDef

287+ newArgs <- mapM (\(atom, atomTyp) -> resolveTypeInAtom atomTyp atom tConss) (zip args atomArgTypes)

198− pure (ConstructedAtom dConsName newType args)

288+ pure (ConstructedAtom dConsName newType newArgs)

289+resolveTypeInAtom (RelationAtomType attrs) (RelationAtom (Relation _ tupSet)) tConss = do

290+ let newTups = mapM (resolveTypesInTuple attrs tConss) (asList tupSet)

291+ RelationAtom . Relation attrs . RelationTupleSet <$> newTups

199−resolveTypeInAtom _ atom = Right atom

292+resolveTypeInAtom _ atom _ = Right atom

200

293

201-- | When creating a tuple, the data constructor may not complete the type constructor arguments, so the wildcard "TypeVar x" fills in the type constructor's argument. The tuple type must be resolved before it can be part of a relation, however.

294-- | When creating a tuple, the data constructor may not complete the type constructor arguments, so the wildcard "TypeVar x" fills in the type constructor's argument. The tuple type must be resolved before it can be part of a relation, however.

202-- Example: "Nothing" does not specify the the argument in "Maybe a", so allow delayed resolution in the tuple before it is added to the relation. Note that this resolution could cause a type error. Hardly a Hindley-Milner system.

295-- Example: "Nothing" does not specify the the argument in "Maybe a", so allow delayed resolution in the tuple before it is added to the relation. Note that this resolution could cause a type error. Hardly a Hindley-Milner system.

203−resolveTypesInTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple

296+resolveTypesInTuple :: Attributes -> TypeConstructorMapping -> RelationTuple -> Either RelationalError RelationTuple

204−resolveTypesInTuple resolvedAttrs (RelationTuple _ tupAtoms) = do

297+resolveTypesInTuple resolvedAttrs tConss (RelationTuple _ tupAtoms) = do

205− newAtoms <- mapM (\(atom, resolvedType) -> resolveTypeInAtom resolvedType atom) (zip (V.toList tupAtoms) $ map A.atomType (V.toList resolvedAttrs))

298+ newAtoms <- mapM (\(atom, resolvedType) -> resolveTypeInAtom resolvedType atom tConss) (zip (V.toList tupAtoms) $ A.atomTypesList resolvedAttrs)

206 Right (RelationTuple resolvedAttrs (V.fromList newAtoms))

299 Right (RelationTuple resolvedAttrs (V.fromList newAtoms))

207

300

208-- | Validate that the type is provided with complete type variables for type constructors.

301-- | Validate that the type is provided with complete type variables for type constructors.

@@ -217,12 +310,38 @@ validateAtomType typ@(ConstructedAtomType tConsName tVarMap) tConss =

217 if not (S.null diff) then

310 if not (S.null diff) then

218 Left $ TypeConstructorTypeVarsMismatch expectedTyVarNames actualTyVarNames

311 Left $ TypeConstructorTypeVarsMismatch expectedTyVarNames actualTyVarNames

219 else

312 else

220− Right ()

313+ validateTypeVarMap tVarMap tConss

221− _ -> Right ()

314+ _ -> Right ()

222−validateAtomType _ _ = Right ()

315+validateAtomType (RelationAtomType attrs) tConss =

316+ mapM_ (\attr ->

317+ validateAtomType (A.atomType attr) tConss) (attributesVec attrs)

318+validateAtomType (TypeVariableType x) _ = Left (TypeConstructorTypeVarMissing x)

319+validateAtomType _ _ = pure ()

320+

321+validateAttributes :: TypeConstructorMapping -> Attributes -> Either RelationalError ()

322+validateAttributes tConss attrs =

323+ if not (null errs) then

324+ Left (someErrors errs)

325+ else

326+ pure ()

327+ where

328+ errs = lefts $ map (`validateAtomType` tConss) (A.atomTypesList attrs)

329+

330+--ensure that all type vars are fully resolved

331+validateTypeVarMap :: TypeVarMap -> TypeConstructorMapping -> Either RelationalError ()

332+validateTypeVarMap tvMap tConss = mapM_ (`validateAtomType` tConss) $ M.elems tvMap

223

333

224validateTuple :: RelationTuple -> TypeConstructorMapping -> Either RelationalError ()

334validateTuple :: RelationTuple -> TypeConstructorMapping -> Either RelationalError ()

225−validateTuple (RelationTuple _ atoms) tConss = mapM_ (\a -> validateAtomType (atomTypeForAtom a) tConss) atoms

335+validateTuple (RelationTuple _ atoms) tConss = mapM_ (`validateAtom` tConss) atoms

336+

337+--ensure that all types are fully resolved

338+validateAtom :: Atom -> TypeConstructorMapping -> Either RelationalError ()

339+validateAtom (RelationAtom (Relation _ tupSet)) tConss = mapM_ (`validateTuple` tConss) (asList tupSet)

340+validateAtom (ConstructedAtom _ dConsType atomArgs) tConss = do

341+ validateAtomType dConsType tConss

342+ mapM_ (`validateAtom` tConss) atomArgs

343+validateAtom _ _ = pure ()

344+

226

345

227-- | Determine if two types are equal or compatible (including special handling for TypeVar x).

346-- | Determine if two types are equal or compatible (including special handling for TypeVar x).

228atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType

347atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType

@@ -234,14 +353,13 @@ atomTypeVerify x@(ConstructedAtomType tConsNameA tVarMapA) (ConstructedAtomType

234 | otherwise = Right x

353 | otherwise = Right x

235

354

236atomTypeVerify x@(RelationAtomType attrs1) y@(RelationAtomType attrs2) = do

355atomTypeVerify x@(RelationAtomType attrs1) y@(RelationAtomType attrs2) = do

237− _ <- mapM (\(attr1,attr2) -> let name1 = A.attributeName attr1

356+ mapM_ (\(attr1,attr2) -> let name1 = A.attributeName attr1

238− name2 = A.attributeName attr2 in

357+ name2 = A.attributeName attr2 in

239 if notElem "_" [name1, name2] && name1 /= name2 then

358 if notElem "_" [name1, name2] && name1 /= name2 then

240 Left $ AtomTypeMismatchError x y

359 Left $ AtomTypeMismatchError x y

241 else

360 else

242− atomTypeVerify (A.atomType attr1) (A.atomType attr2)) $ V.toList (V.zip attrs1 attrs2)

361+ atomTypeVerify (A.atomType attr1) (A.atomType attr2)) $ V.toList (V.zip (attributesVec attrs1) (attributesVec attrs2))

243 return x

362 return x

244−atomTypeVerify (IntervalAtomType typA) (IntervalAtomType typB) = atomTypeVerify typA typB

245atomTypeVerify x y = if x == y then

363atomTypeVerify x y = if x == y then

246 Right x

364 Right x

247 else

365 else

@@ -249,20 +367,26 @@ atomTypeVerify x y = if x == y then

249

367

250-- | Determine if two typeVars are logically compatible.

368-- | Determine if two typeVars are logically compatible.

251typeVarMapsVerify :: TypeVarMap -> TypeVarMap -> Bool

369typeVarMapsVerify :: TypeVarMap -> TypeVarMap -> Bool

252−typeVarMapsVerify a b = M.keysSet a == M.keysSet b && (length . rights) (map (\((_,v1),(_,v2)) -> atomTypeVerify v1 v2) (zip (M.toAscList a) (M.toAscList b))) == M.size a

370+typeVarMapsVerify a b = M.keysSet a == M.keysSet b && (length . rights) zipped == M.size a

371+ where

372+ zipped = zipWith

373+ (curry (\ ((_, v1), (_, v2)) -> atomTypeVerify v1 v2))

374+ (M.toAscList a)

375+ (M.toAscList b)

253

376

254prettyAtomType :: AtomType -> T.Text

377prettyAtomType :: AtomType -> T.Text

255−prettyAtomType (RelationAtomType attrs) = "relation {" `T.append` T.intercalate "," (map prettyAttribute (V.toList attrs)) `T.append` "}"

378+prettyAtomType (RelationAtomType attrs) = "relation {" `T.append` T.intercalate "," (map prettyAttribute (V.toList (attributesVec attrs))) `T.append` "}"

256prettyAtomType (ConstructedAtomType tConsName typeVarMap) = tConsName `T.append` T.concat (map showTypeVars (M.toList typeVarMap))

379prettyAtomType (ConstructedAtomType tConsName typeVarMap) = tConsName `T.append` T.concat (map showTypeVars (M.toList typeVarMap))

257 where

380 where

381+ showTypeVars (_, TypeVariableType x) = " " <> x

258 showTypeVars (tyVarName, aType) = " (" `T.append` tyVarName `T.append` "::" `T.append` prettyAtomType aType `T.append` ")"

382 showTypeVars (tyVarName, aType) = " (" `T.append` tyVarName `T.append` "::" `T.append` prettyAtomType aType `T.append` ")"

259-- it would be nice to have the original ordering, but we don't have access to the type constructor here- maybe the typevarmap should be also positional (ordered map?)

383-- it would be nice to have the original ordering, but we don't have access to the type constructor here- maybe the typevarmap should be also positional (ordered map?)

260−prettyAtomType (TypeVariableType x) = "?TypeVariableType " <> x <> "?"

384+prettyAtomType (TypeVariableType x) = x

261−prettyAtomType (IntervalAtomType tv) = "Interval (" <> prettyAtomType tv <> ")"

262prettyAtomType aType = T.take (T.length fullName - T.length "AtomType") fullName

385prettyAtomType aType = T.take (T.length fullName - T.length "AtomType") fullName

263 where fullName = (T.pack . show) aType

386 where fullName = (T.pack . show) aType

264

387

265prettyAttribute :: Attribute -> T.Text

388prettyAttribute :: Attribute -> T.Text

389+prettyAttribute (Attribute _ (TypeVariableType x)) = x

266prettyAttribute attr = A.attributeName attr `T.append` "::" `T.append` prettyAtomType (A.atomType attr)

390prettyAttribute attr = A.attributeName attr `T.append` "::" `T.append` prettyAtomType (A.atomType attr)

267

391

268resolveTypeVariables :: [AtomType] -> [AtomType] -> Either RelationalError TypeVarMap

392resolveTypeVariables :: [AtomType] -> [AtomType] -> Either RelationalError TypeVarMap

@@ -282,7 +406,6 @@ resolveTypeVariables expectedArgTypes actualArgTypes = do

282

406

283resolveTypeVariable :: AtomType -> AtomType -> TypeVarMap

407resolveTypeVariable :: AtomType -> AtomType -> TypeVarMap

284resolveTypeVariable (TypeVariableType tv) typ = M.singleton tv typ

408resolveTypeVariable (TypeVariableType tv) typ = M.singleton tv typ

285−resolveTypeVariable (IntervalAtomType ityp) typ = resolveTypeVariable ityp typ

286resolveTypeVariable (ConstructedAtomType _ _) (ConstructedAtomType _ actualTvMap) = actualTvMap

409resolveTypeVariable (ConstructedAtomType _ _) (ConstructedAtomType _ actualTvMap) = actualTvMap

287resolveTypeVariable _ _ = M.empty

410resolveTypeVariable _ _ = M.empty

288

411

@@ -293,7 +416,6 @@ resolveFunctionReturnValue funcName tvMap (ConstructedAtomType tCons retMap) = d

293 pure (ConstructedAtomType tCons (M.intersection tvMap retMap))

416 pure (ConstructedAtomType tCons (M.intersection tvMap retMap))

294 else

417 else

295 Left (AtomFunctionTypeVariableResolutionError funcName (fst (head (M.toList diff))))

418 Left (AtomFunctionTypeVariableResolutionError funcName (fst (head (M.toList diff))))

296−resolveFunctionReturnValue funcName tvMap (IntervalAtomType tv) = IntervalAtomType <$> resolveFunctionReturnValue funcName tvMap tv

297resolveFunctionReturnValue funcName tvMap (TypeVariableType tvName) = case M.lookup tvName tvMap of

419resolveFunctionReturnValue funcName tvMap (TypeVariableType tvName) = case M.lookup tvName tvMap of

298 Nothing -> Left (AtomFunctionTypeVariableResolutionError funcName tvName)

420 Nothing -> Left (AtomFunctionTypeVariableResolutionError funcName tvName)

299 Just typ -> pure typ

421 Just typ -> pure typ

@@ -308,3 +430,27 @@ resolvedAtomTypeForDataConstructorDefArg tConsMap tvMap (DataConstructorDefTypeC

308resolvedAtomTypeForDataConstructorDefArg _ tvMap (DataConstructorDefTypeVarNameArg tvName) = case M.lookup tvName tvMap of

430resolvedAtomTypeForDataConstructorDefArg _ tvMap (DataConstructorDefTypeVarNameArg tvName) = case M.lookup tvName tvMap of

309 Nothing -> Left (DataConstructorUsesUndeclaredTypeVariable tvName)

431 Nothing -> Left (DataConstructorUsesUndeclaredTypeVariable tvName)

310 Just typ -> Right typ

432 Just typ -> Right typ

433+

434+isResolvedType :: AtomType -> Bool

435+isResolvedType typ =

436+ case typ of

437+ IntAtomType -> True

438+ IntegerAtomType -> True

439+ DoubleAtomType -> True

440+ TextAtomType -> True

441+ DayAtomType -> True

442+ DateTimeAtomType -> True

443+ ByteStringAtomType -> True

444+ BoolAtomType -> True

445+ RelationalExprAtomType -> True

446+ RelationAtomType attrs -> isResolvedAttributes attrs

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

448+ TypeVariableType _ -> False

449+

450+isResolvedAttributes :: Attributes -> Bool

451+isResolvedAttributes attrs = all isResolvedAttribute (V.toList (attributesVec attrs))

452+

453+isResolvedAttribute :: Attribute -> Bool

454+isResolvedAttribute = isResolvedType . A.atomType

455+

456+--given two AtomTypes x,y

src/lib/ProjectM36/Atomable.hs+68−56

@@ -1,39 +1,28 @@

1{-# LANGUAGE DefaultSignatures, TypeFamilies, TypeOperators, PolyKinds, FlexibleInstances, ScopedTypeVariables, FlexibleContexts #-}

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

2module ProjectM36.Atomable where

3module ProjectM36.Atomable where

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

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

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

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

5import ProjectM36.Base

6import ProjectM36.Base

6−import ProjectM36.DataTypes.Primitive

7import ProjectM36.DataTypes.List

8+import ProjectM36.DataTypes.NonEmptyList

8import ProjectM36.DataTypes.Maybe

9import ProjectM36.DataTypes.Maybe

9import ProjectM36.DataTypes.Either

10import ProjectM36.DataTypes.Either

10import GHC.Generics

11import GHC.Generics

11import qualified Data.Map as M

12import qualified Data.Map as M

12import qualified Data.Text as T

13import qualified Data.Text as T

14+import qualified Data.Vector as V

13import Control.DeepSeq (NFData)

15import Control.DeepSeq (NFData)

14−import Data.Binary

15import Control.Applicative

16import Control.Applicative

16import Data.Time.Calendar

17import Data.Time.Calendar

17import Data.ByteString (ByteString)

18import Data.ByteString (ByteString)

18import Data.Time.Clock

19import Data.Time.Clock

19−import Data.Maybe

20import Data.Proxy

21+import qualified Data.List.NonEmpty as NE

22+import Codec.Winery

22−--also add haskell scripting atomable support

23−--rename this module to Atomable along with test

24−

25−{-

26−data Test1T = Test1C Int

27− deriving (Generic, Show, Eq, Binary, NFData, Atomable)

28−

29−data Test2T = Test2C Int Int

30− deriving (Generic, Show, Eq, Binary, NFData, Atomable)

31−

32−data Test3T = Test3Ca | Test3Cb

33− deriving (Generic, Show, Eq, Binary, NFData, Atomable)

34−-}

35-- | All database values ("atoms") adhere to the 'Atomable' typeclass. This class is derivable allowing new datatypes to be easily marshaling between Haskell values and database values.

24-- | All database values ("atoms") adhere to the 'Atomable' typeclass. This class is derivable allowing new datatypes to be easily marshaling between Haskell values and database values.

36−class (Eq a, NFData a, Binary a, Show a) => Atomable a where

25+class (Eq a, NFData a, Serialise a, Show a) => Atomable a where

37 toAtom :: a -> Atom

26 toAtom :: a -> Atom

38 default toAtom :: (Generic a, AtomableG (Rep a)) => a -> Atom

27 default toAtom :: (Generic a, AtomableG (Rep a)) => a -> Atom

39 toAtom v = toAtomG (from v) (toAtomTypeG (from v))

28 toAtom v = toAtomG (from v) (toAtomTypeG (from v))

@@ -52,9 +41,9 @@ class (Eq a, NFData a, Binary a, Show a) => Atomable a where

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

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

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

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

55− toAddTypeExpr :: Proxy a -> DatabaseContextExpr

44+ toAddTypeExpr :: proxy a -> DatabaseContextExpr

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

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

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

46+ toAddTypeExpr _ = toAddTypeExprG (from (error "insufficient laziness" :: a)) (toAtomType (Proxy :: Proxy a))

59instance Atomable Integer where

48instance Atomable Integer where

60 toAtom = IntegerAtom

49 toAtom = IntegerAtom

@@ -146,15 +135,23 @@ instance (Atomable a, Atomable b) => Atomable (Either a b) where

146--convert to ADT list

135--convert to ADT list

147instance Atomable a => Atomable [a] where

136instance Atomable a => Atomable [a] where

148 toAtom [] = ConstructedAtom "Empty" (listAtomType (toAtomType (Proxy :: Proxy a))) []

137 toAtom [] = ConstructedAtom "Empty" (listAtomType (toAtomType (Proxy :: Proxy a))) []

149− toAtom (x:xs) = ConstructedAtom "Cons" (listAtomType (toAtomType (Proxy :: Proxy a))) (map toAtom (x:xs))

138+ toAtom (x:xs) = ConstructedAtom "Cons" (listAtomType (toAtomType (Proxy :: Proxy a))) (toAtom x: [toAtom xs])

150

139

151 fromAtom (ConstructedAtom "Empty" _ _) = []

140 fromAtom (ConstructedAtom "Empty" _ _) = []

152− fromAtom (ConstructedAtom "Cons" _ (x:xs)) = fromAtom x:map fromAtom xs

141+ fromAtom (ConstructedAtom "Cons" _ [x,y]) = fromAtom x:fromAtom y

153 fromAtom _ = error "improper fromAtom [a]"

142 fromAtom _ = error "improper fromAtom [a]"

154

143

155 toAtomType _ = ConstructedAtomType "List" (M.singleton "a" (toAtomType (Proxy :: Proxy a)))

144 toAtomType _ = ConstructedAtomType "List" (M.singleton "a" (toAtomType (Proxy :: Proxy a)))

156 toAddTypeExpr _ = NoOperation

145 toAddTypeExpr _ = NoOperation

157

146

147+instance Atomable a => Atomable (NE.NonEmpty a) where

148+ toAtom (x NE.:| []) = ConstructedAtom "NECons" (nonEmptyListAtomType (toAtomType (Proxy :: Proxy a))) [toAtom x]

149+ toAtom (x NE.:| xs) = ConstructedAtom "NECons" (nonEmptyListAtomType (toAtomType (Proxy :: Proxy a))) (map toAtom (x:xs))

150+ fromAtom _ = error "improper fromAtom (NonEmptyList a)"

151+

152+ toAtomType _ = ConstructedAtomType "NonEmptyList" (M.singleton "a" (toAtomType (Proxy :: Proxy a)))

153+ toAddTypeExpr _ = NoOperation

154+

158-- Generics

155-- Generics

159class AtomableG g where

156class AtomableG g where

160 --type AtomTG g

157 --type AtomTG g

@@ -170,17 +167,17 @@ class AtomableG g where

170instance (Datatype c, AtomableG a) => AtomableG (M1 D c a) where

167instance (Datatype c, AtomableG a) => AtomableG (M1 D c a) where

171 toAtomG (M1 v) = toAtomG v

168 toAtomG (M1 v) = toAtomG v

172 fromAtomG atom args = M1 <$> fromAtomG atom args

169 fromAtomG atom args = M1 <$> fromAtomG atom args

173− toAtomsG = undefined

170+ toAtomsG = error "invalid toAtomsG in M1 D"

174 toAtomTypeG _ = ConstructedAtomType (T.pack typeName) M.empty -- generics don't allow us to get the type constructor variables- alternatives?

171 toAtomTypeG _ = ConstructedAtomType (T.pack typeName) M.empty -- generics don't allow us to get the type constructor variables- alternatives?

175 where

172 where

176 typeName = datatypeName (undefined :: M1 D c a x)

173 typeName = datatypeName (undefined :: M1 D c a x)

177− toAddTypeExprG (M1 v) (ConstructedAtomType tcName _) = AddTypeConstructor tcDef dataConstructors

174+ toAddTypeExprG ~(M1 v) (ConstructedAtomType tcName _) = AddTypeConstructor tcDef dataConstructors

178 where

175 where

179 tcDef = ADTypeConstructorDef tcName []

176 tcDef = ADTypeConstructorDef tcName []

180 dataConstructors = getConstructorsG v

177 dataConstructors = getConstructorsG v

181 toAddTypeExprG _ _ = NoOperation

178 toAddTypeExprG _ _ = NoOperation

182− getConstructorsG (M1 v) = getConstructorsG v

179+ getConstructorsG ~(M1 v) = getConstructorsG v

183− getConstructorArgsG = undefined

180+ getConstructorArgsG = error "invalid getConstructorArgsG in M1 D"

184

181

185--constructor metadata

182--constructor metadata

186instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where

183instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where

@@ -195,11 +192,11 @@ instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where

195 Nothing

192 Nothing

196 where

193 where

197 dName = T.pack (conName (undefined :: M1 C c a x))

194 dName = T.pack (conName (undefined :: M1 C c a x))

198− fromAtomG _ _ = error "unsupported generic traversal"

195+ fromAtomG _ _ = error "invalid fromAtomG in M1 C"

199− toAtomsG = undefined

196+ toAtomsG = error "invalid toAtomsG in M1 C"

200− toAtomTypeG = undefined

197+ toAtomTypeG = error "invalid toAtomTypeG in M1 C"

201− toAddTypeExprG = undefined

198+ toAddTypeExprG = error "invalid toAddTypeExprG in M1 C"

202− getConstructorsG (M1 v) = [DataConstructorDef (T.pack dName) dArgs]

199+ getConstructorsG ~(M1 v) = [DataConstructorDef (T.pack dName) dArgs]

203 where

200 where

204 dName = conName (undefined :: M1 C c a x)

201 dName = conName (undefined :: M1 C c a x)

205 dArgs = getConstructorArgsG v

202 dArgs = getConstructorArgsG v

@@ -211,9 +208,9 @@ instance (Selector c, AtomableG a) => AtomableG (M1 S c a) where

211 fromAtomG atom args = M1 <$> fromAtomG atom args

208 fromAtomG atom args = M1 <$> fromAtomG atom args

212 toAtomsG (M1 v) = toAtomsG v

209 toAtomsG (M1 v) = toAtomsG v

213 toAtomTypeG (M1 v) = toAtomTypeG v

210 toAtomTypeG (M1 v) = toAtomTypeG v

214− toAddTypeExprG _ _ = undefined

211+ toAddTypeExprG = error "invalid toAddTypeExprG in M1 S"

215− getConstructorsG = undefined

212+ getConstructorsG = error "invalid getConstructorsG in M1 S"

216− getConstructorArgsG (M1 v) = getConstructorArgsG v

213+ getConstructorArgsG ~(M1 v) = getConstructorArgsG v

217

214

218-- field data metadata

215-- field data metadata

219instance (Atomable a) => AtomableG (K1 c a) where

216instance (Atomable a) => AtomableG (K1 c a) where

@@ -223,48 +220,63 @@ instance (Atomable a) => AtomableG (K1 c a) where

223 headatom [] = error "no more atoms for constructor!"

220 headatom [] = error "no more atoms for constructor!"

224 toAtomsG (K1 v) = [toAtom v]

221 toAtomsG (K1 v) = [toAtom v]

225 toAtomTypeG _ = toAtomType (Proxy :: Proxy a)

222 toAtomTypeG _ = toAtomType (Proxy :: Proxy a)

226− toAddTypeExprG _ _ = undefined

223+ toAddTypeExprG = error "invalid toAddTypeExprG in K1"

227− getConstructorsG = undefined

224+ getConstructorsG = error "invalid getConstructorsG in K1"

228− getConstructorArgsG (K1 _) = [DataConstructorDefTypeConstructorArg tCons]

225+ getConstructorArgsG ~(K1 _) = [DataConstructorDefTypeConstructorArg tCons]

229 where

226 where

230− tCons = PrimitiveTypeConstructor primitiveATypeName primitiveAType

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

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

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

228+

233−

229+typeToTypeConstructor :: AtomType -> TypeConstructor

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

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

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

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

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

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

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

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

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

239+typeToTypeConstructor (RelationAtomType attrs)

240+ = RelationAtomTypeConstructor $ map attrToAttrExpr $ V.toList (attributesVec attrs)

241+ where

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

243+typeToTypeConstructor (ConstructedAtomType tcName tvMap)

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

245+typeToTypeConstructor (TypeVariableType tvName) = TypeVariable tvName

246+

234instance AtomableG U1 where

247instance AtomableG U1 where

235− toAtomG = undefined

248+ toAtomG = error "invalid toAtomG in U1"

236 fromAtomG _ _ = pure U1

249 fromAtomG _ _ = pure U1

237 toAtomsG _ = []

250 toAtomsG _ = []

238− toAtomTypeG = undefined

251+ toAtomTypeG = error "invalid toAtomTypeG in U1"

239− toAddTypeExprG = undefined

252+ toAddTypeExprG = error "invalid toAddTypeExprG in U1"

240− getConstructorsG = undefined

253+ getConstructorsG = error "invalid getConstructorsG in U1"

241 getConstructorArgsG _ = []

254 getConstructorArgsG _ = []

242

255

243-- product types

256-- product types

244instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where

257instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where

245 toAtomG = undefined

258 toAtomG = undefined

246− fromAtomG atom args = (:*:) <$> fromAtomG atom [headatom args] <*> fromAtomG atom (tailatoms args)

259+ fromAtomG atom args = (:*:) <$> fromAtomG atom splitargs1 <*> fromAtomG atom splitargs2

247− where headatom (x:_) = x

260+ where splitargs1 = take splitpoint args

248− headatom [] = error "no more atoms in head for product!"

261+ splitargs2 = drop splitpoint args

249− tailatoms (_:xs) = xs

262+ splitpoint = length args `div` 2

250− tailatoms [] = error "no more atoms in tail for product!"

263+ toAtomTypeG = error "invalid toAtomTypeG in :*:"

251− toAtomTypeG = undefined

252 toAtomsG (x :*: y) = toAtomsG x ++ toAtomsG y

264 toAtomsG (x :*: y) = toAtomsG x ++ toAtomsG y

253− toAddTypeExprG _ _ = undefined

265+ toAddTypeExprG = error "invalid toAddTypeExprG in :*:"

254− getConstructorsG = undefined

266+ getConstructorsG = error "invalid getConstructorsG in :*:"

255− getConstructorArgsG (x :*: y) = getConstructorArgsG x ++ getConstructorArgsG y

267+ getConstructorArgsG ~(x :*: y) = getConstructorArgsG x ++ getConstructorArgsG y

256

268

257-- sum types

269-- sum types

258instance (AtomableG a, AtomableG b) => AtomableG (a :+: b) where

270instance (AtomableG a, AtomableG b) => AtomableG (a :+: b) where

259 toAtomG (L1 x) = toAtomG x

271 toAtomG (L1 x) = toAtomG x

260 toAtomG (R1 x) = toAtomG x

272 toAtomG (R1 x) = toAtomG x

261 fromAtomG atom args = (L1 <$> fromAtomG atom args) <|> (R1 <$> fromAtomG atom args)

273 fromAtomG atom args = (L1 <$> fromAtomG atom args) <|> (R1 <$> fromAtomG atom args)

262− toAtomTypeG = undefined

274+ toAtomTypeG = error "invalid toAtomTypeG in :+:"

263 toAtomsG (L1 x) = toAtomsG x

275 toAtomsG (L1 x) = toAtomsG x

264 toAtomsG (R1 x) = toAtomsG x

276 toAtomsG (R1 x) = toAtomsG x

265− toAddTypeExprG _ _ = undefined

277+ toAddTypeExprG = error "invalid toAddTypeExprG in :+:"

266 getConstructorsG _ = getConstructorsG (undefined :: a x) ++ getConstructorsG (undefined :: b x)

278 getConstructorsG _ = getConstructorsG (undefined :: a x) ++ getConstructorsG (undefined :: b x)

267− getConstructorArgsG = undefined

279+ getConstructorArgsG = error "invalid getConstructorArgsG in :+:"

268

280

269--this represents the unimplemented generics traversals which should never be called

281--this represents the unimplemented generics traversals which should never be called

270{-

282{-

src/lib/ProjectM36/Attribute.hs+170−31

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

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

1module ProjectM36.Attribute where

2module ProjectM36.Attribute where

2import ProjectM36.Base

3import ProjectM36.Base

3import ProjectM36.Error

4import ProjectM36.Error

@@ -7,18 +8,57 @@ import qualified Data.Vector as V

7import qualified Data.Hashable as Hash

8import qualified Data.Hashable as Hash

8import qualified Data.HashSet as HS

9import qualified Data.HashSet as HS

9import qualified Data.Map as M

10import qualified Data.Map as M

11+import Data.Either

11arity :: Attributes -> Int

13arity :: Attributes -> Int

12−arity = V.length

14+arity a = V.length (attributesVec a)

15+

16+instance Semigroup Attributes where

17+ attrsA <> attrsB =

18+ case joinAttributes attrsA attrsB of

19+ Left err -> error (show err)

20+ Right attrs' -> attrs'

21+

22+instance Monoid Attributes where

23+ mempty = Attributes {

24+ attributesVec = mempty

25+ --,attributeSet = mempty

26+ }

14emptyAttributes :: Attributes

28emptyAttributes :: Attributes

15−emptyAttributes = V.empty

29+emptyAttributes = mempty

17null :: Attributes -> Bool

31null :: Attributes -> Bool

18−null = V.null

32+null a = V.null (attributesVec a)

33+

34+singleton :: Attribute -> Attributes

35+singleton attr = Attributes {

36+ attributesVec = V.singleton attr

37+ --,attributesSet = HS.singleton attr

38+ }

39+

40+toList :: Attributes -> [Attribute]

41+toList attrs = V.toList (attributesVec attrs)

20attributesFromList :: [Attribute] -> Attributes

43attributesFromList :: [Attribute] -> Attributes

21−attributesFromList = V.fromList -- . L.nub --too expensive

44+attributesFromList attrsL = Attributes {

45+ attributesVec = vec

46+ --,attributesSet = hset

47+ }

48+ where

49+ vec = if length attrsL == HS.size hset then

50+ --fast path- no duplicates

51+ V.fromList attrsL

52+ else

53+ --duplicate detected, uniqueify while maintaining original ordering

54+ V.fromList uniquedL

55+ hset = HS.fromList attrsL

56+ uniquedL = fst $ foldr (\attr acc@(l,s) ->

57+ if HS.member attr s then

58+ acc

59+ else

60+ (l ++ [attr], HS.insert attr s))

61+ ([],mempty) attrsL

23attributeName :: Attribute -> AttributeName

63attributeName :: Attribute -> AttributeName

24attributeName (Attribute name _) = name

64attributeName (Attribute name _) = name

@@ -27,14 +67,16 @@ atomType :: Attribute -> AtomType

27atomType (Attribute _ atype) = atype

67atomType (Attribute _ atype) = atype

29atomTypes :: Attributes -> V.Vector AtomType

69atomTypes :: Attributes -> V.Vector AtomType

30−atomTypes = V.map atomType

70+atomTypes attrs = V.map atomType (attributesVec attrs)

71+

72+atomTypesList :: Attributes -> [AtomType]

73+atomTypesList = V.toList . atomTypes

32−--hm- no error-checking here

33addAttribute :: Attribute -> Attributes -> Attributes

75addAttribute :: Attribute -> Attributes -> Attributes

34−addAttribute attr attrs = attrs `V.snoc` attr

76+addAttribute attr attrs = attrs <> singleton attr

36--if some attribute names overlap but the types do not, then spit back an error

78--if some attribute names overlap but the types do not, then spit back an error

37−joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes

79+{-joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes

38joinAttributes attrs1 attrs2 | V.length uniqueOverlappingAttributes /= V.length overlappingAttributes = Left (TupleAttributeTypeMismatchError overlappingAttributes)

80joinAttributes attrs1 attrs2 | V.length uniqueOverlappingAttributes /= V.length overlappingAttributes = Left (TupleAttributeTypeMismatchError overlappingAttributes)

39 | V.length overlappingAttrsDifferentTypes > 0 = Left (TupleAttributeTypeMismatchError overlappingAttrsDifferentTypes)

81 | V.length overlappingAttrsDifferentTypes > 0 = Left (TupleAttributeTypeMismatchError overlappingAttrsDifferentTypes)

40 | otherwise = Right $ vectorUniqueify (attrs1 V.++ attrs2)

82 | otherwise = Right $ vectorUniqueify (attrs1 V.++ attrs2)

@@ -43,20 +85,52 @@ joinAttributes attrs1 attrs2 | V.length uniqueOverlappingAttributes /= V.length

43 attrNames2 = V.map attributeName attrs2

85 attrNames2 = V.map attributeName attrs2

44 uniqueOverlappingAttributes = vectorUniqueify overlappingAttributes

86 uniqueOverlappingAttributes = vectorUniqueify overlappingAttributes

45 overlappingAttributes = V.filter (`V.elem` attrs2) attrs1

87 overlappingAttributes = V.filter (`V.elem` attrs2) attrs1

88+-}

89+joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes

90+joinAttributes attrs1 attrs2

91+ | S.size overlappingNames == 0 = -- fast path, no overlapping names

92+ pure (concated id)

93+ | attributesForNames overlappingNames attrs1 == attributesForNames overlappingNames attrs2 = -- that atomtypes match

94+ pure (concated vectorUniqueify)

95+ | otherwise =

96+ --special handling to validate that overlapping names have the same atom types

97+ Left (TupleAttributeTypeMismatchError (attributesForNames overlappingNames attrs1))

98+ where

99+ nameSet1 = attributeNameSet attrs1

100+ nameSet2 = attributeNameSet attrs2

101+ overlappingNames = S.intersection nameSet1 nameSet2

102+ concated f = Attributes {

103+ attributesVec = f (attributesVec attrs1 <> attributesVec attrs2)

104+ --,attributesSet = attributesSet attrs1 <> attributesSet attrs2

105+ }

106

47addAttributes :: Attributes -> Attributes -> Attributes

107addAttributes :: Attributes -> Attributes -> Attributes

48−addAttributes = (V.++)

108+addAttributes = (<>)

109+

110+member :: Attribute -> Attributes -> Bool

111+member attr attrs = HS.member attr (attributesSet attrs)

112

50deleteAttributeName :: AttributeName -> Attributes -> Attributes

113deleteAttributeName :: AttributeName -> Attributes -> Attributes

51−deleteAttributeName attrName = V.filter (\attr -> attributeName attr /= attrName)

114+deleteAttributeName attrName = deleteAttributeNames (S.singleton attrName)

115+

116+deleteAttributeNames :: S.Set AttributeName -> Attributes -> Attributes

117+deleteAttributeNames attrNames attrs = Attributes {

118+ attributesVec = vec

119+ }

120+ where

121+ vec = V.filter attrFilter (attributesVec attrs)

122+ attrFilter attr = S.notMember (attributeName attr) attrNames

123

53renameAttribute :: AttributeName -> Attribute -> Attribute

124renameAttribute :: AttributeName -> Attribute -> Attribute

54renameAttribute newAttrName (Attribute _ typeo) = Attribute newAttrName typeo

125renameAttribute newAttrName (Attribute _ typeo) = Attribute newAttrName typeo

126

56renameAttributes :: AttributeName -> AttributeName -> Attributes -> Attributes

127renameAttributes :: AttributeName -> AttributeName -> Attributes -> Attributes

57−renameAttributes oldAttrName newAttrName = V.map renamer

128+renameAttributes oldAttrName newAttrName attrs = Attributes {

129+ attributesVec = vec

130+ }

58 where

131 where

132+ vec = V.map renamer (attributesVec attrs)

59− renamer attr = if attributeName attr == oldAttrName then

133+ renamer attr = if attributeName attr == oldAttrName then

60 renameAttribute newAttrName attr

134 renameAttribute newAttrName attr

61 else

135 else

62 attr

136 attr

@@ -67,20 +141,36 @@ atomTypeForAttributeName attrName attrs = do

67 return atype

141 return atype

142

69attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute

143attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute

70−attributeForName attrName attrs = case V.find (\attr -> attributeName attr == attrName) attrs of

144+attributeForName attrName attrs = case V.find (\attr -> attributeName attr == attrName) (attributesVec attrs) of

71 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))

145 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))

72 Just attr -> Right attr

146 Just attr -> Right attr

147

148+isAttributeNameContained :: AttributeName -> Attributes -> Bool

149+isAttributeNameContained nam attrs = isRight (attributeForName nam attrs)

150+

151+--similar to attributesForNames, but returns error if some names are missing

152+projectionAttributesForNames :: S.Set AttributeName -> Attributes -> Either RelationalError Attributes

153+projectionAttributesForNames names attrsIn =

154+ if not (S.null missingNames) then

155+ Left (NoSuchAttributeNamesError missingNames)

156+ else

157+ Right (attributesForNames names attrsIn)

158+ where

159+ missingNames = attributeNamesNotContained names (S.fromList (V.toList (attributeNames attrsIn)))

160+

74attributesForNames :: S.Set AttributeName -> Attributes -> Attributes

161attributesForNames :: S.Set AttributeName -> Attributes -> Attributes

75−attributesForNames attrNameSet = V.filter filt

162+attributesForNames attrNameSet attrs = Attributes {

163+ attributesVec = vec

164+ }

76 where

165 where

166+ vec = V.filter filt (attributesVec attrs)

77 filt attr = S.member (attributeName attr) attrNameSet

167 filt attr = S.member (attributeName attr) attrNameSet

168

79attributeNameSet :: Attributes -> S.Set AttributeName

169attributeNameSet :: Attributes -> S.Set AttributeName

80−attributeNameSet attrVec = S.fromList $ V.toList $ V.map (\(Attribute name _) -> name) attrVec

170+attributeNameSet attrs = S.fromList $ V.toList $ V.map (\(Attribute name _) -> name) (attributesVec attrs)

171

82attributeNames :: Attributes -> V.Vector AttributeName

172attributeNames :: Attributes -> V.Vector AttributeName

83−attributeNames = V.map attributeName

173+attributeNames attrs = V.map attributeName (attributesVec attrs)

174

85--checks if set s1 is wholly contained in the set s2

175--checks if set s1 is wholly contained in the set s2

86attributesContained :: Attributes -> Attributes -> Bool

176attributesContained :: Attributes -> Attributes -> Bool

@@ -99,41 +189,90 @@ matchingAttributeNameSet = S.intersection

99attributeNamesNotContained :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName

189attributeNamesNotContained :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName

100attributeNamesNotContained subset superset = S.filter (`S.notMember` superset) subset

190attributeNamesNotContained subset superset = S.filter (`S.notMember` superset) subset

101

191

102−-- this is sorted so the tuples know in which order to output- the ordering is arbitrary

192+-- useful for display

103−sortedAttributeNameList :: S.Set AttributeName -> [AttributeName]

193+orderedAttributes :: Attributes -> [Attribute]

104−sortedAttributeNameList attrNameSet= L.sort $ S.toList attrNameSet

194+orderedAttributes attrs = L.sortBy (\a b -> attributeName a `compare` attributeName b) (V.toList (attributesVec attrs))

195+

196+orderedAttributeNames :: Attributes -> [AttributeName]

197+orderedAttributeNames attrs = map attributeName (orderedAttributes attrs)

105

198

106-- take two attribute sets and return an attribute set with the attributes which do not match

199-- take two attribute sets and return an attribute set with the attributes which do not match

200+--this is the function which benefits the most from the HashSet representation- this turned up in the insert performance test

107attributesDifference :: Attributes -> Attributes -> Attributes

201attributesDifference :: Attributes -> Attributes -> Attributes

108−attributesDifference attrsA attrsB = V.fromList $ diff (V.toList attrsA) (V.toList attrsB)

202+{-attributesDifference attrsA attrsB = V.fromList $ diff (V.toList attrsA) (V.toList attrsB)

109 where

203 where

110 diff a b = (a L.\\ b) ++ (b L.\\ a)

204 diff a b = (a L.\\ b) ++ (b L.\\ a)

205+-}

206+attributesDifference attrsA attrsB =

207+ if attributesSet attrsA == attributesSet attrsB then

208+ mempty

209+ else

210+ Attributes {

211+ attributesVec = vec

212+ --,attributesSet = hset

213+ }

214+ where

215+ hset = HS.difference setA setB <> HS.difference setB setA

216+ setA = attributesSet attrsA

217+ setB = attributesSet attrsB

218+ vec = V.filter (`HS.member` hset) (attributesVec attrsA <> attributesVec attrsB)

111

219

112vectorUniqueify :: (Hash.Hashable a, Eq a) => V.Vector a -> V.Vector a

220vectorUniqueify :: (Hash.Hashable a, Eq a) => V.Vector a -> V.Vector a

113vectorUniqueify vecIn = V.fromList $ HS.toList $ HS.fromList $ V.toList vecIn

221vectorUniqueify vecIn = V.fromList $ HS.toList $ HS.fromList $ V.toList vecIn

114

222

115--check that each attribute only appears once

223--check that each attribute only appears once

116verifyAttributes :: Attributes -> Either RelationalError Attributes

224verifyAttributes :: Attributes -> Either RelationalError Attributes

117−verifyAttributes attrs = if collapsedAttrs /= attrs then

225+verifyAttributes attrs =

226+ if vecSet == attributesSet attrs then

227+ pure attrs

228+ else

118− Left (TupleAttributeTypeMismatchError (attributesDifference collapsedAttrs attrs))

229+ Left (TupleAttributeTypeMismatchError diffAttrs)

119− else

230+ where

120− Right attrs

231+ vecSet = V.foldr' HS.insert HS.empty (attributesVec attrs)

232+ diffSet = HS.difference vecSet (attributesSet attrs) <> HS.difference (attributesSet attrs) vecSet

233+ diffAttrs = Attributes {

234+ attributesVec = V.fromList (HS.toList diffSet)

235+ --,attributesSet = diffSet

236+ }

237+

238+--used in Generics derivation for ADTs without named attributes- not to be used elsewhere

239+--drop first n attributes from vector representation

240+drop :: Int -> Attributes -> Attributes

241+drop c attrs = Attributes { attributesVec = vec

242+ }

121 where

243 where

122− collapsedAttrs = vectorUniqueify attrs

244+ vec = V.drop c (attributesVec attrs)

123

245

246+

247+-- use this in preference to attributesEqual when the attribute ordering matters such as during tuple unions

248+attributesAndOrderEqual :: Attributes -> Attributes -> Bool

249+attributesAndOrderEqual a b = attributesVec a == attributesVec b

250+

251+-- use to determine if the same attributes are contained (but ordering is irrelevant)

124attributesEqual :: Attributes -> Attributes -> Bool

252attributesEqual :: Attributes -> Attributes -> Bool

125−attributesEqual attrs1 attrs2 = V.null (attributesDifference attrs1 attrs2)

253+attributesEqual attrsA attrsB =

254+ attributesVec attrsA == attributesVec attrsB ||

255+ attributesSet attrsA == attributesSet attrsB

126

256

127attributesAsMap :: Attributes -> M.Map AttributeName Attribute

257attributesAsMap :: Attributes -> M.Map AttributeName Attribute

128−attributesAsMap attrs = (M.fromList . V.toList) (V.map (\attr -> (attributeName attr, attr)) attrs)

258+attributesAsMap attrs = V.foldr' (\attr acc -> M.insert (attributeName attr) attr acc) mempty (attributesVec attrs)

259+

129

260

130-- | Left-biased union of attributes.

261-- | Left-biased union of attributes.

131union :: Attributes -> Attributes -> Attributes

262union :: Attributes -> Attributes -> Attributes

132−union attrsA attrsB = V.fromList (M.elems unioned)

263+union attrsA attrsB = Attributes {

264+ attributesVec = vec

265+ --,attributesSet = hset

266+ }

133 where

267 where

134− unioned = M.union (attributesAsMap attrsA) (attributesAsMap attrsB)

268+ hset = HS.union (attributesSet attrsA) (attributesSet attrsB)

269+ vec = HS.foldr (flip V.snoc) mempty hset

135

270

136intersection :: Attributes -> Attributes -> Attributes

271intersection :: Attributes -> Attributes -> Attributes

137−intersection attrsA attrsB = V.fromList (M.elems intersected)

272+intersection attrsA attrsB = Attributes {

273+ attributesVec = vec

274+ --,attributesSet = hset

275+ }

138 where

276 where

139− intersected = M.intersection (attributesAsMap attrsA) (attributesAsMap attrsB)

277+ hset = HS.intersection (attributesSet attrsA) (attributesSet attrsB)

278+ vec = HS.foldr (flip V.snoc) mempty hset

src/lib/ProjectM36/AttributeExpr.hsnew file+7

@@ -0,0 +1,7 @@

1+module ProjectM36.AttributeExpr where

2+import ProjectM36.Base

3+import ProjectM36.Attribute as A

5+attributeName :: AttributeExprBase a -> AttributeName

6+attributeName (AttributeAndTypeNameExpr nam _ _) = nam

7+attributeName (NakedAttributeExpr attr) = A.attributeName attr

src/lib/ProjectM36/AttributeNames.hs+3−30

@@ -1,38 +1,11 @@

1module ProjectM36.AttributeNames where

2−import qualified ProjectM36.Attribute as A

3import ProjectM36.Base

2import ProjectM36.Base

4−import ProjectM36.Error

5import qualified Data.Set as S

3import qualified Data.Set as S

6−--AttributeNames is a data structure which can represent inverted projection attributes

4+--AttributeNames is a data structure which can represent inverted projection attributes and attribute names derived from relational expressions

8−empty :: AttributeNames

6+empty :: AttributeNamesBase a

9empty = AttributeNames S.empty

7empty = AttributeNames S.empty

11−all :: AttributeNames

9+all :: AttributeNamesBase a

12all = InvertedAttributeNames S.empty

10all = InvertedAttributeNames S.empty

14−--check that the attribute names are actually in the attributes

15−projectionAttributesForAttributeNames :: Attributes -> AttributeNames -> Either RelationalError Attributes

16−projectionAttributesForAttributeNames attrs (AttributeNames attrNameSet) = do

17− let nonExistentAttributeNames = A.attributeNamesNotContained attrNameSet (A.attributeNameSet attrs)

18− if not $ S.null nonExistentAttributeNames then

19− Left $ AttributeNamesMismatchError nonExistentAttributeNames

20− else

21− return $ A.attributesForNames attrNameSet attrs

22−projectionAttributesForAttributeNames attrs (InvertedAttributeNames unselectedAttrNameSet) = do

23− let nonExistentAttributeNames = A.attributeNamesNotContained unselectedAttrNameSet (A.attributeNameSet attrs)

24− if not $ S.null nonExistentAttributeNames then

25− Left $ AttributeNamesMismatchError nonExistentAttributeNames

26− else

27− return $ A.attributesForNames (A.nonMatchingAttributeNameSet unselectedAttrNameSet (A.attributeNameSet attrs)) attrs

28−projectionAttributesForAttributeNames attrs (UnionAttributeNames namesA namesB) = do

29− attrsA <- projectionAttributesForAttributeNames attrs namesA

30− attrsB <- projectionAttributesForAttributeNames attrs namesB

31− pure (A.union attrsA attrsB)

32−projectionAttributesForAttributeNames attrs (IntersectAttributeNames namesA namesB) = A.intersection <$> projectionAttributesForAttributeNames attrs namesA <*> projectionAttributesForAttributeNames attrs namesB

33−

34−invertAttributeNames :: AttributeNames -> AttributeNames

35−invertAttributeNames (AttributeNames names) = InvertedAttributeNames names

36−invertAttributeNames (InvertedAttributeNames names) = AttributeNames names

37−invertAttributeNames (UnionAttributeNames namesA namesB) = IntersectAttributeNames (invertAttributeNames namesA) (invertAttributeNames namesB)

38−invertAttributeNames (IntersectAttributeNames namesA namesB) = UnionAttributeNames (invertAttributeNames namesA) (invertAttributeNames namesB)

src/lib/ProjectM36/Base.hs+243−120

@@ -1,9 +1,12 @@

1−{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass, TypeSynonymInstances, FlexibleInstances #-}

1+{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass,FlexibleInstances,OverloadedStrings, DeriveTraversable, DerivingVia, TemplateHaskell, TypeFamilies #-}

2{-# OPTIONS_GHC -fno-warn-orphans #-}

3module ProjectM36.Base where

4module ProjectM36.Base where

4import ProjectM36.DatabaseContextFunctionError

5import ProjectM36.DatabaseContextFunctionError

5import ProjectM36.AtomFunctionError

6import ProjectM36.AtomFunctionError

7+import ProjectM36.MerkleHash

9+import Data.Functor.Foldable.TH

7import qualified Data.Map as M

10import qualified Data.Map as M

8import qualified Data.HashSet as HS

11import qualified Data.HashSet as HS

9import Data.Hashable (Hashable, hashWithSalt)

12import Data.Hashable (Hashable, hashWithSalt)

@@ -12,19 +15,21 @@ import Data.UUID (UUID)

12import Control.DeepSeq (NFData, rnf)

15import Control.DeepSeq (NFData, rnf)

13import Control.DeepSeq.Generics (genericRnf)

16import Control.DeepSeq.Generics (genericRnf)

14import GHC.Generics (Generic)

17import GHC.Generics (Generic)

18+import GHC.Stack

15import qualified Data.Vector as V

19import qualified Data.Vector as V

16import qualified Data.List as L

20import qualified Data.List as L

17import Data.Text (Text,unpack)

21import Data.Text (Text,unpack)

18−import Data.Binary

19−import Data.Vector.Binary()

20import Data.Time.Clock

22import Data.Time.Clock

21−import Data.Time.Clock.POSIX

22−import Data.Time.Calendar (Day,toGregorian,fromGregorian)

23import Data.Hashable.Time ()

24+import Data.Time.Calendar (Day)

24import Data.Typeable

25import Data.Typeable

25import Data.ByteString (ByteString)

26import Data.ByteString (ByteString)

27+import qualified Data.List.NonEmpty as NE

28+import Data.Vector.Instances ()

27type StringType = Text

30type StringType = Text

31+

32+type DatabaseName = String

29-- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.

34-- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.

30data Atom = IntegerAtom Integer |

35data Atom = IntegerAtom Integer |

@@ -35,12 +40,10 @@ data Atom = IntegerAtom Integer |

35 DateTimeAtom UTCTime |

40 DateTimeAtom UTCTime |

36 ByteStringAtom ByteString |

41 ByteStringAtom ByteString |

37 BoolAtom Bool |

42 BoolAtom Bool |

38− IntervalAtom Atom Atom OpenInterval OpenInterval |

39 RelationAtom Relation |

43 RelationAtom Relation |

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

40 ConstructedAtom DataConstructorName AtomType [Atom]

45 ConstructedAtom DataConstructorName AtomType [Atom]

41− deriving (Eq, Show, Binary, Typeable, NFData, Generic)

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

42−

43−type OpenInterval = Bool

45instance Hashable Atom where

48instance Hashable Atom where

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

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

@@ -53,20 +56,8 @@ instance Hashable Atom where

53 hashWithSalt salt (DateTimeAtom dt) = salt `hashWithSalt` dt

56 hashWithSalt salt (DateTimeAtom dt) = salt `hashWithSalt` dt

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

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

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

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

56− hashWithSalt salt (IntervalAtom a1 a2 bo be) = salt `hashWithSalt` a1 `hashWithSalt` a2 `hashWithSalt` bo `hashWithSalt` be

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

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

58−

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

59−instance Binary UTCTime where

60− put utc = put $ toRational (utcTimeToPOSIXSeconds utc)

61− get = do

62− r <- get :: Get Rational

63− return (posixSecondsToUTCTime (fromRational r))

64−

65−instance Binary Day where

66− put day = put $ toGregorian day

67− get = do

68− (y,m,d) <- get :: Get (Integer, Int, Int)

69− return (fromGregorian y m d)

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

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

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

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

@@ -78,13 +69,17 @@ data AtomType = IntAtomType |

78 DateTimeAtomType |

69 DateTimeAtomType |

79 ByteStringAtomType |

70 ByteStringAtomType |

80 BoolAtomType |

71 BoolAtomType |

81− IntervalAtomType AtomType |

82 RelationAtomType Attributes |

72 RelationAtomType Attributes |

83 ConstructedAtomType TypeConstructorName TypeVarMap |

73 ConstructedAtomType TypeConstructorName TypeVarMap |

74+ RelationalExprAtomType |

84 TypeVariableType TypeVarName

75 TypeVariableType TypeVarName

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

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

86− deriving (Eq, NFData, Generic, Binary, Show)

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

87−

78+

79+instance Ord AtomType where

80+ compare = undefined

81+

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

88type TypeVarMap = M.Map TypeVarName AtomType

83type TypeVarMap = M.Map TypeVarName AtomType

90instance Hashable TypeVarMap where

85instance Hashable TypeVarMap where

@@ -99,25 +94,37 @@ isRelationAtomType _ = False

99type AttributeName = StringType

94type AttributeName = StringType

100

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

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

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

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

103

104instance Hashable Attribute where

99instance Hashable Attribute where

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

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

106

101

102+type AttributesHash = Int

103+

107-- | 'Attributes' represent the head of a relation.

104-- | 'Attributes' represent the head of a relation.

105+newtype Attributes = Attributes {

108−type Attributes = V.Vector Attribute

106+ attributesVec :: V.Vector Attribute

107+ --,attributesSet :: HS.HashSet Attribute --compare with this generated in heap profile and benchmarks

108+ }

109+ deriving (NFData, Read, Hashable, Generic)

110+

111+attributesSet :: Attributes -> HS.HashSet Attribute

112+attributesSet = HS.fromList . V.toList . attributesVec

113+

114+instance Show Attributes where

115+ show attrs = "attributesFromList [" <> L.intercalate ", " (map (\attr -> "(" <> show attr <> ")") (V.toList (attributesVec attrs))) <> "]"

116+

117+--when attribute ordering is irrelevant

118+instance Eq Attributes where

119+ attrsA == attrsB =

120+ attributesVec attrsA == attributesVec attrsB ||

121+ attributesSet attrsA == attributesSet attrsB

109

122

110−-- | Equality function for a set of attributes.

111−attributesEqual :: Attributes -> Attributes -> Bool

112−attributesEqual attrs1 attrs2 = attrsAsSet attrs1 == attrsAsSet attrs2

113− where

114− attrsAsSet = HS.fromList . V.toList

115−

116sortedAttributesIndices :: Attributes -> [(Int, Attribute)]

123sortedAttributesIndices :: Attributes -> [(Int, Attribute)]

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

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

118

125

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

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

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

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

121

128

122instance Read Relation where

129instance Read Relation where

123 readsPrec = error "relation read not supported"

130 readsPrec = error "relation read not supported"

@@ -133,8 +140,8 @@ instance NFData RelationTupleSet where rnf = genericRnf

133instance Hashable RelationTuple where

140instance Hashable RelationTuple where

134 --sanity check the tuple for attribute and tuple counts

141 --sanity check the tuple for attribute and tuple counts

135 --this bit me when tuples were being hashed before being verified

142 --this bit me when tuples were being hashed before being verified

136− hashWithSalt salt (RelationTuple attrs tupVec) = if V.length attrs /= V.length tupVec then

143+ hashWithSalt salt (RelationTuple attrs tupVec) = if V.length (attributesVec attrs) /= V.length tupVec then

137− error "invalid tuple: attributes and tuple count mismatch"

144+ error ("invalid tuple: attributes and tuple count mismatch " <> show (attributesVec attrs, tupVec))

138 else

145 else

139 salt `hashWithSalt`

146 salt `hashWithSalt`

140 sortedAttrs `hashWithSalt`

147 sortedAttrs `hashWithSalt`

@@ -145,24 +152,23 @@ instance Hashable RelationTuple where

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

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

146

153

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

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

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

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

149−

150−instance Binary RelationTuple

151

156

152instance Eq RelationTuple where

157instance Eq RelationTuple where

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

158+ tuple1@(RelationTuple attrs1 _) == tuple2@(RelationTuple attrs2 _) =

159+ attrs1 == attrs2 && atomsEqual

154 where

160 where

155− atomForAttribute attr (RelationTuple attrs tupVec) = case V.findIndex (== attr) attrs of

161+ atomForAttribute attr (RelationTuple attrs tupVec) = case V.findIndex (== attr) (attributesVec attrs) of

156− Nothing -> Nothing

162+ Nothing -> Nothing

157− Just index -> tupVec V.!? index

163+ Just index -> tupVec V.!? index

158− atomsEqual = V.all (== True) $ V.map (\attr -> atomForAttribute attr tuple1 == atomForAttribute attr tuple2) attrs1

164+ atomsEqual = V.all (== True) $ V.map (\attr -> atomForAttribute attr tuple1 == atomForAttribute attr tuple2) (attributesVec attrs1)

159

165

160instance NFData RelationTuple where rnf = genericRnf

166instance NFData RelationTuple where rnf = genericRnf

161

167

162data Relation = Relation Attributes RelationTupleSet deriving (Show, Generic,Typeable)

168data Relation = Relation Attributes RelationTupleSet deriving (Show, Generic,Typeable)

163

169

164instance Eq Relation where

170instance Eq Relation where

165− Relation attrs1 tupSet1 == Relation attrs2 tupSet2 = attributesEqual attrs1 attrs2 && tupSet1 == tupSet2

171+ Relation attrs1 tupSet1 == Relation attrs2 tupSet2 = attrs1 == attrs2 && tupSet1 == tupSet2

166

172

167instance NFData Relation where rnf = genericRnf

173instance NFData Relation where rnf = genericRnf

168

174

@@ -173,8 +179,6 @@ instance Hashable Relation where

173 where

179 where

174 sortedAttrs = map snd (sortedAttributesIndices attrs)

180 sortedAttrs = map snd (sortedAttributesIndices attrs)

175

181

176−instance Binary Relation

177−

178-- | Used to represent the number of tuples in a relation.

182-- | Used to represent the number of tuples in a relation.

179data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)

183data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)

180

184

@@ -186,7 +190,7 @@ type RelationalExpr = RelationalExprBase ()

186-- | A relational expression represents query (read) operations on a database.

190-- | A relational expression represents query (read) operations on a database.

187data RelationalExprBase a =

191data RelationalExprBase a =

188 --- | Create a relation from tuple expressions.

192 --- | Create a relation from tuple expressions.

189− MakeRelationFromExprs (Maybe [AttributeExprBase a]) [TupleExprBase a] |

193+ MakeRelationFromExprs (Maybe [AttributeExprBase a]) (TupleExprsBase a) |

190 --- | Create and reference a relation from attributes and a tuple set.

194 --- | Create and reference a relation from attributes and a tuple set.

191 MakeStaticRelation Attributes RelationTupleSet |

195 MakeStaticRelation Attributes RelationTupleSet |

192 --- | Reference an existing relation in Haskell-space.

196 --- | Reference an existing relation in Haskell-space.

@@ -195,9 +199,9 @@ data RelationalExprBase a =

195 --in Tutorial D, relational variables pick up the type of the first relation assigned to them

199 --in Tutorial D, relational variables pick up the type of the first relation assigned to them

196 --relational variables should also be able to be explicitly-typed like in Haskell

200 --relational variables should also be able to be explicitly-typed like in Haskell

197 --- | Reference a relation variable by its name.

201 --- | Reference a relation variable by its name.

198− RelationVariable RelVarName a |

202+ RelationVariable RelVarName a |

199 --- | Create a projection over attribute names. (Note that the 'AttributeNames' structure allows for the names to be inverted.)

203 --- | Create a projection over attribute names. (Note that the 'AttributeNames' structure allows for the names to be inverted.)

200− Project AttributeNames (RelationalExprBase a) |

204+ Project (AttributeNamesBase a) (RelationalExprBase a) |

201 --- | Create a union of two relational expressions. The expressions should have identical attributes.

205 --- | Create a union of two relational expressions. The expressions should have identical attributes.

202 Union (RelationalExprBase a) (RelationalExprBase a) |

206 Union (RelationalExprBase a) (RelationalExprBase a) |

203 --- | Create a join of two relational expressions. The join occurs on attributes which are identical. If the expressions have no overlapping attributes, the join becomes a cross-product of both tuple sets.

207 --- | Create a join of two relational expressions. The join occurs on attributes which are identical. If the expressions have no overlapping attributes, the join becomes a cross-product of both tuple sets.

@@ -207,7 +211,7 @@ data RelationalExprBase a =

207 --- | Return a relation containing all tuples of the first argument which do not appear in the second argument (minus).

211 --- | Return a relation containing all tuples of the first argument which do not appear in the second argument (minus).

208 Difference (RelationalExprBase a) (RelationalExprBase a) |

212 Difference (RelationalExprBase a) (RelationalExprBase a) |

209 --- | Create a sub-relation composed of the first argument's attributes which will become an attribute of the result expression. The unreferenced attributes are not altered in the result but duplicate tuples in the projection of the expression minus the attribute names are compressed into one. For more information, <https://github.com/agentm/project-m36/blob/master/docs/introduction_to_the_relational_algebra.markdown#group read the relational algebra tutorial.>

213 --- | Create a sub-relation composed of the first argument's attributes which will become an attribute of the result expression. The unreferenced attributes are not altered in the result but duplicate tuples in the projection of the expression minus the attribute names are compressed into one. For more information, <https://github.com/agentm/project-m36/blob/master/docs/introduction_to_the_relational_algebra.markdown#group read the relational algebra tutorial.>

210− Group AttributeNames AttributeName (RelationalExprBase a) |

214+ Group (AttributeNamesBase a) AttributeName (RelationalExprBase a) |

211 --- | Create an expression to unwrap a sub-relation contained within at an attribute's name. Note that this is not always an inverse of a group operation.

215 --- | Create an expression to unwrap a sub-relation contained within at an attribute's name. Note that this is not always an inverse of a group operation.

212 Ungroup AttributeName (RelationalExprBase a) |

216 Ungroup AttributeName (RelationalExprBase a) |

213 --- | Filter the tuples of the relational expression to only retain the tuples which evaluate against the restriction predicate to true.

217 --- | Filter the tuples of the relational expression to only retain the tuples which evaluate against the restriction predicate to true.

@@ -215,12 +219,21 @@ data RelationalExprBase a =

215 --- | Returns the true relation iff

219 --- | Returns the true relation iff

216 Equals (RelationalExprBase a) (RelationalExprBase a) |

220 Equals (RelationalExprBase a) (RelationalExprBase a) |

217 NotEquals (RelationalExprBase a) (RelationalExprBase a) |

221 NotEquals (RelationalExprBase a) (RelationalExprBase a) |

218− Extend (ExtendTupleExprBase a) (RelationalExprBase a)

222+ Extend (ExtendTupleExprBase a) (RelationalExprBase a) |

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

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

224+ --Evaluate relationalExpr with scoped views

225+ With [(WithNameExprBase a, RelationalExprBase a)] (RelationalExprBase a)

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

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

221−

227+

222−instance Binary RelationalExpr

228+instance Hashable RelationalExpr

223−

229+

230+data WithNameExprBase a = WithNameExpr RelVarName a

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

232+

233+type WithNameExpr = WithNameExprBase ()

234+

235+type GraphRefWithNameExpr = WithNameExprBase GraphRefTransactionMarker

236+

224type NotificationName = StringType

237type NotificationName = StringType

225type Notifications = M.Map NotificationName Notification

238type Notifications = M.Map NotificationName Notification

226

239

@@ -230,20 +243,22 @@ data Notification = Notification {

230 reportOldExpr :: RelationalExpr, --run the expression in the pre-change context

243 reportOldExpr :: RelationalExpr, --run the expression in the pre-change context

231 reportNewExpr :: RelationalExpr --run the expression in the post-change context

244 reportNewExpr :: RelationalExpr --run the expression in the post-change context

232 }

245 }

233− deriving (Show, Eq, Binary, Generic, NFData)

246+ deriving (Show, Eq, Generic, NFData)

234

247

235type TypeVarName = StringType

248type TypeVarName = StringType

236

249

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

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

238data TypeConstructorDef = ADTypeConstructorDef TypeConstructorName [TypeVarName] |

251data TypeConstructorDef = ADTypeConstructorDef TypeConstructorName [TypeVarName] |

239 PrimitiveTypeConstructorDef TypeConstructorName AtomType

252 PrimitiveTypeConstructorDef TypeConstructorName AtomType

240− deriving (Show, Generic, Binary, Eq, NFData)

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

241

254

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

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

256+type TypeConstructor = TypeConstructorBase ()

243−data TypeConstructor = ADTypeConstructor TypeConstructorName [TypeConstructor] |

257+data TypeConstructorBase a = ADTypeConstructor TypeConstructorName [TypeConstructor] |

244− PrimitiveTypeConstructor TypeConstructorName AtomType |

258+ PrimitiveTypeConstructor TypeConstructorName AtomType |

259+ RelationAtomTypeConstructor [AttributeExprBase a] |

245− TypeVariable TypeVarName

260+ TypeVariable TypeVarName

246− deriving (Show, Generic, Binary, Eq, NFData)

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

247

262

248type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)]

263type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)]

249

264

@@ -253,16 +268,23 @@ type DataConstructorName = StringType

253type AtomTypeName = StringType

268type AtomTypeName = StringType

254

269

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

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

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

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

257

272

258type DataConstructorDefs = [DataConstructorDef]

273type DataConstructorDefs = [DataConstructorDef]

259

274

260data DataConstructorDefArg = DataConstructorDefTypeConstructorArg TypeConstructor |

275data DataConstructorDefArg = DataConstructorDefTypeConstructorArg TypeConstructor |

261 DataConstructorDefTypeVarNameArg TypeVarName

276 DataConstructorDefTypeVarNameArg TypeVarName

262− deriving (Show, Generic, Binary, Eq, NFData)

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

263

278

264type InclusionDependencies = M.Map IncDepName InclusionDependency

279type InclusionDependencies = M.Map IncDepName InclusionDependency

265−type RelationVariables = M.Map RelVarName Relation

280+type RelationVariables = M.Map RelVarName GraphRefRelationalExpr

281+

282+data GraphRefTransactionMarker = TransactionMarker TransactionId |

283+ UncommittedContextMarker

284+ deriving (Eq, Show, Generic, NFData, Ord)

285+

286+-- a fundamental relational expr to which other relational expressions compile

287+type GraphRefRelationalExpr = RelationalExprBase GraphRefTransactionMarker

266

288

267type SchemaName = StringType

289type SchemaName = StringType

268

290

@@ -270,17 +292,18 @@ type Subschemas = M.Map SchemaName Schema

270

292

271-- | Every transaction has one concrete database context and any number of isomorphic subschemas.

293-- | Every transaction has one concrete database context and any number of isomorphic subschemas.

272data Schemas = Schemas DatabaseContext Subschemas

294data Schemas = Schemas DatabaseContext Subschemas

295+ deriving (Generic)

273

296

274-- | The DatabaseContext is a snapshot of a database's evolving state and contains everything a database client can change over time.

297-- | The DatabaseContext is a snapshot of a database's evolving state and contains everything a database client can change over time.

275-- I spent some time thinking about whether the VirtualDatabaseContext/Schema and DatabaseContext data constructors should be the same constructor, but that would allow relation variables to be created in a "virtual" context which would appear to defeat the isomorphisms of the contexts. It should be possible to switch to an alternative schema to view the same equivalent information without information loss. However, allowing all contexts to reference another context while maintaining its own relation variables, new types, etc. could be interesting from a security perspective. For example, if a user creates a new relvar in a virtual context, then does it necessarily appear in all linked contexts? After deliberation, I think the relvar should appear in *all* linked contexts to retain the isomorphic properties, even when the isomorphism is for a subset of the context. This hints that the IsoMorphs should allow for "fall-through"; that is, when a relvar is not defined in the virtual context (for morphing), then the lookup should fall through to the underlying context.

298-- I spent some time thinking about whether the VirtualDatabaseContext/Schema and DatabaseContext data constructors should be the same constructor, but that would allow relation variables to be created in a "virtual" context which would appear to defeat the isomorphisms of the contexts. It should be possible to switch to an alternative schema to view the same equivalent information without information loss. However, allowing all contexts to reference another context while maintaining its own relation variables, new types, etc. could be interesting from a security perspective. For example, if a user creates a new relvar in a virtual context, then does it necessarily appear in all linked contexts? After deliberation, I think the relvar should appear in *all* linked contexts to retain the isomorphic properties, even when the isomorphism is for a subset of the context. This hints that the IsoMorphs should allow for "fall-through"; that is, when a relvar is not defined in the virtual context (for morphing), then the lookup should fall through to the underlying context.

276newtype Schema = Schema SchemaIsomorphs

299newtype Schema = Schema SchemaIsomorphs

277− deriving (Generic, Binary)

300+ deriving (Generic)

278

301

279data SchemaIsomorph = IsoRestrict RelVarName RestrictionPredicateExpr (RelVarName, RelVarName) |

302data SchemaIsomorph = IsoRestrict RelVarName RestrictionPredicateExpr (RelVarName, RelVarName) |

280 IsoRename RelVarName RelVarName |

303 IsoRename RelVarName RelVarName |

281 IsoUnion (RelVarName, RelVarName) RestrictionPredicateExpr RelVarName --maps two relvars to one relvar

304 IsoUnion (RelVarName, RelVarName) RestrictionPredicateExpr RelVarName --maps two relvars to one relvar

282 -- IsoTypeConstructor in morphAttrExpr

305 -- IsoTypeConstructor in morphAttrExpr

283− deriving (Generic, Binary, Show)

306+ deriving (Generic, Show)

284

307

285type SchemaIsomorphs = [SchemaIsomorph]

308type SchemaIsomorphs = [SchemaIsomorph]

286

309

@@ -296,24 +319,28 @@ data DatabaseContext = DatabaseContext {

296type IncDepName = StringType

319type IncDepName = StringType

297

320

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

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

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

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

300−

301−instance Binary InclusionDependency

302

323

303type AttributeNameAtomExprMap = M.Map AttributeName AtomExpr

324type AttributeNameAtomExprMap = M.Map AttributeName AtomExpr

304

325

305--used for returning information about individual expressions

326--used for returning information about individual expressions

306type DatabaseContextExprName = StringType

327type DatabaseContextExprName = StringType

307

328

329+type DatabaseContextExpr = DatabaseContextExprBase ()

330+

331+instance Hashable DatabaseContextExpr

332+

333+type GraphRefDatabaseContextExpr = DatabaseContextExprBase GraphRefTransactionMarker

334+

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

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

309−data DatabaseContextExpr =

336+data DatabaseContextExprBase a =

310 NoOperation |

337 NoOperation |

311− Define RelVarName [AttributeExpr] |

338+ Define RelVarName [AttributeExprBase a] |

312 Undefine RelVarName | --forget existence of relvar X

339 Undefine RelVarName | --forget existence of relvar X

313− Assign RelVarName RelationalExpr |

340+ Assign RelVarName (RelationalExprBase a) |

314− Insert RelVarName RelationalExpr |

341+ Insert RelVarName (RelationalExprBase a) |

315− Delete RelVarName RestrictionPredicateExpr |

342+ Delete RelVarName (RestrictionPredicateExprBase a) |

316− Update RelVarName AttributeNameAtomExprMap RestrictionPredicateExpr |

343+ Update RelVarName AttributeNameAtomExprMap (RestrictionPredicateExprBase a) |

317

344

318 AddInclusionDependency IncDepName InclusionDependency |

345 AddInclusionDependency IncDepName InclusionDependency |

319 RemoveInclusionDependency IncDepName |

346 RemoveInclusionDependency IncDepName |

@@ -329,19 +356,36 @@ data DatabaseContextExpr =

329

356

330 RemoveDatabaseContextFunction DatabaseContextFunctionName |

357 RemoveDatabaseContextFunction DatabaseContextFunctionName |

331

358

332− ExecuteDatabaseContextFunction DatabaseContextFunctionName [AtomExpr] |

359+ ExecuteDatabaseContextFunction DatabaseContextFunctionName [AtomExprBase a] |

333

360

334− MultipleExpr [DatabaseContextExpr]

361+ MultipleExpr [DatabaseContextExprBase a]

335− deriving (Show, Eq, Binary, Generic)

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

336

363

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

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

366+

367+type ObjModuleName = StringType

368+type ObjFunctionName = StringType

369+type Range = (Int,Int)

337-- | Adding an atom function should be nominally a DatabaseExpr except for the fact that it cannot be performed purely. Thus, we create the DatabaseContextIOExpr.

370-- | Adding an atom function should be nominally a DatabaseExpr except for the fact that it cannot be performed purely. Thus, we create the DatabaseContextIOExpr.

371+data DatabaseContextIOExprBase a =

338−data DatabaseContextIOExpr = AddAtomFunction AtomFunctionName [TypeConstructor] AtomFunctionBodyScript |

372+ AddAtomFunction AtomFunctionName [TypeConstructor] AtomFunctionBodyScript |

373+ LoadAtomFunctions ObjModuleName ObjFunctionName FilePath |

339− AddDatabaseContextFunction DatabaseContextFunctionName [TypeConstructor] DatabaseContextFunctionBodyScript

374+ AddDatabaseContextFunction DatabaseContextFunctionName [TypeConstructor] DatabaseContextFunctionBodyScript |

375+ LoadDatabaseContextFunctions ObjModuleName ObjFunctionName FilePath |

376+ CreateArbitraryRelation RelVarName [AttributeExprBase a] Range

340− deriving (Show, Eq, Generic, Binary)

377+ deriving (Show, Eq, Generic)

378+

379+type GraphRefDatabaseContextIOExpr = DatabaseContextIOExprBase GraphRefTransactionMarker

341

380

381+type DatabaseContextIOExpr = DatabaseContextIOExprBase ()

342

382

343type RestrictionPredicateExpr = RestrictionPredicateExprBase ()

383type RestrictionPredicateExpr = RestrictionPredicateExprBase ()

344

384

385+instance Hashable RestrictionPredicateExpr

386+

387+type GraphRefRestrictionPredicateExpr = RestrictionPredicateExprBase GraphRefTransactionMarker

388+

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

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

346data RestrictionPredicateExprBase a =

390data RestrictionPredicateExprBase a =

347 TruePredicate |

391 TruePredicate |

@@ -351,9 +395,7 @@ data RestrictionPredicateExprBase a =

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

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

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

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

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

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

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

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

355−

356−instance Binary RestrictionPredicateExpr

357

399

358-- child + parent links

400-- child + parent links

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

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

@@ -363,32 +405,42 @@ type TransactionHeads = M.Map HeadName Transaction

363

405

364-- | The transaction graph is the global database's state which references every committed transaction.

406-- | The transaction graph is the global database's state which references every committed transaction.

365data TransactionGraph = TransactionGraph TransactionHeads (S.Set Transaction)

407data TransactionGraph = TransactionGraph TransactionHeads (S.Set Transaction)

366−

408+ deriving Generic

367−transactionsForGraph :: TransactionGraph -> S.Set Transaction

368−transactionsForGraph (TransactionGraph _ t) = t

369

409

370transactionHeadsForGraph :: TransactionGraph -> TransactionHeads

410transactionHeadsForGraph :: TransactionGraph -> TransactionHeads

371−transactionHeadsForGraph (TransactionGraph heads _) = heads

411+transactionHeadsForGraph (TransactionGraph hs _) = hs

412+

413+transactionsForGraph :: TransactionGraph -> S.Set Transaction

414+transactionsForGraph (TransactionGraph _ ts) = ts

372

415

373-- | Every transaction has context-specific information attached to it.

416-- | Every transaction has context-specific information attached to it.

417+-- The `TransactionDiff`s represent child/edge relationships to previous transactions (branches or continuations of the same branch).

374−data TransactionInfo = TransactionInfo TransactionId (S.Set TransactionId) UTCTime | -- 1 parent + n children

418+data TransactionInfo = TransactionInfo {

419+ parents :: TransactionParents,

420+ stamp :: UTCTime,

421+ merkleHash :: MerkleHash

422+ } deriving (Show, Generic)

423+

424+type TransactionParents = NE.NonEmpty TransactionId

425+{-

426+data TransactionInfo = TransactionInfo TransactionId TransactionDiffs UTCTime | -- 1 parent + n children

375− MergeTransactionInfo TransactionId TransactionId (S.Set TransactionId) UTCTime -- 2 parents, n children

427+ MergeTransactionInfo TransactionId TransactionId TransactionDiffs UTCTime -- 2 parents, n children

376− deriving(Show, Generic)

428+ deriving (Show, Generic)

377−

429+-}

378−instance Binary TransactionInfo

379

430

380-- | Every set of modifications made to the database are atomically committed to the transaction graph as a transaction.

431-- | Every set of modifications made to the database are atomically committed to the transaction graph as a transaction.

381type TransactionId = UUID

432type TransactionId = UUID

382

433

383data Transaction = Transaction TransactionId TransactionInfo Schemas

434data Transaction = Transaction TransactionId TransactionInfo Schemas

435+ deriving Generic

384

436

385−--instance Binary Transaction

437+-- | The disconnected transaction represents an in-progress workspace used by sessions before changes are committed. This is similar to git's "index". After a transaction is committed, it is "connected" in the transaction graph and can no longer be modified.

386−

438+data DisconnectedTransaction = DisconnectedTransaction TransactionId Schemas DirtyFlag

439+--the database context expression represents a difference between the disconnected transaction and its immutable parent transaction- is this diff expr used at all?

440+

387type DirtyFlag = Bool

441type DirtyFlag = Bool

388

442

389−-- | The disconnected transaction represents an in-progress workspace used by sessions before changes are committed. This is similar to git's "index". After a transaction is committed, it is "connected" in the transaction graph and can no longer be modified.

443+type TransactionDiffExpr = DatabaseContextExpr

390−data DisconnectedTransaction = DisconnectedTransaction TransactionId Schemas DirtyFlag --parentID, context- the context here represents the singular concrete context from the schema

391−--the dirty flag indicates that the database context has diverged from its parent's context

392

444

393transactionId :: Transaction -> TransactionId

445transactionId :: Transaction -> TransactionId

394transactionId (Transaction tid _ _) = tid

446transactionId (Transaction tid _ _) = tid

@@ -404,24 +456,28 @@ instance Ord Transaction where

404

456

405type AtomExpr = AtomExprBase ()

457type AtomExpr = AtomExprBase ()

406

458

459+instance Hashable AtomExpr

460+

461+type GraphRefAtomExpr = AtomExprBase GraphRefTransactionMarker

462+

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

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

408data AtomExprBase a = AttributeAtomExpr AttributeName |

464data AtomExprBase a = AttributeAtomExpr AttributeName |

409 NakedAtomExpr Atom |

465 NakedAtomExpr Atom |

410 FunctionAtomExpr AtomFunctionName [AtomExprBase a] a |

466 FunctionAtomExpr AtomFunctionName [AtomExprBase a] a |

411 RelationAtomExpr (RelationalExprBase a) |

467 RelationAtomExpr (RelationalExprBase a) |

412 ConstructedAtomExpr DataConstructorName [AtomExprBase a] a

468 ConstructedAtomExpr DataConstructorName [AtomExprBase a] a

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

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

414

470

415−instance Binary AtomExpr

416−

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

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

418data ExtendTupleExprBase a = AttributeExtendTupleExpr AttributeName (AtomExprBase a)

472data ExtendTupleExprBase a = AttributeExtendTupleExpr AttributeName (AtomExprBase a)

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

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

420

474

421−type ExtendTupleExpr = ExtendTupleExprBase ()

475+type ExtendTupleExpr = ExtendTupleExprBase ()

476+

477+instance Hashable ExtendTupleExpr

478+

479+type GraphRefExtendTupleExpr = ExtendTupleExprBase GraphRefTransactionMarker

422

480

423−instance Binary ExtendTupleExpr

424−

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

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

426type AtomFunctions = HS.HashSet AtomFunction

482type AtomFunctions = HS.HashSet AtomFunction

427

483

@@ -432,6 +488,7 @@ type AtomFunctionBodyScript = StringType

432type AtomFunctionBodyType = [Atom] -> Either AtomFunctionError Atom

488type AtomFunctionBodyType = [Atom] -> Either AtomFunctionError Atom

433

489

434data AtomFunctionBody = AtomFunctionBody (Maybe AtomFunctionBodyScript) AtomFunctionBodyType

490data AtomFunctionBody = AtomFunctionBody (Maybe AtomFunctionBodyScript) AtomFunctionBodyType

491+ deriving Generic

435

492

436instance NFData AtomFunctionBody where

493instance NFData AtomFunctionBody where

437 rnf (AtomFunctionBody mScript _) = rnf mScript

494 rnf (AtomFunctionBody mScript _) = rnf mScript

@@ -461,12 +518,22 @@ instance Show AtomFunction where

461 showArgTypes = L.intercalate "->" (map show (atomFuncType aFunc))

518 showArgTypes = L.intercalate "->" (map show (atomFuncType aFunc))

462

519

463-- | The 'AttributeNames' structure represents a set of attribute names or the same set of names but inverted in the context of a relational expression. For example, if a relational expression has attributes named "a", "b", and "c", the 'InvertedAttributeNames' of ("a","c") is ("b").

520-- | The 'AttributeNames' structure represents a set of attribute names or the same set of names but inverted in the context of a relational expression. For example, if a relational expression has attributes named "a", "b", and "c", the 'InvertedAttributeNames' of ("a","c") is ("b").

464−data AttributeNames = AttributeNames (S.Set AttributeName) |

521+data AttributeNamesBase a = AttributeNames (S.Set AttributeName) |

465− InvertedAttributeNames (S.Set AttributeName) |

522+ InvertedAttributeNames (S.Set AttributeName) |

466− UnionAttributeNames AttributeNames AttributeNames |

523+ UnionAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |

467− IntersectAttributeNames AttributeNames AttributeNames

524+ IntersectAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |

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

468− deriving (Eq, Show, Generic, Binary, NFData)

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

469−

527+

528+instance Hashable AttributeNames

529+

530+instance Hashable (S.Set AttributeName) where

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

532+

533+type AttributeNames = AttributeNamesBase ()

534+

535+type GraphRefAttributeNames = AttributeNamesBase GraphRefTransactionMarker

536+

470-- | The persistence strategy is a global database option which represents how to persist the database in the filesystem, if at all.

537-- | The persistence strategy is a global database option which represents how to persist the database in the filesystem, if at all.

471data PersistenceStrategy = NoPersistence | -- ^ no filesystem persistence/memory-only database

538data PersistenceStrategy = NoPersistence | -- ^ no filesystem persistence/memory-only database

472 MinimalPersistence FilePath | -- ^ fsync off, not crash-safe

539 MinimalPersistence FilePath | -- ^ fsync off, not crash-safe

@@ -474,19 +541,31 @@ data PersistenceStrategy = NoPersistence | -- ^ no filesystem persistence/memory

474 deriving (Show, Read)

541 deriving (Show, Read)

475

542

476type AttributeExpr = AttributeExprBase ()

543type AttributeExpr = AttributeExprBase ()

544+type GraphRefAttributeExpr = AttributeExprBase GraphRefTransactionMarker

477

545

478-- | Create attributes dynamically.

546-- | Create attributes dynamically.

479data AttributeExprBase a = AttributeAndTypeNameExpr AttributeName TypeConstructor a |

547data AttributeExprBase a = AttributeAndTypeNameExpr AttributeName TypeConstructor a |

480 NakedAttributeExpr Attribute

548 NakedAttributeExpr Attribute

481− deriving (Eq, Show, Generic, Binary, NFData)

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

482

550

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

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

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

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

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

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

486−

554+

487−instance Binary TupleExpr

555+instance Hashable TupleExpr

488−

556+

489−type TupleExpr = TupleExprBase ()

557+type TupleExpr = TupleExprBase ()

558+

559+type GraphRefTupleExpr = TupleExprBase GraphRefTransactionMarker

560+

561+data TupleExprsBase a = TupleExprs a [TupleExprBase a]

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

563+

564+instance Hashable TupleExprs

565+

566+type GraphRefTupleExprs = TupleExprsBase GraphRefTransactionMarker

567+

568+type TupleExprs = TupleExprsBase ()

490

569

491data MergeStrategy =

570data MergeStrategy =

492 -- | After a union merge, the merge transaction is a result of union'ing relvars of the same name, introducing all uniquely-named relvars, union of constraints, union of atom functions, notifications, and types (unless the names and definitions collide, e.g. two types of the same name with different definitions)

571 -- | After a union merge, the merge transaction is a result of union'ing relvars of the same name, introducing all uniquely-named relvars, union of constraints, union of atom functions, notifications, and types (unless the names and definitions collide, e.g. two types of the same name with different definitions)

@@ -495,7 +574,7 @@ data MergeStrategy =

495 UnionPreferMergeStrategy HeadName |

574 UnionPreferMergeStrategy HeadName |

496 -- | Similar to the our/theirs merge strategy in git, the merge transaction's context is identical to that of the last transaction in the selected branch.

575 -- | Similar to the our/theirs merge strategy in git, the merge transaction's context is identical to that of the last transaction in the selected branch.

497 SelectedBranchMergeStrategy HeadName

576 SelectedBranchMergeStrategy HeadName

498− deriving (Eq, Show, Binary, Generic, NFData)

577+ deriving (Eq, Show, Generic, NFData)

499

578

500type DatabaseContextFunctionName = StringType

579type DatabaseContextFunctionName = StringType

501

580

@@ -521,3 +600,47 @@ instance Hashable DatabaseContextFunction where

521

600

522instance Eq DatabaseContextFunction where

601instance Eq DatabaseContextFunction where

523 f1 == f2 = dbcFuncName f1 == dbcFuncName f2

602 f1 == f2 = dbcFuncName f1 == dbcFuncName f2

603+

604+attrTypeVars :: Attribute -> S.Set TypeVarName

605+attrTypeVars (Attribute _ aType) = case aType of

606+ IntAtomType -> S.empty

607+ IntegerAtomType -> S.empty

608+ DoubleAtomType -> S.empty

609+ TextAtomType -> S.empty

610+ DayAtomType -> S.empty

611+ DateTimeAtomType -> S.empty

612+ ByteStringAtomType -> S.empty

613+ BoolAtomType -> S.empty

614+ RelationalExprAtomType -> S.empty

615+ (RelationAtomType attrs) -> S.unions (map attrTypeVars (V.toList (attributesVec attrs)))

616+ (ConstructedAtomType _ tvMap) -> M.keysSet tvMap

617+ (TypeVariableType nam) -> S.singleton nam

618+

619+typeVars :: TypeConstructor -> S.Set TypeVarName

620+typeVars (PrimitiveTypeConstructor _ _) = S.empty

621+typeVars (ADTypeConstructor _ args) = S.unions (map typeVars args)

622+typeVars (TypeVariable v) = S.singleton v

623+typeVars (RelationAtomTypeConstructor attrExprs) = S.unions (map attrExprTypeVars attrExprs)

624+

625+attrExprTypeVars :: AttributeExprBase a -> S.Set TypeVarName

626+attrExprTypeVars (AttributeAndTypeNameExpr _ tCons _) = typeVars tCons

627+attrExprTypeVars (NakedAttributeExpr attr) = attrTypeVars attr

628+

629+atomTypeVars :: AtomType -> S.Set TypeVarName

630+atomTypeVars IntAtomType = S.empty

631+atomTypeVars IntegerAtomType = S.empty

632+atomTypeVars DoubleAtomType = S.empty

633+atomTypeVars TextAtomType = S.empty

634+atomTypeVars DayAtomType = S.empty

635+atomTypeVars DateTimeAtomType = S.empty

636+atomTypeVars ByteStringAtomType = S.empty

637+atomTypeVars BoolAtomType = S.empty

638+atomTypeVars RelationalExprAtomType = S.empty

639+atomTypeVars (RelationAtomType attrs) = S.unions (map attrTypeVars (V.toList (attributesVec attrs)))

640+atomTypeVars (ConstructedAtomType _ tvMap) = M.keysSet tvMap

641+atomTypeVars (TypeVariableType nam) = S.singleton nam

642+

643+unimplemented :: HasCallStack => a

644+unimplemented = error "unimplemented"

645+

646+makeBaseFunctor ''RelationalExprBase

src/lib/ProjectM36/Client.hs+384−364

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

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

1+{-# LANGUAGE DeriveGeneric, ScopedTypeVariables, MonoLocalBinds, DerivingVia #-}

2{-|

3Module: ProjectM36.Client

@@ -9,6 +9,7 @@ module ProjectM36.Client

9 Connection(..),

10 Port,

11 Hostname,

12+ ServiceName,

12 DatabaseName,

13 DatabaseName,

13 ConnectionError(..),

14 ConnectionError(..),

14 connectProjectM36,

15 connectProjectM36,

@@ -16,7 +17,8 @@ module ProjectM36.Client

16 closeRemote_,

17 closeRemote_,

17 executeRelationalExpr,

18 executeRelationalExpr,

18 executeDatabaseContextExpr,

19 executeDatabaseContextExpr,

19− executeDatabaseContextIOExpr,

20+ executeDatabaseContextIOExpr,

21+ executeDataFrameExpr,

20 executeGraphExpr,

22 executeGraphExpr,

21 executeSchemaExpr,

23 executeSchemaExpr,

22 executeTransGraphRelationalExpr,

24 executeTransGraphRelationalExpr,

@@ -25,6 +27,7 @@ module ProjectM36.Client

25 typeForRelationalExpr,

27 typeForRelationalExpr,

26 inclusionDependencies,

28 inclusionDependencies,

27 ProjectM36.Client.typeConstructorMapping,

29 ProjectM36.Client.typeConstructorMapping,

30+ ProjectM36.Client.databaseContextFunctionsAsRelation,

28 planForDatabaseContextExpr,

31 planForDatabaseContextExpr,

29 currentSchemaName,

32 currentSchemaName,

30 SchemaName,

33 SchemaName,

@@ -32,6 +35,7 @@ module ProjectM36.Client

32 setCurrentSchemaName,

35 setCurrentSchemaName,

33 transactionGraphAsRelation,

36 transactionGraphAsRelation,

34 relationVariablesAsRelation,

37 relationVariablesAsRelation,

38+ ProjectM36.Client.atomFunctionsAsRelation,

35 disconnectedTransactionIsDirty,

39 disconnectedTransactionIsDirty,

36 headName,

40 headName,

37 remoteDBLookupName,

41 remoteDBLookupName,

@@ -40,19 +44,20 @@ module ProjectM36.Client

40 defaultDatabaseName,

44 defaultDatabaseName,

41 defaultRemoteConnectionInfo,

45 defaultRemoteConnectionInfo,

42 defaultHeadName,

46 defaultHeadName,

47+ addClientNode,

43 PersistenceStrategy(..),

48 PersistenceStrategy(..),

44 RelationalExpr,

49 RelationalExpr,

45 RelationalExprBase(..),

50 RelationalExprBase(..),

51+ DatabaseContextExprBase(..),

46− DatabaseContextExpr(..),

52+ DatabaseContextExpr,

53+ DatabaseContextIOExprBase(..),

47− DatabaseContextIOExpr(..),

54+ DatabaseContextIOExpr,

48 Attribute(..),

55 Attribute(..),

49 MergeStrategy(..),

56 MergeStrategy(..),

50 attributesFromList,

57 attributesFromList,

51− createNodeId,

52 createSessionAtCommit,

58 createSessionAtCommit,

53 createSessionAtHead,

59 createSessionAtHead,

54 closeSession,

60 closeSession,

55− addClientNode,

56 callTestTimeout_,

61 callTestTimeout_,

57 RelationCardinality(..),

62 RelationCardinality(..),

58 TransactionGraphOperator(..),

63 TransactionGraphOperator(..),

@@ -62,7 +67,6 @@ module ProjectM36.Client

62 TransGraphRelationalExpr,

67 TransGraphRelationalExpr,

63 TransactionIdLookup(..),

68 TransactionIdLookup(..),

64 TransactionIdHeadBacktrack(..),

69 TransactionIdHeadBacktrack(..),

65− NodeId(..),

66 Atom(..),

70 Atom(..),

67 Session,

71 Session,

68 SessionId,

72 SessionId,

@@ -75,86 +79,95 @@ module ProjectM36.Client

75 databaseContextExprForUniqueKey,

79 databaseContextExprForUniqueKey,

76 databaseContextExprForForeignKey,

80 databaseContextExprForForeignKey,

77 createScriptedAtomFunction,

81 createScriptedAtomFunction,

82+ ProjectM36.Client.validateMerkleHashes,

78 AttributeExprBase(..),

83 AttributeExprBase(..),

79− TypeConstructor(..),

84+ TypeConstructorBase(..),

80 TypeConstructorDef(..),

85 TypeConstructorDef(..),

81 DataConstructorDef(..),

86 DataConstructorDef(..),

82− AttributeNames(..),

87+ AttributeNamesBase(..),

83 RelVarName,

88 RelVarName,

84 IncDepName,

89 IncDepName,

85 InclusionDependency(..),

90 InclusionDependency(..),

86 AttributeName,

91 AttributeName,

92+ DF.DataFrame,

93+ DF.DataFrameExpr,

94+ DF.AttributeOrderExpr,

95+ DF.Order(..),

87 RelationalError(..),

96 RelationalError(..),

88 RequestTimeoutException(..),

97 RequestTimeoutException(..),

89 RemoteProcessDiedException(..),

98 RemoteProcessDiedException(..),

90 AtomType(..),

99 AtomType(..),

91 Atomable(..),

100 Atomable(..),

92 TupleExprBase(..),

101 TupleExprBase(..),

102+ TupleExprsBase(..),

93 AtomExprBase(..),

103 AtomExprBase(..),

94 RestrictionPredicateExprBase(..),

104 RestrictionPredicateExprBase(..),

95 withTransaction

105 withTransaction

96 ) where

106 ) where

97import ProjectM36.Base hiding (inclusionDependencies) --defined in this module as well

107import ProjectM36.Base hiding (inclusionDependencies) --defined in this module as well

98import qualified ProjectM36.Base as B

108import qualified ProjectM36.Base as B

109+import ProjectM36.Serialise.Error ()

99import ProjectM36.Error

110import ProjectM36.Error

100import ProjectM36.Atomable

111import ProjectM36.Atomable

101−import ProjectM36.AtomFunction

112+import ProjectM36.AtomFunction as AF

102import ProjectM36.StaticOptimizer

113import ProjectM36.StaticOptimizer

103import ProjectM36.Key

114import ProjectM36.Key

115+import qualified ProjectM36.DataFrame as DF

116+import ProjectM36.DatabaseContextFunction as DCF

104import qualified ProjectM36.IsomorphicSchema as Schema

117import qualified ProjectM36.IsomorphicSchema as Schema

105import Control.Monad.State

118import Control.Monad.State

106−import Control.Monad.Trans.Reader

107import qualified ProjectM36.RelationalExpression as RE

119import qualified ProjectM36.RelationalExpression as RE

108import ProjectM36.DatabaseContext (basicDatabaseContext)

120import ProjectM36.DatabaseContext (basicDatabaseContext)

109import qualified ProjectM36.TransactionGraph as Graph

121import qualified ProjectM36.TransactionGraph as Graph

110−import ProjectM36.TransactionGraph

122+import ProjectM36.TransactionGraph as TG

111import qualified ProjectM36.Transaction as Trans

123import qualified ProjectM36.Transaction as Trans

112import ProjectM36.TransactionGraph.Persist

124import ProjectM36.TransactionGraph.Persist

113−import ProjectM36.Attribute hiding (atomTypes)

125+import ProjectM36.Attribute

114−import ProjectM36.TransGraphRelationalExpression (TransGraphRelationalExpr, evalTransGraphRelationalExpr)

126+import ProjectM36.TransGraphRelationalExpression as TGRE (TransGraphRelationalExpr)

115import ProjectM36.Persist (DiskSync(..))

127import ProjectM36.Persist (DiskSync(..))

116import ProjectM36.FileLock

128import ProjectM36.FileLock

129+import ProjectM36.NormalizeExpr

117import ProjectM36.Notifications

130import ProjectM36.Notifications

118import ProjectM36.Server.RemoteCallTypes

131import ProjectM36.Server.RemoteCallTypes

119import qualified ProjectM36.DisconnectedTransaction as Discon

132import qualified ProjectM36.DisconnectedTransaction as Discon

120import ProjectM36.Relation (typesAsRelation)

133import ProjectM36.Relation (typesAsRelation)

121import ProjectM36.ScriptSession (initScriptSession, ScriptSession)

134import ProjectM36.ScriptSession (initScriptSession, ScriptSession)

122import qualified ProjectM36.Relation as R

135import qualified ProjectM36.Relation as R

123−import qualified ProjectM36.DatabaseContext as DBC

124import Control.Exception.Base

136import Control.Exception.Base

125−import GHC.Conc.Sync

137+import Control.Concurrent.STM

138+import Control.Concurrent.Async

126

139

127−import Network.Transport (Transport(closeTransport))

128−import Network.Transport.TCP (createTransport, defaultTCPParameters, encodeEndPointAddress)

129−import Control.Distributed.Process.Node (newLocalNode, initRemoteTable, runProcess, LocalNode, forkProcess, closeLocalNode)

130−import Control.Distributed.Process.Extras.Internal.Types (whereisRemote)

131−import Control.Distributed.Process.ManagedProcess.Client (call, safeCall)

132import Data.Either (isRight)

140import Data.Either (isRight)

133import Data.UUID.V4 (nextRandom)

141import Data.UUID.V4 (nextRandom)

134import Data.Word

142import Data.Word

135−import Control.Distributed.Process (ProcessId, Process, receiveWait, send, match, NodeId(..), reconnect)

143+import Data.Hashable

136import Control.Exception (IOException, handle, AsyncException, throwIO, fromException, Exception)

144import Control.Exception (IOException, handle, AsyncException, throwIO, fromException, Exception)

137import Control.Concurrent.MVar

145import Control.Concurrent.MVar

146+import Codec.Winery hiding (Schema, schema)

138import qualified Data.Map as M

147import qualified Data.Map as M

139−import Control.Distributed.Process.Serializable (Serializable)

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

149+import qualified StmContainers.Map as StmMap

150+import qualified StmContainers.Set as StmSet

151+#else

140−import qualified STMContainers.Map as STMMap

152+import qualified STMContainers.Map as StmMap

141−import qualified STMContainers.Set as STMSet

153+import qualified STMContainers.Set as StmSet

154+#endif

142import qualified ProjectM36.Session as Sess

155import qualified ProjectM36.Session as Sess

143import ProjectM36.Session

156import ProjectM36.Session

144import ProjectM36.Sessions

157import ProjectM36.Sessions

145−import ListT

146−import Data.Binary (Binary)

147import GHC.Generics (Generic)

158import GHC.Generics (Generic)

148import Control.DeepSeq (force)

159import Control.DeepSeq (force)

149import System.IO

160import System.IO

150import Data.Time.Clock

161import Data.Time.Clock

162+import qualified Network.RPC.Curryer.Client as RPC

163+import qualified Network.RPC.Curryer.Server as RPC

164+import Network.Socket (Socket, AddrInfo(..), getAddrInfo, defaultHints, AddrInfoFlag(..), SocketType(..), ServiceName, hostAddressToTuple, SockAddr(..))

165+import GHC.Conc (unsafeIOToSTM)

151

166

152type Hostname = String

167type Hostname = String

153

168

154type Port = Word16

169type Port = Word16

155

170

156−type DatabaseName = String

157−

158-- | The type for notifications callbacks in the client. When a registered notification fires due to a changed relational expression evaluation, the server propagates the notifications to the clients in the form of the callback.

171-- | The type for notifications callbacks in the client. When a registered notification fires due to a changed relational expression evaluation, the server propagates the notifications to the clients in the form of the callback.

159type NotificationCallback = NotificationName -> EvaluatedNotification -> IO ()

172type NotificationCallback = NotificationName -> EvaluatedNotification -> IO ()

160

173

@@ -174,15 +187,16 @@ data RequestTimeoutException = RequestTimeoutException

174

187

175instance Exception RequestTimeoutException

188instance Exception RequestTimeoutException

176

189

177−-- | Construct a 'ConnectionInfo' to describe how to make the 'Connection'. The database can be run within the current process or running remotely via distributed-process.

190+-- | Construct a 'ConnectionInfo' to describe how to make the 'Connection'. The database can be run within the current process or running remotely via RPC.

178−data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy NotificationCallback [GhcPkgPath]|

191+data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy NotificationCallback [GhcPkgPath] |

179− RemoteProcessConnectionInfo DatabaseName NodeId NotificationCallback

192+ RemoteConnectionInfo DatabaseName Hostname ServiceName NotificationCallback

180

193

181type EvaluatedNotifications = M.Map NotificationName EvaluatedNotification

194type EvaluatedNotifications = M.Map NotificationName EvaluatedNotification

182

195

183-- | Used for callbacks from the server when monitored changes have been made.

196-- | Used for callbacks from the server when monitored changes have been made.

184newtype NotificationMessage = NotificationMessage EvaluatedNotifications

197newtype NotificationMessage = NotificationMessage EvaluatedNotifications

185− deriving (Binary, Eq, Show, Generic)

198+ deriving (Eq, Show, Generic)

199+ deriving Serialise via WineryVariant NotificationMessage

186

200

187-- | When a notification is fired, the 'reportOldExpr' is evaluated in the commit's pre-change context while the 'reportNewExpr' is evaluated in the post-change context and they are returned along with the original notification.

201-- | When a notification is fired, the 'reportOldExpr' is evaluated in the commit's pre-change context while the 'reportNewExpr' is evaluated in the post-change context and they are returned along with the original notification.

188data EvaluatedNotification = EvaluatedNotification {

202data EvaluatedNotification = EvaluatedNotification {

@@ -190,13 +204,10 @@ data EvaluatedNotification = EvaluatedNotification {

190 reportOldRelation :: Either RelationalError Relation,

204 reportOldRelation :: Either RelationalError Relation,

191 reportNewRelation :: Either RelationalError Relation

205 reportNewRelation :: Either RelationalError Relation

192 }

206 }

193− deriving(Binary, Eq, Show, Generic)

207+ deriving (Eq, Show, Generic)

208+ deriving Serialise via WineryRecord EvaluatedNotification

194

209

195

210

196−-- | Create a 'NodeId' for use in connecting to a remote server using distributed-process.

197−createNodeId :: Hostname -> Port -> NodeId

198−createNodeId host port = NodeId $ encodeEndPointAddress host (show port) 1

199−

200-- | Use this for connecting to remote servers on the default port.

211-- | Use this for connecting to remote servers on the default port.

201defaultServerPort :: Port

212defaultServerPort :: Port

202defaultServerPort = 6543

213defaultServerPort = 6543

@@ -211,127 +222,107 @@ defaultHeadName = "master"

211

222

212-- | Create a connection configuration which connects to the localhost on the default server port and default server database name. The configured notification callback is set to ignore all events.

223-- | Create a connection configuration which connects to the localhost on the default server port and default server database name. The configured notification callback is set to ignore all events.

213defaultRemoteConnectionInfo :: ConnectionInfo

224defaultRemoteConnectionInfo :: ConnectionInfo

225+defaultRemoteConnectionInfo =

214−defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (createNodeId "127.0.0.1" defaultServerPort) emptyNotificationCallback

226+ RemoteConnectionInfo defaultDatabaseName defaultServerHostname (show defaultServerPort) emptyNotificationCallback

215−

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

217−type ClientNodes = STMSet.Set ProcessId

218

227

219−-- internal structure specific to in-process connections

228+defaultServerHostname :: Hostname

220−data InProcessConnectionConf = InProcessConnectionConf {

229+defaultServerHostname = "localhost"

221− ipPersistenceStrategy :: PersistenceStrategy,

222− ipClientNodes :: ClientNodes,

223− ipSessions :: Sessions,

224− ipTransactionGraph :: TVar TransactionGraph,

225− ipScriptSession :: Maybe ScriptSession,

226− ipLocalNode :: LocalNode,

227− ipTransport :: Transport, -- we hold onto this so that we can close it gracefully

228− ipLocks :: Maybe (LockFile, MVar LockFileHash) -- nothing when NoPersistence

229− }

230

231−data RemoteProcessConnectionConf = RemoteProcessConnectionConf {

231+newtype RemoteConnectionConf = RemoteConnectionConf RPC.Connection

232− rLocalNode :: LocalNode,

233− rProcessId :: ProcessId, --remote processId

234− rTransport :: Transport --the TCP socket transport

235− }

236

232

237data Connection = InProcessConnection InProcessConnectionConf |

233data Connection = InProcessConnection InProcessConnectionConf |

238− RemoteProcessConnection RemoteProcessConnectionConf

234+ RemoteConnection RemoteConnectionConf

239

235

240-- | There are several reasons why a connection can fail.

236-- | There are several reasons why a connection can fail.

241data ConnectionError = SetupDatabaseDirectoryError PersistenceError |

237data ConnectionError = SetupDatabaseDirectoryError PersistenceError |

242 IOExceptionError IOException |

238 IOExceptionError IOException |

243 NoSuchDatabaseByNameError DatabaseName |

239 NoSuchDatabaseByNameError DatabaseName |

240+ DatabaseValidationError [MerkleValidationError] |

244 LoginError

241 LoginError

245 deriving (Show, Eq, Generic)

242 deriving (Show, Eq, Generic)

246

243

247remoteDBLookupName :: DatabaseName -> String

244remoteDBLookupName :: DatabaseName -> String

248remoteDBLookupName = (++) "db-"

245remoteDBLookupName = (++) "db-"

249

246

250−createLocalNode :: IO (LocalNode, Transport)

251−createLocalNode = do

252− eLocalTransport <- createTransport "127.0.0.1" "0" defaultTCPParameters

253− case eLocalTransport of

254− Left err -> error ("failed to create transport: " ++ show err)

255− Right localTransport -> do

256− localNode <- newLocalNode localTransport initRemoteTable

257− pure (localNode, localTransport)

258−

259−notificationListener :: NotificationCallback -> Process ()

260−notificationListener callback = do

261− --pid <- getSelfPid

262− --liftIO $ putStrLn $ "LISTENER THREAD START " ++ show pid

263− _ <- forever $

264− receiveWait [

265− match (\(NotificationMessage eNots) ->

266− --say $ "NOTIFICATION: " ++ show eNots

267− -- when notifications are thrown, they are not adjusted for the current schema which could be problematic, but we don't have access to the current session here

268− liftIO $ mapM_ (uncurry callback) (M.toList eNots)

269− )

270− ]

271− --say "LISTENER THREAD EXIT"

272− pure ()

273−

274−startNotificationListener :: LocalNode -> NotificationCallback -> IO ProcessId

275−startNotificationListener localNode callback = forkProcess localNode (notificationListener callback)

276−

277createScriptSession :: [String] -> IO (Maybe ScriptSession)

247createScriptSession :: [String] -> IO (Maybe ScriptSession)

278createScriptSession ghcPkgPaths = do

248createScriptSession ghcPkgPaths = do

279 eScriptSession <- initScriptSession ghcPkgPaths

249 eScriptSession <- initScriptSession ghcPkgPaths

280 case eScriptSession of

250 case eScriptSession of

281− Left err -> hPutStrLn stderr ("Failed to load scripting engine- scripting disabled: " ++ show err) >> pure Nothing --not a fatal error, but the scripting feature must be disabled

251+ Left err -> hPutStrLn stderr ("Warning: Haskell scripting disabled: " ++ show err) >> pure Nothing --not a fatal error, but the scripting feature must be disabled

282 Right s -> pure (Just s)

252 Right s -> pure (Just s)

283

253

254+

284-- | To create a 'Connection' to a remote or local database, create a 'ConnectionInfo' and call 'connectProjectM36'.

255-- | To create a 'Connection' to a remote or local database, create a 'ConnectionInfo' and call 'connectProjectM36'.

285connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)

256connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)

286--create a new in-memory database/transaction graph

257--create a new in-memory database/transaction graph

287connectProjectM36 (InProcessConnectionInfo strat notificationCallback ghcPkgPaths) = do

258connectProjectM36 (InProcessConnectionInfo strat notificationCallback ghcPkgPaths) = do

288 freshId <- nextRandom

259 freshId <- nextRandom

289− stamp <- getCurrentTime

260+ tstamp <- getCurrentTime

290 let bootstrapContext = basicDatabaseContext

261 let bootstrapContext = basicDatabaseContext

291− freshGraph = bootstrapTransactionGraph stamp freshId bootstrapContext

262+ freshGraph = bootstrapTransactionGraph tstamp freshId bootstrapContext

292 case strat of

263 case strat of

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

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

294 NoPersistence -> do

265 NoPersistence -> do

295 graphTvar <- newTVarIO freshGraph

266 graphTvar <- newTVarIO freshGraph

296− clientNodes <- STMSet.newIO

267+ clientNodes <- StmSet.newIO

297− sessions <- STMMap.newIO

268+ sessions <- StmMap.newIO

298− (localNode, transport) <- createLocalNode

299− notificationPid <- startNotificationListener localNode notificationCallback

300 mScriptSession <- createScriptSession ghcPkgPaths

269 mScriptSession <- createScriptSession ghcPkgPaths

301−

270+ notifAsync <- startNotificationListener clientNodes notificationCallback

302 let conn = InProcessConnection InProcessConnectionConf {

271 let conn = InProcessConnection InProcessConnectionConf {

303 ipPersistenceStrategy = strat,

272 ipPersistenceStrategy = strat,

304 ipClientNodes = clientNodes,

273 ipClientNodes = clientNodes,

305 ipSessions = sessions,

274 ipSessions = sessions,

306 ipTransactionGraph = graphTvar,

275 ipTransactionGraph = graphTvar,

307 ipScriptSession = mScriptSession,

276 ipScriptSession = mScriptSession,

308− ipLocalNode = localNode,

309− ipTransport = transport,

310− ipLocks = Nothing}

277+ ipLocks = Nothing,

311− addClientNode conn notificationPid

278+ ipCallbackAsync = notifAsync

279+ }

312 pure (Right conn)

280 pure (Right conn)

313 MinimalPersistence dbdir -> connectPersistentProjectM36 strat NoDiskSync dbdir freshGraph notificationCallback ghcPkgPaths

281 MinimalPersistence dbdir -> connectPersistentProjectM36 strat NoDiskSync dbdir freshGraph notificationCallback ghcPkgPaths

314 CrashSafePersistence dbdir -> connectPersistentProjectM36 strat FsyncDiskSync dbdir freshGraph notificationCallback ghcPkgPaths

282 CrashSafePersistence dbdir -> connectPersistentProjectM36 strat FsyncDiskSync dbdir freshGraph notificationCallback ghcPkgPaths

315

283

316−connectProjectM36 (RemoteProcessConnectionInfo databaseName serverNodeId notificationCallback) = do

284+connectProjectM36 (RemoteConnectionInfo dbName hostName servicePort notificationCallback) = do

317− connStatus <- newEmptyMVar

285+ --TODO- add notification callback thread

318− (localNode, transport) <- createLocalNode

286+ let resolutionHints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV],

319− let dbName = remoteDBLookupName databaseName

287+ addrSocketType = Stream

320− --putStrLn $ "Connecting to " ++ show serverNodeId ++ " " ++ dbName

288+ }

321− notificationListenerPid <- startNotificationListener localNode notificationCallback

289+ resolved <- getAddrInfo (Just resolutionHints) (Just hostName) (Just servicePort)

322− runProcess localNode $ do

290+ case resolved of

323− --even a failed connection retains an open socket!

291+ [] -> error ("DNS resolution failed for" <> hostName <> ":" <> servicePort)

324− mServerProcessId <- whereisRemote serverNodeId dbName

292+ addrInfo:_ -> do

325− case mServerProcessId of

293+ --supports IPv4 only for now

326− Nothing -> liftIO $ putMVar connStatus $ Left (NoSuchDatabaseByNameError databaseName)

294+ let (SockAddrInet port addr) = addrAddress addrInfo

327− Just serverProcessId -> do

295+ notificationHandlers =

328− loginConfirmation <- safeLogin (Login notificationListenerPid) serverProcessId

296+ [RPC.ClientAsyncRequestHandler $

329− if not loginConfirmation then

297+ \(NotificationMessage notifications') ->

330− liftIO $ putMVar connStatus (Left LoginError)

298+ forM_ (M.toList notifications') (uncurry notificationCallback)

331− else

299+ ]

332− liftIO $ putMVar connStatus (Right $ RemoteProcessConnection RemoteProcessConnectionConf {rLocalNode = localNode, rProcessId = serverProcessId, rTransport = transport})

300+ let connectExcHandler (e :: IOException) = pure $ Left (IOExceptionError e)

333− status <- takeMVar connStatus

301+ eConn <- (Right <$> RPC.connect notificationHandlers (hostAddressToTuple addr) port) `catch` connectExcHandler

334− pure status

302+ case eConn of

303+ Left err -> pure (Left err)

304+ Right conn -> do

305+ eRet <- RPC.call conn (Login dbName)

306+ case eRet of

307+ Left err -> error (show err)

308+ Right False -> error "wtf"

309+ Right True ->

310+ --TODO handle connection errors!

311+ pure (Right (RemoteConnection (RemoteConnectionConf conn)))

312+

313+--convert RPC errors into exceptions

314+convertRPCErrors :: RPC.ConnectionError -> IO a

315+convertRPCErrors err =

316+ case err of

317+ RPC.TimeoutError -> throw RequestTimeoutException

318+ RPC.CodecError msg -> error $ "decoding message failed on server: " <> msg

319+ RPC.ExceptionError msg -> error $ "server threw exception: " <> msg

320+

321+addClientNode :: Connection -> RPC.Locking Socket -> IO ()

322+addClientNode (RemoteConnection _) _ = error "addClientNode called on remote connection"

323+addClientNode (InProcessConnection conf) lockSock = atomically (StmSet.insert clientInfo (ipClientNodes conf))

324+ where

325+ clientInfo = RemoteClientInfo lockSock

335

326

336connectPersistentProjectM36 :: PersistenceStrategy ->

327connectPersistentProjectM36 :: PersistenceStrategy ->

337 DiskSync ->

328 DiskSync ->

@@ -350,49 +341,57 @@ connectPersistentProjectM36 strat sync dbdir freshGraph notificationCallback ghc

350 case graph of

341 case graph of

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

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

352 Right graph' -> do

343 Right graph' -> do

344+ case TG.validateMerkleHashes graph' of

345+ Left merkleErrs -> pure (Left (DatabaseValidationError merkleErrs))

346+ Right _ -> do

353− tvarGraph <- newTVarIO graph'

347+ tvarGraph <- newTVarIO graph'

354− sessions <- STMMap.newIO

348+ sessions <- StmMap.newIO

355− clientNodes <- STMSet.newIO

349+ clientNodes <- StmSet.newIO

356− (localNode, transport) <- createLocalNode

357− lockMVar <- newMVar digest

350+ lockMVar <- newMVar digest

351+ notifAsync <- startNotificationListener clientNodes notificationCallback

358− let conn = InProcessConnection InProcessConnectionConf {

352+ let conn = InProcessConnection InProcessConnectionConf {

359 ipPersistenceStrategy = strat,

353 ipPersistenceStrategy = strat,

360 ipClientNodes = clientNodes,

354 ipClientNodes = clientNodes,

361 ipSessions = sessions,

355 ipSessions = sessions,

362 ipTransactionGraph = tvarGraph,

356 ipTransactionGraph = tvarGraph,

363 ipScriptSession = mScriptSession,

357 ipScriptSession = mScriptSession,

364− ipLocalNode = localNode,

365− ipTransport = transport,

366− ipLocks = Just (lockFileH, lockMVar)

358+ ipLocks = Just (lockFileH, lockMVar),

359+ ipCallbackAsync = notifAsync

367 }

360 }

361+ pure (Right conn)

362+

363+--startup local async process to handle notification callbacks

364+startNotificationListener :: ClientNodes -> NotificationCallback -> IO (Async ())

365+startNotificationListener cNodes notificationCallback = do

366+ inProcessClientInfo@(InProcessClientInfo notifMVar) <- InProcessClientInfo <$> newEmptyMVar

367+ atomically $ StmSet.insert inProcessClientInfo cNodes

368+ async $ forever $ do

369+ notifs <- takeMVar notifMVar

370+ forM_ (M.toList notifs) $ uncurry notificationCallback

368

371

369− notificationPid <- startNotificationListener localNode notificationCallback

370− addClientNode conn notificationPid

371− pure (Right conn)

372−

373-- | Create a new session at the transaction id and return the session's Id.

372-- | Create a new session at the transaction id and return the session's Id.

374createSessionAtCommit :: Connection -> TransactionId -> IO (Either RelationalError SessionId)

373createSessionAtCommit :: Connection -> TransactionId -> IO (Either RelationalError SessionId)

375createSessionAtCommit conn@(InProcessConnection _) commitId = do

374createSessionAtCommit conn@(InProcessConnection _) commitId = do

376 newSessionId <- nextRandom

375 newSessionId <- nextRandom

377 atomically $ createSessionAtCommit_ commitId newSessionId conn

376 atomically $ createSessionAtCommit_ commitId newSessionId conn

378−createSessionAtCommit conn@(RemoteProcessConnection _) uuid = remoteCall conn (CreateSessionAtCommit uuid)

377+createSessionAtCommit conn@(RemoteConnection _) uuid = remoteCall conn (CreateSessionAtCommit uuid)

379

378

380createSessionAtCommit_ :: TransactionId -> SessionId -> Connection -> STM (Either RelationalError SessionId)

379createSessionAtCommit_ :: TransactionId -> SessionId -> Connection -> STM (Either RelationalError SessionId)

381createSessionAtCommit_ commitId newSessionId (InProcessConnection conf) = do

380createSessionAtCommit_ commitId newSessionId (InProcessConnection conf) = do

382 let sessions = ipSessions conf

381 let sessions = ipSessions conf

383 graphTvar = ipTransactionGraph conf

382 graphTvar = ipTransactionGraph conf

384 graph <- readTVar graphTvar

383 graph <- readTVar graphTvar

385− case transactionForId commitId graph of

384+ case RE.transactionForId commitId graph of

386 Left err -> pure (Left err)

385 Left err -> pure (Left err)

387 Right transaction -> do

386 Right transaction -> do

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

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

389− keyDuplication <- STMMap.lookup newSessionId sessions

388+ keyDuplication <- StmMap.lookup newSessionId sessions

390 case keyDuplication of

389 case keyDuplication of

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

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

392 Nothing -> do

391 Nothing -> do

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

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

394 pure $ Right newSessionId

393 pure $ Right newSessionId

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

394+createSessionAtCommit_ _ _ (RemoteConnection _) = error "createSessionAtCommit_ called on remote connection"

396

395

397-- | Call 'createSessionAtHead' with a transaction graph's head's name to create a new session pinned to that head. This function returns a 'SessionId' which can be used in other function calls to reference the point in the transaction graph.

396-- | Call 'createSessionAtHead' with a transaction graph's head's name to create a new session pinned to that head. This function returns a 'SessionId' which can be used in other function calls to reference the point in the transaction graph.

398createSessionAtHead :: Connection -> HeadName -> IO (Either RelationalError SessionId)

397createSessionAtHead :: Connection -> HeadName -> IO (Either RelationalError SessionId)

@@ -404,42 +403,38 @@ createSessionAtHead conn@(InProcessConnection conf) headn = do

404 case transactionForHead headn graph of

403 case transactionForHead headn graph of

405 Nothing -> pure $ Left (NoSuchHeadNameError headn)

404 Nothing -> pure $ Left (NoSuchHeadNameError headn)

406 Just trans -> createSessionAtCommit_ (transactionId trans) newSessionId conn

405 Just trans -> createSessionAtCommit_ (transactionId trans) newSessionId conn

407−createSessionAtHead conn@(RemoteProcessConnection _) headn = remoteCall conn (CreateSessionAtHead headn)

406+createSessionAtHead conn@(RemoteConnection _) headn = remoteCall conn (CreateSessionAtHead headn)

408−

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

410−addClientNode :: Connection -> ProcessId -> IO ()

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

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

413

407

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

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

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

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

416closeSession sessionId (InProcessConnection conf) =

410closeSession sessionId (InProcessConnection conf) =

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

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

418−closeSession sessionId conn@(RemoteProcessConnection _) = remoteCall conn (CloseSession sessionId)

412+closeSession sessionId conn@(RemoteConnection _) = remoteCall conn (CloseSession sessionId)

419

413

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

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

421close :: Connection -> IO ()

415close :: Connection -> IO ()

422close (InProcessConnection conf) = do

416close (InProcessConnection conf) = do

417+ cancel (ipCallbackAsync conf)

423 atomically $ do

418 atomically $ do

424 let sessions = ipSessions conf

419 let sessions = ipSessions conf

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

421+ StmMap.reset sessions

422+#else

425− STMMap.deleteAll sessions

423+ StmMap.deleteAll sessions

424+#endif

426 pure ()

425 pure ()

427− closeLocalNode (ipLocalNode conf)

428− closeTransport (ipTransport conf)

429 let mLocks = ipLocks conf

426 let mLocks = ipLocks conf

430 case mLocks of

427 case mLocks of

431 Nothing -> pure ()

428 Nothing -> pure ()

432 Just (lockFileH, _) -> closeLockFile lockFileH

429 Just (lockFileH, _) -> closeLockFile lockFileH

433

430

434−close conn@(RemoteProcessConnection conf) = do

431+close (RemoteConnection (RemoteConnectionConf conn)) =

435− _ <- remoteCall conn Logout :: IO Bool

432+ RPC.close conn

436− closeLocalNode (rLocalNode conf)

437− closeTransport (rTransport conf)

438

433

439--used only by the server EntryPoints

434--used only by the server EntryPoints

440closeRemote_ :: Connection -> IO ()

435closeRemote_ :: Connection -> IO ()

441closeRemote_ (InProcessConnection _) = error "invalid call of closeRemote_ on InProcessConnection"

436closeRemote_ (InProcessConnection _) = error "invalid call of closeRemote_ on InProcessConnection"

442−closeRemote_ (RemoteProcessConnection conf) = runProcess (rLocalNode conf) (reconnect (rProcessId conf))

437+closeRemote_ (RemoteConnection (RemoteConnectionConf conn)) = RPC.close conn

443

438

444 --we need to actually close the localNode's connection to the remote

439 --we need to actually close the localNode's connection to the remote

445--within the database server, we must catch and handle all exception lest they take down the database process- this handling might be different for other use-cases

440--within the database server, we must catch and handle all exception lest they take down the database process- this handling might be different for other use-cases

@@ -450,40 +445,19 @@ excEither = handle handler

450 where

445 where

451 handler exc | Just (_ :: AsyncException) <- fromException exc = throwIO exc

446 handler exc | Just (_ :: AsyncException) <- fromException exc = throwIO exc

452 | otherwise = pure (Left (UnhandledExceptionError (show exc)))

447 | otherwise = pure (Left (UnhandledExceptionError (show exc)))

453−

454−runProcessResult :: LocalNode -> Process a -> IO a

455−runProcessResult localNode proc = do

456− ret <- newEmptyMVar

457− runProcess localNode $ do

458− val <- proc

459− liftIO $ putMVar ret val

460− takeMVar ret

461−

462−safeLogin :: Login -> ProcessId -> Process Bool

463−safeLogin login procId = do

464− ret <- call procId login

465− case ret of

466− Left (_ :: ServerError) -> pure False

467− Right val -> pure val

468

448

449+

469−remoteCall :: (Serializable a, Serializable b) => Connection -> a -> IO b

450+remoteCall :: (Serialise a, Serialise b) => Connection -> a -> IO b

470remoteCall (InProcessConnection _ ) _ = error "remoteCall called on local connection"

451remoteCall (InProcessConnection _ ) _ = error "remoteCall called on local connection"

471−remoteCall (RemoteProcessConnection conf) arg = runProcessResult localNode $ do

452+remoteCall (RemoteConnection (RemoteConnectionConf rpcConn)) arg = do

472− ret <- safeCall serverProcessId arg

453+ eRet <- RPC.call rpcConn arg

473− case ret of

454+ case eRet of

474− Left err -> error ("server died: " ++ show err)

455+ Left err -> convertRPCErrors err

475− Right ret' -> case ret' of

476− Left RequestTimeoutError -> liftIO (throwIO RequestTimeoutException)

477− Left (ProcessDiedError _) -> liftIO (throwIO RemoteProcessDiedException)

478− Right val -> pure val

456+ Right val -> pure val

479− where

480− localNode = rLocalNode conf

481− serverProcessId = rProcessId conf

482

457

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

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

484−sessionForSessionId sessionId sessions = do

459+sessionForSessionId sessionId sessions =

485− maybeSession <- STMMap.lookup sessionId sessions

486− pure $ maybe (Left $ NoSuchSessionError sessionId) Right maybeSession

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

487

461

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

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

489schemaForSessionId session = do

463schemaForSessionId session = do

@@ -514,7 +488,7 @@ currentSchemaName sessionId (InProcessConnection conf) = atomically $ do

514 case eSession of

488 case eSession of

515 Left err -> pure (Left err)

489 Left err -> pure (Left err)

516 Right session -> pure (Right (Sess.schemaName session))

490 Right session -> pure (Right (Sess.schemaName session))

517−currentSchemaName sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveCurrentSchemaName sessionId)

491+currentSchemaName sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveCurrentSchemaName sessionId)

518

492

519-- | Switch to the named isomorphic schema.

493-- | Switch to the named isomorphic schema.

520setCurrentSchemaName :: SessionId -> Connection -> SchemaName -> IO (Either RelationalError ())

494setCurrentSchemaName :: SessionId -> Connection -> SchemaName -> IO (Either RelationalError ())

@@ -525,8 +499,8 @@ setCurrentSchemaName sessionId (InProcessConnection conf) sname = atomically $ d

525 Left err -> pure (Left err)

499 Left err -> pure (Left err)

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

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

527 Left err -> pure (Left err)

501 Left err -> pure (Left err)

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

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

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

503+setCurrentSchemaName sessionId conn@(RemoteConnection _) sname = remoteCall conn (ExecuteSetCurrentSchema sessionId sname)

530

504

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

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

532executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

506executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

@@ -542,10 +516,15 @@ executeRelationalExpr sessionId (InProcessConnection conf) expr = excEither $ at

542 Right expr

516 Right expr

543 case expr' of

517 case expr' of

544 Left err -> pure (Left err)

518 Left err -> pure (Left err)

519+ Right expr'' -> do

520+ let graphTvar = ipTransactionGraph conf

521+ graph <- readTVar graphTvar

545− Right expr'' -> case runReader (RE.evalRelationalExpr expr'') (RE.mkRelationalExprState (Sess.concreteDatabaseContext session)) of

522+ let reEnv = RE.mkRelationalExprEnv (Sess.concreteDatabaseContext session) graph

546− Left err -> pure (Left err)

523+ case optimizeAndEvalRelationalExpr reEnv expr'' of

547− Right rel -> pure (force (Right rel)) -- this is necessary so that any undefined/error exceptions are spit out here

524+ Right rel -> pure (force (Right rel)) -- this is necessary so that any undefined/error exceptions are spit out here

525+ Left err -> pure (Left err)

526+

548−executeRelationalExpr sessionId conn@(RemoteProcessConnection _) relExpr = remoteCall conn (ExecuteRelationalExpr sessionId relExpr)

527+executeRelationalExpr sessionId conn@(RemoteConnection _) relExpr = remoteCall conn (ExecuteRelationalExpr sessionId relExpr)

549

528

550-- | Execute a database context expression in the context of the session and connection. Database expressions modify the current session's disconnected transaction but cannot modify the transaction graph.

529-- | Execute a database context expression in the context of the session and connection. Database expressions modify the current session's disconnected transaction but cannot modify the transaction graph.

551executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ())

530executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ())

@@ -561,36 +540,54 @@ executeDatabaseContextExpr sessionId (InProcessConnection conf) expr = excEither

561 Schema.processDatabaseContextExprInSchema schema expr

540 Schema.processDatabaseContextExprInSchema schema expr

562 case expr' of

541 case expr' of

563 Left err -> pure (Left err)

542 Left err -> pure (Left err)

543+ Right expr'' -> do

544+ graph <- readTVar (ipTransactionGraph conf)

564− Right expr'' -> case runState (RE.evalDatabaseContextExpr expr'') (RE.freshDatabaseState (Sess.concreteDatabaseContext session)) of

545+ let ctx = Sess.concreteDatabaseContext session

546+ env = RE.mkDatabaseContextEvalEnv transId graph

547+ transId = Sess.parentId session

548+ case RE.runDatabaseContextEvalMonad ctx env (optimizeAndEvalDatabaseContextExpr True expr'') of

565− (Just err,_) -> pure (Left err)

549+ Left err -> pure (Left err)

550+ Right newState ->

566− (Nothing, (_,_,False)) -> pure (Right ()) --optimization- if nothing was dirtied, nothing to do

551+ if not (RE.dbc_dirty newState) then --nothing dirtied, nothing to do

567− (Nothing, (!context',_,True)) -> do

552+ pure (Right ())

553+ else do

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

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

555+ context' = RE.dbc_context newState

569− newSubschemas = Schema.processDatabaseContextExprSchemasUpdate (Sess.subschemas session) expr

556+ newSubschemas = Schema.processDatabaseContextExprSchemasUpdate (Sess.subschemas session) expr

570− newSchemas = Schemas context' newSubschemas

557+ newSchemas = Schemas context' newSubschemas

571− newSession = Session newDiscon (Sess.schemaName session)

558+ newSession = Session newDiscon (Sess.schemaName session)

572− STMMap.insert newSession sessionId sessions

559+ StmMap.insert newSession sessionId sessions

573− pure (Right ())

560+ pure (Right ())

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

561+executeDatabaseContextExpr sessionId conn@(RemoteConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)

575−

562+

576−-- | Similar to a git rebase, 'autoMergeToHead' atomically creates a temporary branch and merges it to the latest commit of the branch referred to by the 'HeadName' and commits the merge. This is useful to reduce incidents of 'TransactionIsNotAHeadError's but at the risk of merge errors (thus making it similar to rebasing).

563+-- | Similar to a git rebase, 'autoMergeToHead' atomically creates a temporary branch and merges it to the latest commit of the branch referred to by the 'HeadName' and commits the merge. This is useful to reduce incidents of 'TransactionIsNotAHeadError's but at the risk of merge errors (thus making it similar to rebasing). Alternatively, as an optimization, if a simple commit is possible (meaning that the head has not changed), then a fast-forward commit takes place instead.

577autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())

564autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())

578autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do

565autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do

579 let sessions = ipSessions conf

566 let sessions = ipSessions conf

580 id1 <- nextRandom

567 id1 <- nextRandom

581 id2 <- nextRandom

568 id2 <- nextRandom

582 id3 <- nextRandom

569 id3 <- nextRandom

583− stamp <- getCurrentTime

570+ tstamp <- getCurrentTime

584 commitLock_ sessionId conf $ \graph -> do

571 commitLock_ sessionId conf $ \graph -> do

585 eSession <- sessionForSessionId sessionId sessions

572 eSession <- sessionForSessionId sessionId sessions

586 case eSession of

573 case eSession of

587 Left err -> pure (Left err)

574 Left err -> pure (Left err)

588− Right session ->

575+ Right session ->

576+ case Graph.transactionForHead headName' graph of

577+ Nothing -> pure (Left (NoSuchHeadNameError headName'))

578+ Just headTrans -> do

579+ --attempt fast-forward commit, if possible

580+ let graphInfo = if Sess.parentId session == transactionId headTrans then do

581+ ret <- Graph.evalGraphOp tstamp id1 (Sess.disconnectedTransaction session) graph Commit

582+ pure (ret, [id1])

583+ else do

589− case Graph.autoMergeToHead stamp (id1, id2, id3) (Sess.disconnectedTransaction session) headName' strat graph of

584+ ret <- Graph.autoMergeToHead tstamp (id1, id2, id3) (Sess.disconnectedTransaction session) headName' strat graph

585+ pure (ret, [id1,id2,id3])

586+ case graphInfo of

590− Left err -> pure (Left err)

587+ Left err -> pure (Left err)

591− Right (discon', graph') ->

588+ Right ((discon', graph'), transactionIdsAdded) ->

592− pure (Right (discon', graph', [id1, id2, id3]))

589+ pure (Right (discon', graph', transactionIdsAdded))

593−autoMergeToHead sessionId conn@(RemoteProcessConnection _) strat headName' = remoteCall conn (ExecuteAutoMergeToHead sessionId strat headName')

590+autoMergeToHead sessionId conn@(RemoteConnection _) strat headName' = remoteCall conn (ExecuteAutoMergeToHead sessionId strat headName')

594

591

595-- | Execute a database context IO-monad-based expression for the given session and connection. `DatabaseContextIOExpr`s modify the DatabaseContext but cannot be purely implemented.

592-- | Execute a database context IO-monad-based expression for the given session and connection. `DatabaseContextIOExpr`s modify the DatabaseContext but cannot be purely implemented.

596--this is almost completely identical to executeDatabaseContextExpr above

593--this is almost completely identical to executeDatabaseContextExpr above

@@ -602,38 +599,35 @@ executeDatabaseContextIOExpr sessionId (InProcessConnection conf) expr = excEith

602 case eSession of

599 case eSession of

603 Left err -> pure (Left err)

600 Left err -> pure (Left err)

604 Right session -> do

601 Right session -> do

602+ graph <- readTVarIO (ipTransactionGraph conf)

603+ let env = RE.DatabaseContextIOEvalEnv transId graph scriptSession

604+ transId = Sess.parentId session

605− res <- RE.evalDatabaseContextIOExpr scriptSession (Sess.concreteDatabaseContext session) expr

605+ context = Sess.concreteDatabaseContext session

606+ res <- RE.runDatabaseContextIOEvalMonad env context (optimizeAndEvalDatabaseContextIOExpr expr)

606 case res of

607 case res of

607 Left err -> pure (Left err)

608 Left err -> pure (Left err)

608− Right context' -> do

609+ Right newState -> do

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

610+ let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas False

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

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

611 newSession = Session newDiscon (Sess.schemaName session)

612 newSession = Session newDiscon (Sess.schemaName session)

613+ context' = RE.dbc_context newState

612− atomically $ STMMap.insert newSession sessionId sessions

614+ atomically $ StmMap.insert newSession sessionId sessions

613 pure (Right ())

615 pure (Right ())

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

616+executeDatabaseContextIOExpr sessionId conn@(RemoteConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextIOExpr sessionId dbExpr)

615

617

616−{-

617−executeGraphExprSTM_ :: TransactionId -> SessionId -> Session -> Sessions -> TransactionGraphOperator -> TransactionGraph -> TVar TransactionGraph -> STM (Either RelationalError (TransactionGraph, DisconnectedTransaction)

618−executeGraphExprSTM_ freshId sessionId session sessions graphExpr graph graphTVar= do

619− case evalGraphOp freshId (Sess.disconnectedTransaction session) graph graphExpr of

620− Left err -> do

621− when updateGraphOnError (writeTVar graphTVar graph)

622− pure $ Left err

623− Right (discon', graph') -> do

624− writeTVar graphTVar graph'

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

626− STMMap.insert newSession sessionId sessions

627− pure $ Right graph'

628−-}

629−

630-- process notifications for commits

618-- process notifications for commits

619+executeCommitExprSTM_

620+ :: TransactionGraph

621+ -> DatabaseContext

622+ -> DatabaseContext

623+ -> ClientNodes

631−executeCommitExprSTM_ :: DatabaseContext -> DatabaseContext -> ClientNodes -> STM (EvaluatedNotifications, ClientNodes)

624+ -> STM (EvaluatedNotifications, ClientNodes)

632−executeCommitExprSTM_ oldContext newContext nodes = do

625+executeCommitExprSTM_ graph oldContext newContext nodes = do

633 let nots = notifications oldContext

626 let nots = notifications oldContext

634− fireNots = notificationChanges nots oldContext newContext

627+ fireNots = notificationChanges nots graph oldContext newContext

635 evaldNots = M.map mkEvaldNot fireNots

628 evaldNots = M.map mkEvaldNot fireNots

636− evalInContext expr ctx = runReader (RE.evalRelationalExpr expr) (RE.mkRelationalExprState ctx)

629+ evalInContext expr ctx = optimizeAndEvalRelationalExpr (RE.mkRelationalExprEnv ctx graph) expr

630+

637 mkEvaldNot notif = EvaluatedNotification { notification = notif,

631 mkEvaldNot notif = EvaluatedNotification { notification = notif,

638 reportOldRelation = evalInContext (reportOldExpr notif) oldContext,

632 reportOldRelation = evalInContext (reportOldExpr notif) oldContext,

639 reportNewRelation = evalInContext (reportNewExpr notif) newContext}

633 reportNewRelation = evalInContext (reportNewExpr notif) newContext}

@@ -648,103 +642,29 @@ executeGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> IO (E

648executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do

642executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do

649 let sessions = ipSessions conf

643 let sessions = ipSessions conf

650 freshId <- nextRandom

644 freshId <- nextRandom

651− stamp <- getCurrentTime

645+ tstamp <- getCurrentTime

652 commitLock_ sessionId conf $ \updatedGraph -> do

646 commitLock_ sessionId conf $ \updatedGraph -> do

653 eSession <- sessionForSessionId sessionId sessions

647 eSession <- sessionForSessionId sessionId sessions

654 case eSession of

648 case eSession of

655 Left err -> pure (Left err)

649 Left err -> pure (Left err)

656 Right session -> do

650 Right session -> do

657 let discon = Sess.disconnectedTransaction session

651 let discon = Sess.disconnectedTransaction session

658− case evalGraphOp stamp freshId discon updatedGraph graphExpr of

652+ case evalGraphOp tstamp freshId discon updatedGraph graphExpr of

659 Left err -> pure (Left err)

653 Left err -> pure (Left err)

660 Right (discon', graph') -> do

654 Right (discon', graph') -> do

661 --if freshId appears in the graph, then we need to pass it on

655 --if freshId appears in the graph, then we need to pass it on

662− let transIds = [freshId | isRight (transactionForId freshId graph')]

656+ let transIds = [freshId | isRight (RE.transactionForId freshId graph')]

663 pure (Right (discon', graph', transIds))

657 pure (Right (discon', graph', transIds))

664−{-

658+

665−executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do

666− let strat = ipPersistenceStrategy conf

667− clientNodes = ipClientNodes conf

668− sessions = ipSessions conf

669− graphTvar = ipTransactionGraph conf

670− mLockFileH = ipLocks conf

671− lockHandler body = case graphExpr of

672− Commit -> case mLockFileH of

673− Nothing -> body False

674− Just (lockFileH, lockMVar) -> let acquireLocks = do

675− lastWrittenDigest <- takeMVar lockMVar

676− lockFile lockFileH WriteLock

677− latestDigest <- readGraphTransactionIdDigest strat

678− pure (latestDigest /= lastWrittenDigest)

679−

680− releaseLocks _ = do

681− --still holding the lock- get the latest digest

682− gDigest <- readGraphTransactionIdDigest strat

683− unlockFile lockFileH

684− putMVar lockMVar gDigest

685− in bracket acquireLocks releaseLocks body

686− _ -> body False

687− freshId <- nextRandom

688− lockHandler $ \dbWrittenByOtherProcess -> do

689− --if the database file has been updated since we wrote it last, load it before trying to sync our version done- this can result in TransactionNotAHeadErrors

690− --read transaction data and compare to existing graph

691− --in the future, we can detect if updated transaction graph can be safely merged (such as with a transaction on a separate head) (rebase-able commits should force the user to rebase from the client to confirm that the action makes sense)

692− manip <- atomically $ do

693− eSession <- sessionForSessionId sessionId sessions

694− --handle graph update by other process

695− oldGraph <- readTVar graphTvar

696− case eSession of

697− Left err -> pure (Left err)

698− Right session -> do

699− let mScriptSession = ipScriptSession conf

700− dbdir = case strat of

701− MinimalPersistence x -> x

702− CrashSafePersistence x -> x

703− _ -> error "accessing dbdir on non-persisted connection"

704− eRefreshedGraph <- if dbWrittenByOtherProcess then

705− unsafeIOToSTM (transactionGraphLoad dbdir oldGraph mScriptSession)

706− else

707− pure (Right oldGraph)

708− case eRefreshedGraph of

709− Left err -> pure (Left (DatabaseLoadError err))

710− Right refreshedGraph -> do

711− --snip it

712− eGraph <- executeGraphExprSTM_ dbWrittenByOtherProcess freshId sessionId session sessions graphExpr refreshedGraph graphTvar

713− --snip it

714− case eGraph of

715− Left err -> pure (Left err)

716− Right newGraph -> do

717− --handle commit

718− if isCommit graphExpr then do

719− case transactionForId (Sess.parentId session) oldGraph of

720− Left err -> pure $ Left err

721− Right previousTrans -> do

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

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

724− pure $ Right (evaldNots, nodesToNotify, newGraph)

725− else

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

727− case manip of

728− Left err -> return $ Just err

729− Right (notsToFire, nodesToNotify, newGraph) -> do

730− --update filesystem database, if necessary

731− processTransactionGraphPersistence strat newGraph

732− sendNotifications nodesToNotify (ipLocalNode conf) notsToFire

733− pure Nothing

734−-}

735−executeGraphExpr sessionId conn@(RemoteProcessConnection _) graphExpr = remoteCall conn (ExecuteGraphExpr sessionId graphExpr)

659+executeGraphExpr sessionId conn@(RemoteConnection _) graphExpr = remoteCall conn (ExecuteGraphExpr sessionId graphExpr)

736

660

737-- | A trans-graph expression is a relational query executed against the entirety of a transaction graph.

661-- | A trans-graph expression is a relational query executed against the entirety of a transaction graph.

738executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)

662executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)

739executeTransGraphRelationalExpr _ (InProcessConnection conf) tgraphExpr = excEither . atomically $ do

663executeTransGraphRelationalExpr _ (InProcessConnection conf) tgraphExpr = excEither . atomically $ do

740 let graphTvar = ipTransactionGraph conf

664 let graphTvar = ipTransactionGraph conf

741 graph <- readTVar graphTvar

665 graph <- readTVar graphTvar

742− case evalTransGraphRelationalExpr tgraphExpr graph of

666+ pure $ force $ optimizeAndEvalTransGraphRelationalExpr graph tgraphExpr

743− Left err -> pure (Left err)

744− Right relExpr -> case runReader (RE.evalRelationalExpr relExpr) (RE.mkRelationalExprState DBC.empty) of

745− Left err -> pure (Left err)

746− Right rel -> pure (force (Right rel))

747−executeTransGraphRelationalExpr sessionId conn@(RemoteProcessConnection _) tgraphExpr = remoteCall conn (ExecuteTransGraphRelationalExpr sessionId tgraphExpr)

667+executeTransGraphRelationalExpr sessionId conn@(RemoteConnection _) tgraphExpr = remoteCall conn (ExecuteTransGraphRelationalExpr sessionId tgraphExpr)

748

668

749-- | Schema expressions manipulate the isomorphic schemas for the current 'DatabaseContext'.

669-- | Schema expressions manipulate the isomorphic schemas for the current 'DatabaseContext'.

750executeSchemaExpr :: SessionId -> Connection -> Schema.SchemaExpr -> IO (Either RelationalError ())

670executeSchemaExpr :: SessionId -> Connection -> Schema.SchemaExpr -> IO (Either RelationalError ())

@@ -755,32 +675,36 @@ executeSchemaExpr sessionId (InProcessConnection conf) schemaExpr = atomically $

755 Left err -> pure (Left err)

675 Left err -> pure (Left err)

756 Right (session, _) -> do

676 Right (session, _) -> do

757 let subschemas' = subschemas session

677 let subschemas' = subschemas session

678+ transId = Sess.parentId session

679+ context = Sess.concreteDatabaseContext session

680+ graph <- readTVar (ipTransactionGraph conf)

758− case Schema.evalSchemaExpr schemaExpr (Sess.concreteDatabaseContext session) subschemas' of

681+ case Schema.evalSchemaExpr schemaExpr context transId graph subschemas' of

759 Left err -> pure (Left err)

682 Left err -> pure (Left err)

760 Right (newSubschemas, newContext) -> do

683 Right (newSubschemas, newContext) -> do

761 --hm- maybe we should start using lenses

684 --hm- maybe we should start using lenses

762 let discon = Sess.disconnectedTransaction session

685 let discon = Sess.disconnectedTransaction session

763 newSchemas = Schemas newContext newSubschemas

686 newSchemas = Schemas newContext newSubschemas

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

687+ newSession = Session (DisconnectedTransaction (Discon.parentId discon) newSchemas False) (Sess.schemaName session)

765− STMMap.insert newSession sessionId sessions

688+ StmMap.insert newSession sessionId sessions

766 pure (Right ())

689 pure (Right ())

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

690+executeSchemaExpr sessionId conn@(RemoteConnection _) schemaExpr = remoteCall conn (ExecuteSchemaExpr sessionId schemaExpr)

768

691

769-- | After modifying a 'DatabaseContext', 'commit' the transaction to the transaction graph at the head which the session is referencing. This will also trigger checks for any notifications which need to be propagated.

692-- | After modifying a 'DatabaseContext', 'commit' the transaction to the transaction graph at the head which the session is referencing. This will also trigger checks for any notifications which need to be propagated.

770commit :: SessionId -> Connection -> IO (Either RelationalError ())

693commit :: SessionId -> Connection -> IO (Either RelationalError ())

771commit sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Commit

694commit sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Commit

772−commit sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Commit)

695+commit sessionId conn@(RemoteConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Commit)

773−

696+

774−sendNotifications :: [ProcessId] -> LocalNode -> EvaluatedNotifications -> IO ()

697+sendNotifications :: [ClientInfo] -> EvaluatedNotifications -> IO ()

775−sendNotifications pids localNode nots = mapM_ sendNots pids

698+sendNotifications clients notifs =

776− where

699+ unless (M.null notifs) $ forM_ clients sender

777− sendNots remoteClientPid =

700+ where

778− unless (M.null nots) $ runProcess localNode $ send remoteClientPid (NotificationMessage nots)

701+ sender (RemoteClientInfo sock) = RPC.sendMessage sock (NotificationMessage notifs)

779−

702+ sender (InProcessClientInfo tvar) = putMVar tvar notifs

703+

780-- | Discard any changes made in the current 'Session' and 'DatabaseContext'. This resets the disconnected transaction to reference the original database context of the parent transaction and is a very cheap operation.

704-- | Discard any changes made in the current 'Session' and 'DatabaseContext'. This resets the disconnected transaction to reference the original database context of the parent transaction and is a very cheap operation.

781rollback :: SessionId -> Connection -> IO (Either RelationalError ())

705rollback :: SessionId -> Connection -> IO (Either RelationalError ())

782rollback sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Rollback

706rollback sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Rollback

783−rollback sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Rollback)

707+rollback sessionId conn@(RemoteConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Rollback)

784

708

785-- | Write the transaction graph to disk. This function can be used to incrementally write new transactions to disk.

709-- | Write the transaction graph to disk. This function can be used to incrementally write new transactions to disk.

786processTransactionGraphPersistence :: PersistenceStrategy -> [TransactionId] -> TransactionGraph -> IO ()

710processTransactionGraphPersistence :: PersistenceStrategy -> [TransactionId] -> TransactionGraph -> IO ()

@@ -796,7 +720,7 @@ readGraphTransactionIdDigest (CrashSafePersistence dbdir) = readGraphTransaction

796-- | Return a relation whose type would match that of the relational expression if it were executed. This is useful for checking types and validating a relational expression's types.

720-- | Return a relation whose type would match that of the relational expression if it were executed. This is useful for checking types and validating a relational expression's types.

797typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

721typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

798typeForRelationalExpr sessionId conn@(InProcessConnection _) relExpr = atomically $ typeForRelationalExprSTM sessionId conn relExpr

722typeForRelationalExpr sessionId conn@(InProcessConnection _) relExpr = atomically $ typeForRelationalExprSTM sessionId conn relExpr

799−typeForRelationalExpr sessionId conn@(RemoteProcessConnection _) relExpr = remoteCall conn (ExecuteTypeForRelationalExpr sessionId relExpr)

723+typeForRelationalExpr sessionId conn@(RemoteConnection _) relExpr = remoteCall conn (ExecuteTypeForRelationalExpr sessionId relExpr)

800

724

801typeForRelationalExprSTM :: SessionId -> Connection -> RelationalExpr -> STM (Either RelationalError Relation)

725typeForRelationalExprSTM :: SessionId -> Connection -> RelationalExpr -> STM (Either RelationalError Relation)

802typeForRelationalExprSTM sessionId (InProcessConnection conf) relExpr = do

726typeForRelationalExprSTM sessionId (InProcessConnection conf) relExpr = do

@@ -811,7 +735,10 @@ typeForRelationalExprSTM sessionId (InProcessConnection conf) relExpr = do

811 Schema.processRelationalExprInSchema schema relExpr

735 Schema.processRelationalExprInSchema schema relExpr

812 case processed of

736 case processed of

813 Left err -> pure (Left err)

737 Left err -> pure (Left err)

738+ Right relExpr' -> do

739+ graph <- readTVar (ipTransactionGraph conf)

814− Right relExpr' -> pure $ runReader (RE.typeForRelationalExpr relExpr') (RE.mkRelationalExprState (Sess.concreteDatabaseContext session))

740+ let reEnv = RE.mkRelationalExprEnv (Sess.concreteDatabaseContext session) graph

741+ pure $ RE.runRelationalExprM reEnv (RE.typeForRelationalExpr relExpr')

815

742

816typeForRelationalExprSTM _ _ _ = error "typeForRelationalExprSTM called on non-local connection"

743typeForRelationalExprSTM _ _ _ = error "typeForRelationalExprSTM called on non-local connection"

817

744

@@ -830,7 +757,7 @@ inclusionDependencies sessionId (InProcessConnection conf) = do

830 else

757 else

831 pure (Schema.inclusionDependenciesInSchema schema (B.inclusionDependencies context))

758 pure (Schema.inclusionDependenciesInSchema schema (B.inclusionDependencies context))

832

759

833−inclusionDependencies sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveInclusionDependencies sessionId)

760+inclusionDependencies sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveInclusionDependencies sessionId)

834

761

835typeConstructorMapping :: SessionId -> Connection -> IO (Either RelationalError TypeConstructorMapping)

762typeConstructorMapping :: SessionId -> Connection -> IO (Either RelationalError TypeConstructorMapping)

836typeConstructorMapping sessionId (InProcessConnection conf) = do

763typeConstructorMapping sessionId (InProcessConnection conf) = do

@@ -841,22 +768,27 @@ typeConstructorMapping sessionId (InProcessConnection conf) = do

841 Left err -> pure $ Left err

768 Left err -> pure $ Left err

842 Right (session, _) -> --warning, no schema support for typeconstructors

769 Right (session, _) -> --warning, no schema support for typeconstructors

843 pure (Right (B.typeConstructorMapping (Sess.concreteDatabaseContext session)))

770 pure (Right (B.typeConstructorMapping (Sess.concreteDatabaseContext session)))

844−typeConstructorMapping sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveTypeConstructorMapping sessionId)

771+typeConstructorMapping sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveTypeConstructorMapping sessionId)

845−

772+

846-- | Return an optimized database expression which is logically equivalent to the input database expression. This function can be used to determine which expression will actually be evaluated.

773-- | Return an optimized database expression which is logically equivalent to the input database expression. This function can be used to determine which expression will actually be evaluated.

847−planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError DatabaseContextExpr)

774+planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr)

848planForDatabaseContextExpr sessionId (InProcessConnection conf) dbExpr = do

775planForDatabaseContextExpr sessionId (InProcessConnection conf) dbExpr = do

849 let sessions = ipSessions conf

776 let sessions = ipSessions conf

850 atomically $ do

777 atomically $ do

778+ graph <- readTVar (ipTransactionGraph conf)

851 eSession <- sessionAndSchema sessionId sessions

779 eSession <- sessionAndSchema sessionId sessions

852 case eSession of

780 case eSession of

853 Left err -> pure $ Left err

781 Left err -> pure $ Left err

782+ Right (session, _) ->

854− Right (session, _) -> if schemaName session == defaultSchemaName then

783+ if schemaName session == defaultSchemaName then do

855− pure $ evalState (applyStaticDatabaseOptimization dbExpr) (RE.freshDatabaseState (Sess.concreteDatabaseContext session))

784+ let ctx = Sess.concreteDatabaseContext session

785+ transId = Sess.parentId session

786+ gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextExpr dbExpr)

787+ pure $ runGraphRefSOptDatabaseContextExprM transId ctx graph (optimizeGraphRefDatabaseContextExpr gfExpr)

856− else -- don't show any optimization because the current optimization infrastructure relies on access to the base context- this probably underscores the need for each schema to have its own DatabaseContext, even if it is generated on-the-fly

788+ else -- don't show any optimization because the current optimization infrastructure relies on access to the base context- this probably underscores the need for each schema to have its own DatabaseContext, even if it is generated on-the-fly-}

857− pure (Right dbExpr)

789+ pure (Left NonConcreteSchemaPlanError)

858

790

859−planForDatabaseContextExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr)

791+planForDatabaseContextExpr sessionId conn@(RemoteConnection _) dbExpr = remoteCall conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr)

860

792

861-- | Return a relation which represents the current state of the global transaction graph. The attributes are

793-- | Return a relation which represents the current state of the global transaction graph. The attributes are

862-- * current- boolean attribute representing whether or not the current session references this transaction

794-- * current- boolean attribute representing whether or not the current session references this transaction

@@ -871,30 +803,57 @@ transactionGraphAsRelation sessionId (InProcessConnection conf) = do

871 eSession <- sessionForSessionId sessionId sessions

803 eSession <- sessionForSessionId sessionId sessions

872 case eSession of

804 case eSession of

873 Left err -> pure $ Left err

805 Left err -> pure $ Left err

874− Right session -> do

806+ Right session ->

875− graph <- readTVar tvar

876− pure $ graphAsRelation (Sess.disconnectedTransaction session) graph

807+ graphAsRelation (Sess.disconnectedTransaction session) <$> readTVar tvar

877

808

878−transactionGraphAsRelation sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveTransactionGraph sessionId)

809+transactionGraphAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveTransactionGraph sessionId)

879

810

880-- | Returns the names and types of the relation variables in the current 'Session'.

811-- | Returns the names and types of the relation variables in the current 'Session'.

881relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

812relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

882relationVariablesAsRelation sessionId (InProcessConnection conf) = do

813relationVariablesAsRelation sessionId (InProcessConnection conf) = do

883 let sessions = ipSessions conf

814 let sessions = ipSessions conf

884 atomically $ do

815 atomically $ do

816+ graph <- readTVar (ipTransactionGraph conf)

885 eSession <- sessionAndSchema sessionId sessions

817 eSession <- sessionAndSchema sessionId sessions

886 case eSession of

818 case eSession of

887 Left err -> pure (Left err)

819 Left err -> pure (Left err)

888 Right (session, schema) -> do

820 Right (session, schema) -> do

889 let context = Sess.concreteDatabaseContext session

821 let context = Sess.concreteDatabaseContext session

890 if Sess.schemaName session == defaultSchemaName then

822 if Sess.schemaName session == defaultSchemaName then

891− pure $ R.relationVariablesAsRelation (relationVariables context)

823+ pure $ RE.relationVariablesAsRelation context graph

892 else

824 else

893− case Schema.relationVariablesInSchema schema context of

825+ case Schema.relationVariablesInSchema schema of

894 Left err -> pure (Left err)

826 Left err -> pure (Left err)

827+ Right relvars -> do

828+ let schemaContext = context {relationVariables = relvars }

895− Right relvars -> pure $ R.relationVariablesAsRelation relvars

829+ pure $ RE.relationVariablesAsRelation schemaContext graph

896

830

897−relationVariablesAsRelation sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveRelationVariableSummary sessionId)

831+relationVariablesAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveRelationVariableSummary sessionId)

832+

833+-- | Returns the names and types of the atom functions in the current 'Session'.

834+atomFunctionsAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

835+atomFunctionsAsRelation sessionId (InProcessConnection conf) = do

836+ let sessions = ipSessions conf

837+ atomically $ do

838+ eSession <- sessionAndSchema sessionId sessions

839+ case eSession of

840+ Left err -> pure (Left err)

841+ Right (session, _) ->

842+ pure (AF.atomFunctionsAsRelation (atomFunctions (concreteDatabaseContext session)))

843+

844+atomFunctionsAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveAtomFunctionSummary sessionId)

845+

846+databaseContextFunctionsAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

847+databaseContextFunctionsAsRelation sessionId (InProcessConnection conf) = do

848+ let sessions = ipSessions conf

849+ atomically $ do

850+ eSession <- sessionAndSchema sessionId sessions

851+ case eSession of

852+ Left err -> pure (Left err)

853+ Right (session, _) ->

854+ pure (DCF.databaseContextFunctionsAsRelation (dbcFunctions (concreteDatabaseContext session)))

855+

856+databaseContextFunctionsAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveDatabaseContextFunctionSummary sessionId)

898

857

899-- | Returns the transaction id for the connection's disconnected transaction committed parent transaction.

858-- | Returns the transaction id for the connection's disconnected transaction committed parent transaction.

900headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId)

859headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId)

@@ -905,7 +864,7 @@ headTransactionId sessionId (InProcessConnection conf) = do

905 case eSession of

864 case eSession of

906 Left err -> pure (Left err)

865 Left err -> pure (Left err)

907 Right session -> pure $ Right (Sess.parentId session)

866 Right session -> pure $ Right (Sess.parentId session)

908−headTransactionId sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveHeadTransactionId sessionId)

867+headTransactionId sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveHeadTransactionId sessionId)

909

868

910headNameSTM_ :: SessionId -> Sessions -> TVar TransactionGraph -> STM (Either RelationalError HeadName)

869headNameSTM_ :: SessionId -> Sessions -> TVar TransactionGraph -> STM (Either RelationalError HeadName)

911headNameSTM_ sessionId sessions graphTvar = do

870headNameSTM_ sessionId sessions graphTvar = do

@@ -913,7 +872,7 @@ headNameSTM_ sessionId sessions graphTvar = do

913 eSession <- sessionForSessionId sessionId sessions

872 eSession <- sessionForSessionId sessionId sessions

914 case eSession of

873 case eSession of

915 Left err -> pure (Left err)

874 Left err -> pure (Left err)

916− Right session -> case transactionForId (Sess.parentId session) graph of

875+ Right session -> case RE.transactionForId (Sess.parentId session) graph of

917 Left err -> pure (Left err)

876 Left err -> pure (Left err)

918 Right parentTrans -> case headNameForTransaction parentTrans graph of

877 Right parentTrans -> case headNameForTransaction parentTrans graph of

919 Nothing -> pure (Left UnknownHeadError)

878 Nothing -> pure (Left UnknownHeadError)

@@ -925,7 +884,7 @@ headName sessionId (InProcessConnection conf) = do

925 let sessions = ipSessions conf

884 let sessions = ipSessions conf

926 graphTvar = ipTransactionGraph conf

885 graphTvar = ipTransactionGraph conf

927 atomically (headNameSTM_ sessionId sessions graphTvar)

886 atomically (headNameSTM_ sessionId sessions graphTvar)

928−headName sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteHeadName sessionId)

887+headName sessionId conn@(RemoteConnection _) = remoteCall conn (ExecuteHeadName sessionId)

929

888

930-- | Returns a listing of all available atom types.

889-- | Returns a listing of all available atom types.

931atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

890atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

@@ -939,7 +898,7 @@ atomTypesAsRelation sessionId (InProcessConnection conf) = do

939 case typesAsRelation (B.typeConstructorMapping (Sess.concreteDatabaseContext session)) of

898 case typesAsRelation (B.typeConstructorMapping (Sess.concreteDatabaseContext session)) of

940 Left err -> pure (Left err)

899 Left err -> pure (Left err)

941 Right rel -> pure (Right rel)

900 Right rel -> pure (Right rel)

942−atomTypesAsRelation sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveAtomTypesAsRelation sessionId)

901+atomTypesAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveAtomTypesAsRelation sessionId)

943

902

944disconnectedTransactionIsDirty :: SessionId -> Connection -> IO (Either RelationalError Bool)

903disconnectedTransactionIsDirty :: SessionId -> Connection -> IO (Either RelationalError Bool)

945disconnectedTransactionIsDirty sessionId (InProcessConnection conf) = do

904disconnectedTransactionIsDirty sessionId (InProcessConnection conf) = do

@@ -950,23 +909,23 @@ disconnectedTransactionIsDirty sessionId (InProcessConnection conf) = do

950 Left err -> pure (Left err)

909 Left err -> pure (Left err)

951 Right session ->

910 Right session ->

952 pure (Right (isDirty session))

911 pure (Right (isDirty session))

953−disconnectedTransactionIsDirty sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveSessionIsDirty sessionId)

912+disconnectedTransactionIsDirty sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveSessionIsDirty sessionId)

954

913

955--used only for testing- we expect this to throw an exception

914--used only for testing- we expect this to throw an exception

956callTestTimeout_ :: SessionId -> Connection -> IO Bool

915callTestTimeout_ :: SessionId -> Connection -> IO Bool

957callTestTimeout_ _ (InProcessConnection _) = error "bad testing call"

916callTestTimeout_ _ (InProcessConnection _) = error "bad testing call"

958−callTestTimeout_ sessionId conn@(RemoteProcessConnection _) = remoteCall conn (TestTimeout sessionId)

917+callTestTimeout_ sessionId conn@(RemoteConnection _) = remoteCall conn (TestTimeout sessionId)

959

918

960--used in tests only

919--used in tests only

961transactionGraph_ :: Connection -> IO TransactionGraph

920transactionGraph_ :: Connection -> IO TransactionGraph

962−transactionGraph_ (InProcessConnection conf) = atomically $ readTVar (ipTransactionGraph conf)

921+transactionGraph_ (InProcessConnection conf) = readTVarIO (ipTransactionGraph conf)

963transactionGraph_ _ = error "remote connection used"

922transactionGraph_ _ = error "remote connection used"

964

923

965--used in tests only

924--used in tests only

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

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

967disconnectedTransaction_ sessionId (InProcessConnection conf) = do

926disconnectedTransaction_ sessionId (InProcessConnection conf) = do

968 let sessions = ipSessions conf

927 let sessions = ipSessions conf

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

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

970 case mSession of

929 case mSession of

971 Nothing -> error "No such session"

930 Nothing -> error "No such session"

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

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

@@ -1024,13 +983,13 @@ commitLock_ sessionId conf stmBlock = do

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

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

1025 writeTVar graphTvar graph'

984 writeTVar graphTvar graph'

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

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

1027− STMMap.insert newSession sessionId sessions

986+ StmMap.insert newSession sessionId sessions

1028− case transactionForId (Sess.parentId session) oldGraph of

987+ case RE.transactionForId (Sess.parentId session) oldGraph of

1029 Left err -> pure $ Left err

988 Left err -> pure $ Left err

1030 Right previousTrans ->

989 Right previousTrans ->

1031 if not (Prelude.null transactionIdsToPersist) then do

990 if not (Prelude.null transactionIdsToPersist) then do

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

991+ (evaldNots, nodes) <- executeCommitExprSTM_ graph' (Trans.concreteDatabaseContext previousTrans) (Sess.concreteDatabaseContext session) clientNodes

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

992+ nodesToNotify <- stmSetToList nodes

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

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

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

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

1036

995

@@ -1040,15 +999,8 @@ commitLock_ sessionId conf stmBlock = do

1040 Right (notsToFire, nodesToNotify, newGraph, transactionIdsToPersist) -> do

999 Right (notsToFire, nodesToNotify, newGraph, transactionIdsToPersist) -> do

1041 --update filesystem database, if necessary

1000 --update filesystem database, if necessary

1042 processTransactionGraphPersistence strat transactionIdsToPersist newGraph

1001 processTransactionGraphPersistence strat transactionIdsToPersist newGraph

1043− sendNotifications nodesToNotify (ipLocalNode conf) notsToFire

1002+ sendNotifications nodesToNotify notsToFire

1044 pure (Right ())

1003 pure (Right ())

1045−{-

1046−writeDisconAndGraph_ :: TVar TransactionGraph -> SessionId -> Session -> Sessions -> DisconnectedTransaction -> TransactionGraph -> STM ()

1047−writeDisconAndGraph_ graphTvar sessionId session sessions discon graph = do

1048− writeTVar graphTvar graph

1049− let newSession = Session discon (Sess.schemaName session)

1050− STMMap.insert newSession sessionId sessions

1051−-}

1052

1004

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

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

1054withTransaction :: SessionId -> Connection -> IO (Either RelationalError a) -> IO (Either RelationalError ()) -> IO (Either RelationalError a)

1006withTransaction :: SessionId -> Connection -> IO (Either RelationalError a) -> IO (Either RelationalError ()) -> IO (Either RelationalError a)

@@ -1073,3 +1025,71 @@ withTransaction sessionId conn io successFunc = bracketOnError (pure ()) (const

1073 Right _ -> pure (Right val)

1025 Right _ -> pure (Right val)

1074 else -- no updates executed, so don't create a commit

1026 else -- no updates executed, so don't create a commit

1075 pure (Right val)

1027 pure (Right val)

1028+

1029+executeDataFrameExpr :: SessionId -> Connection -> DF.DataFrameExpr -> IO (Either RelationalError DF.DataFrame)

1030+executeDataFrameExpr sessionId conn@(InProcessConnection _) dfExpr = do

1031+ eRel <- executeRelationalExpr sessionId conn (DF.convertExpr dfExpr)

1032+ case eRel of

1033+ Left err -> pure (Left err)

1034+ Right rel -> do

1035+ let relAttrs = R.attributes rel

1036+ attrName (DF.AttributeOrderExpr name _) = name

1037+ order (DF.AttributeOrderExpr _ ord) = ord

1038+ orders = map order (DF.orderExprs dfExpr)

1039+ attributeForName' = flip attributeForName relAttrs

1040+ attrNames = map attrName (DF.orderExprs dfExpr)

1041+ verified = forM attrNames attributeForName'

1042+ case verified of

1043+ Left err -> pure (Left err)

1044+ Right attrs -> do

1045+ let attrOrders = zipWith

1046+ (DF.AttributeOrder . attributeName)

1047+ attrs

1048+ orders

1049+ case DF.sortDataFrameBy attrOrders . DF.toDataFrame $ rel of

1050+ Left err -> pure (Left err)

1051+ Right dFrame -> do

1052+ let dFrame' = maybe dFrame (`DF.drop'` dFrame) (DF.offset dfExpr)

1053+ dFrame'' = maybe dFrame' (`DF.take'` dFrame') (DF.limit dfExpr)

1054+ pure (Right dFrame'')

1055+executeDataFrameExpr sessionId conn@(RemoteConnection _) dfExpr = remoteCall conn (ExecuteDataFrameExpr sessionId dfExpr)

1056+

1057+validateMerkleHashes :: SessionId -> Connection -> IO (Either RelationalError ())

1058+validateMerkleHashes sessionId (InProcessConnection conf) = do

1059+ let sessions = ipSessions conf

1060+ atomically $ do

1061+ eSession <- sessionForSessionId sessionId sessions

1062+ case eSession of

1063+ Left err -> pure (Left err)

1064+ Right _ -> do

1065+ graph <- readTVar (ipTransactionGraph conf)

1066+ case Graph.validateMerkleHashes graph of

1067+ Left merkleErrs -> pure $ Left $ someErrors (map (\(MerkleValidationError tid expected actual) -> MerkleHashValidationError tid expected actual) merkleErrs)

1068+ Right () -> pure (Right ())

1069+validateMerkleHashes sessionId conn@RemoteConnection{} = remoteCall conn (ExecuteValidateMerkleHashes sessionId)

1070+

1071+type ClientNodes = StmSet.Set ClientInfo

1072+

1073+-- internal structure specific to in-process connections

1074+data InProcessConnectionConf = InProcessConnectionConf {

1075+ ipPersistenceStrategy :: PersistenceStrategy,

1076+ ipClientNodes :: ClientNodes,

1077+ ipSessions :: Sessions,

1078+ ipTransactionGraph :: TVar TransactionGraph,

1079+ ipScriptSession :: Maybe ScriptSession,

1080+ ipLocks :: Maybe (LockFile, MVar LockFileHash), -- nothing when NoPersistence

1081+ ipCallbackAsync :: Async ()

1082+ }

1083+

1084+-- clients may connect associate one socket/mvar with the server to register for change callbacks

1085+data ClientInfo = RemoteClientInfo (RPC.Locking Socket) |

1086+ InProcessClientInfo (MVar EvaluatedNotifications)

1087+

1088+instance Eq ClientInfo where

1089+ (RemoteClientInfo a) == (RemoteClientInfo b) = RPC.lockless a == RPC.lockless b

1090+ (InProcessClientInfo a) == (InProcessClientInfo b) = a == b

1091+ _ == _ = False

1092+

1093+instance Hashable ClientInfo where

1094+ hashWithSalt salt (RemoteClientInfo sock) = hashWithSalt salt (show (RPC.lockless sock))

1095+ hashWithSalt salt (InProcessClientInfo _) = hashWithSalt salt (1::Int)

src/lib/ProjectM36/Client/Simple.hs+4−3

@@ -25,7 +25,8 @@ module ProjectM36.Client.Simple (

25 C.PersistenceStrategy(..),

26 C.NotificationCallback,

27 C.emptyNotificationCallback,

28− C.DatabaseContextExpr(..),

28+ C.DatabaseContextExprBase(..),

29+ C.DatabaseContextExpr,

29 C.RelationalExprBase(..)

30 C.RelationalExprBase(..)

30 ) where

31 ) where

@@ -72,7 +73,7 @@ close (_ , conn) = C.close conn

72withTransaction :: DbConn -> Db a -> IO (Either DbError a)

73withTransaction :: DbConn -> Db a -> IO (Either DbError a)

73withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy

74withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy

75−-- | Same a 'withTransaction' except that the merge strategy can be specified.

76+-- | Same as 'withTransaction' except that the merge strategy can be specified.

76withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)

77withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)

77withTransactionUsing (sess, conn) strat dbm = do

78withTransactionUsing (sess, conn) strat dbm = do

78 eHeadName <- C.headName sess conn

79 eHeadName <- C.headName sess conn

@@ -84,7 +85,7 @@ withTransactionUsing (sess, conn) strat dbm = do

84 handler :: TransactionCancelled -> IO (Either DbError a)

85 handler :: TransactionCancelled -> IO (Either DbError a)

85 handler (TransactionCancelled err) = pure (Left err)

86 handler (TransactionCancelled err) = pure (Left err)

86 handle handler $ do

87 handle handler $ do

87− ret <- C.withTransaction sess conn (block >>= pure . Right) successFunc

88+ ret <- C.withTransaction sess conn (Right <$> block) successFunc

88 case ret of

89 case ret of

89 Left err -> pure (Left (RelError err))

90 Left err -> pure (Left (RelError err))

90 Right val -> pure (Right val)

91 Right val -> pure (Right val)

src/lib/ProjectM36/DataConstructorDef.hs+2−3

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

1module ProjectM36.DataConstructorDef where

2−import ProjectM36.Base

2+import ProjectM36.Base as B

3−import qualified ProjectM36.TypeConstructor as TC

4import qualified Data.Set as S

3import qualified Data.Set as S

6emptyDataConstructor :: DataConstructorName -> DataConstructorDef

5emptyDataConstructor :: DataConstructorName -> DataConstructorDef

@@ -16,6 +15,6 @@ typeVars :: DataConstructorDef -> S.Set TypeVarName

16typeVars (DataConstructorDef _ tConsArgs) = S.unions $ map typeVarsInDefArg tConsArgs

15typeVars (DataConstructorDef _ tConsArgs) = S.unions $ map typeVarsInDefArg tConsArgs

18typeVarsInDefArg :: DataConstructorDefArg -> S.Set TypeVarName

17typeVarsInDefArg :: DataConstructorDefArg -> S.Set TypeVarName

19−typeVarsInDefArg (DataConstructorDefTypeConstructorArg tCons) = TC.typeVars tCons

18+typeVarsInDefArg (DataConstructorDefTypeConstructorArg tCons) = B.typeVars tCons

20typeVarsInDefArg (DataConstructorDefTypeVarNameArg pVarName) = S.singleton pVarName

19typeVarsInDefArg (DataConstructorDefTypeVarNameArg pVarName) = S.singleton pVarName

src/lib/ProjectM36/DataFrame.hsnew file+183

@@ -0,0 +1,183 @@

1+{-# LANGUAGE DeriveGeneric, DerivingVia #-}

2+{- A dataframe is a strongly-typed, ordered list of named tuples. A dataframe differs from a relation in that its tuples are ordered.-}

3+module ProjectM36.DataFrame where

4+import ProjectM36.Base

5+import ProjectM36.Attribute as A hiding (drop)

6+import ProjectM36.Error

7+import qualified ProjectM36.Relation as R

8+import ProjectM36.Relation.Show.Term

9+import qualified ProjectM36.Relation.Show.HTML as RelHTML

10+import ProjectM36.DataTypes.Sorting

11+import ProjectM36.AtomType

12+import ProjectM36.Atom

13+import qualified Data.Vector as V

14+import GHC.Generics

15+import qualified Data.List as L

16+import qualified Data.Set as S

17+import Data.Maybe

18+import qualified Data.Text as T

19+import Control.Arrow

20+#if __GLASGOW_HASKELL__ < 804

21+import Data.Monoid

22+#endif

23+

24+data AttributeOrderExpr = AttributeOrderExpr AttributeName Order

25+ deriving (Show, Generic)

26+

27+data AttributeOrder = AttributeOrder AttributeName Order

28+ deriving (Show, Generic)

29+

30+data Order = AscendingOrder | DescendingOrder

31+ deriving (Eq, Show, Generic)

32+

33+ascending :: T.Text

34+ascending = "⬆"

35+

36+descending :: T.Text

37+descending = "⬇"

38+

39+arbitrary :: T.Text

40+arbitrary = "↕"

41+

42+data DataFrame = DataFrame {

43+ orders :: [AttributeOrder],

44+ attributes :: Attributes,

45+ tuples :: [DataFrameTuple]

46+ }

47+ deriving (Show, Generic)

48+

49+data DataFrameTuple = DataFrameTuple Attributes (V.Vector Atom)

50+ deriving (Eq, Show, Generic)

51+

52+sortDataFrameBy :: [AttributeOrder] -> DataFrame -> Either RelationalError DataFrame

53+sortDataFrameBy attrOrders frame = do

54+ attrs <- mapM (\(AttributeOrder nam _) -> A.attributeForName nam (attributes frame)) attrOrders

55+ mapM_ (\attr -> if not (isSortableAtomType (atomType attr)) then

56+ Left (AttributeNotSortableError attr)

57+ else

58+ pure ()) attrs

59+ pure $ DataFrame attrOrders (attributes frame) (sortTuplesBy (compareTupleByAttributeOrders attrOrders) (tuples frame))

60+

61+sortTuplesBy :: (DataFrameTuple -> DataFrameTuple -> Ordering) -> [DataFrameTuple] -> [DataFrameTuple]

62+sortTuplesBy = L.sortBy

63+

64+compareTupleByAttributeOrders :: [AttributeOrder] -> DataFrameTuple -> DataFrameTuple -> Ordering

65+compareTupleByAttributeOrders attributeOrders tup1 tup2 =

66+ let compare' (AttributeOrder attr order) = if order == DescendingOrder

67+ then compareTupleByOneAttributeName attr tup2 tup1

68+ else compareTupleByOneAttributeName attr tup1 tup2

69+ res = map compare' attributeOrders in

70+ fromMaybe EQ (L.find (/= EQ) res)

71+

72+compareTupleByOneAttributeName :: AttributeName -> DataFrameTuple -> DataFrameTuple -> Ordering

73+compareTupleByOneAttributeName attr tuple1 tuple2 =

74+ let eAtom1 = atomForAttributeName attr tuple1

75+ eAtom2 = atomForAttributeName attr tuple2 in

76+ case eAtom1 of

77+ Left err -> error (show err)

78+ Right atom1 ->

79+ case eAtom2 of

80+ Left err -> error (show err)

81+ Right atom2 -> compareAtoms atom1 atom2

82+

83+atomForAttributeName :: AttributeName -> DataFrameTuple -> Either RelationalError Atom

84+atomForAttributeName attrName (DataFrameTuple tupAttrs tupVec) = case V.findIndex (\attr -> attributeName attr == attrName) (attributesVec tupAttrs) of

85+ Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))

86+ Just index -> case tupVec V.!? index of

87+ Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))

88+ Just atom -> Right atom

89+

90+take' :: Integer -> DataFrame -> DataFrame

91+take' n df = df { tuples = take (fromInteger n) (tuples df) }

92+

93+drop' :: Integer -> DataFrame -> DataFrame

94+drop' n df = df { tuples = drop (fromInteger n) (tuples df) }

95+

96+toDataFrame :: Relation -> DataFrame

97+toDataFrame (Relation attrs (RelationTupleSet tuples')) = DataFrame [] attrs (map (\(RelationTuple tupAttrs tupVec) -> DataFrameTuple tupAttrs tupVec) tuples')

98+

99+fromDataFrame :: DataFrame -> Either RelationalError Relation

100+fromDataFrame df = R.mkRelation (attributes df) (RelationTupleSet tuples')

101+ where

102+ tuples' = map (\(DataFrameTuple attrs' tupVec) -> RelationTuple attrs' tupVec) (tuples df)

103+

104+showDataFrame :: DataFrame -> T.Text

105+showDataFrame = renderTable . dataFrameAsTable

106+

107+--terminal display

108+dataFrameAsTable :: DataFrame -> Table

109+dataFrameAsTable df = (header, body)

110+ where

111+ oAttrNames = orderedAttributeNames (attributes df)

112+ oAttrs = orderedAttributes (attributes df)

113+ header = "DF" : map dfPrettyAttribute oAttrs

114+ dfPrettyAttribute attr = prettyAttribute attr <> case L.find (\(AttributeOrder nam _) -> nam == attributeName attr) (orders df) of

115+ Nothing -> arbitrary

116+ Just (AttributeOrder _ AscendingOrder) -> ascending

117+ Just (AttributeOrder _ DescendingOrder) -> descending

118+ body = snd (L.foldl' tupleFolder (1 :: Int,[]) (tuples df))

119+ tupleFolder (count, acc) tuple = (count + 1,

120+ acc ++ [T.pack (show count) : map (\attrName -> case atomForAttributeName attrName tuple of

121+ Left _ -> "?"

122+ Right atom -> showAtom 0 atom

123+ ) oAttrNames])

124+

125+-- | A Relation can be converted to a DataFrame for sorting, limits, and offsets.

126+data DataFrameExpr = DataFrameExpr {

127+ convertExpr :: RelationalExpr,

128+ orderExprs :: [AttributeOrderExpr],

129+ offset :: Maybe Integer,

130+ limit :: Maybe Integer

131+ }

132+ deriving (Show, Generic)

133+

134+dataFrameAsHTML :: DataFrame -> T.Text

135+-- web browsers don't display tables with empty cells or empty headers, so we have to insert some placeholders- it's not technically the same, but looks as expected in the browser

136+dataFrameAsHTML df

137+ | length (tuples df) == 1 && A.null (attributes df) = style <>

138+ tablestart <>

139+ "<tr><th></th></tr>" <>

140+ "<tr><td></td></tr>" <>

141+ tablefooter <> "</table>"

142+ | L.null (tuples df) && A.null (attributes df) = style <>

143+ tablestart <>

144+ "<tr><th></th></tr>" <>

145+ tablefooter <>

146+ "</table>"

147+ | otherwise = style <>

148+ tablestart <>

149+ attributesAsHTML (attributes df) (orders df) <>

150+ tuplesAsHTML (tuples df) <>

151+ tablefooter <>

152+ "</table>"

153+ where

154+ cardinality = T.pack (show (length (tuples df)))

155+ style = "<style>.pm36dataframe {empty-cells: show;} .pm36dataframe tbody td, .pm36relation th { border: 1px solid black;}</style>"

156+ tablefooter = "<tfoot><tr><td colspan=\"100%\">" <> cardinality <> " tuples</td></tr></tfoot>"

157+ tablestart = "<table class=\"pm36dataframe\"\">"

158+

159+tuplesAsHTML :: [DataFrameTuple] -> T.Text

160+tuplesAsHTML = foldr folder ""

161+ where

162+ folder tuple acc = acc <> tupleAsHTML tuple

163+

164+tupleAssocs :: DataFrameTuple -> [(AttributeName, Atom)]

165+tupleAssocs (DataFrameTuple attrs tupVec) = V.toList $ V.map (first attributeName) (V.zip (attributesVec attrs) tupVec)

166+

167+

168+tupleAsHTML :: DataFrameTuple -> T.Text

169+tupleAsHTML tuple = "<tr>" <> T.concat (L.map tupleFrag (tupleAssocs tuple)) <> "</tr>"

170+ where

171+ tupleFrag tup = "<td>" <> atomAsHTML (snd tup) <> "</td>"

172+ atomAsHTML (RelationAtom rel) = RelHTML.relationAsHTML rel

173+ atomAsHTML (TextAtom t) = """ <> t <> """

174+ atomAsHTML atom = atomToText atom

175+

176+attributesAsHTML :: Attributes -> [AttributeOrder] -> T.Text

177+attributesAsHTML attrs orders' = "<tr>" <> T.concat (map oneAttrHTML (A.toList attrs)) <> "</tr>"

178+ where

179+ oneAttrHTML attr = "<th>" <> prettyAttribute attr <> ordering (attributeName attr) <> "</th>"

180+ ordering attrName = " " <> case L.find (\(AttributeOrder nam _) -> nam == attrName) orders' of

181+ Nothing -> "(arb)"

182+ Just (AttributeOrder _ AscendingOrder) -> "(asc)"

183+ Just (AttributeOrder _ DescendingOrder) -> "(desc)"

src/lib/ProjectM36/DataTypes/Basic.hs+4−2

@@ -1,10 +1,11 @@

1-- wraps up primitives plus other basic data types

2module ProjectM36.DataTypes.Basic where

3import ProjectM36.DataTypes.Primitive

4−import ProjectM36.DataTypes.Day

5import ProjectM36.DataTypes.Either

4import ProjectM36.DataTypes.Either

6import ProjectM36.DataTypes.Maybe

5import ProjectM36.DataTypes.Maybe

7import ProjectM36.DataTypes.List

6import ProjectM36.DataTypes.List

7+import ProjectM36.DataTypes.NonEmptyList

8+import ProjectM36.DataTypes.Interval

8import ProjectM36.Base

9import ProjectM36.Base

10basicTypeConstructorMapping :: TypeConstructorMapping

11basicTypeConstructorMapping :: TypeConstructorMapping

@@ -12,6 +13,7 @@ basicTypeConstructorMapping = primitiveTypeConstructorMapping ++

12 maybeTypeConstructorMapping ++

13 maybeTypeConstructorMapping ++

13 eitherTypeConstructorMapping ++

14 eitherTypeConstructorMapping ++

14 listTypeConstructorMapping ++

15 listTypeConstructorMapping ++

15− dayTypeConstructorMapping

16+ nonEmptyListTypeConstructorMapping ++

17+ intervalTypeConstructorMapping

src/lib/ProjectM36/DataTypes/Day.hs+2−5

@@ -7,14 +7,11 @@ import Data.Time.Calendar

7dayAtomFunctions :: AtomFunctions

8dayAtomFunctions = HS.fromList [

9 AtomFunction { atomFuncName = "fromGregorian",

10− atomFuncType = [IntAtomType, IntAtomType, IntAtomType, DayAtomType],

10+ atomFuncType = [IntegerAtomType, IntegerAtomType, IntegerAtomType, DayAtomType],

11− atomFuncBody = compiledAtomFunctionBody $ \(IntAtom year:IntAtom month:IntAtom day:_) -> pure $ DayAtom (fromGregorian (fromIntegral year) (fromIntegral month) (fromIntegral day))

11+ atomFuncBody = compiledAtomFunctionBody $ \(IntegerAtom year:IntegerAtom month:IntegerAtom day:_) -> pure $ DayAtom (fromGregorian (fromIntegral year) (fromIntegral month) (fromIntegral day))

12 },

13 AtomFunction { atomFuncName = "dayEarlierThan",

14 atomFuncType = [DayAtomType, DayAtomType, BoolAtomType],

15 atomFuncBody = compiledAtomFunctionBody $ \(ConstructedAtom _ _ (IntAtom dayA:_):ConstructedAtom _ _ (IntAtom dayB:_):_) -> pure (BoolAtom (dayA < dayB))

16 }

17 ]

18−

19−dayTypeConstructorMapping :: TypeConstructorMapping

20−dayTypeConstructorMapping = [] -- use fromGregorian

src/lib/ProjectM36/DataTypes/Interval.hs+57−19

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

6import ProjectM36.DataTypes.Primitive

7import ProjectM36.AtomFunctionError

8import qualified Data.HashSet as HS

9+import qualified Data.Map as M

10+import Control.Monad (when)

11+import Data.Maybe

13+type OpenInterval = Bool

14+

15+intervalSubType :: AtomType -> AtomType

16+intervalSubType typ = if isIntervalAtomType typ then

17+ case typ of

18+ ConstructedAtomType _ tvMap ->

19+ fromMaybe err (M.lookup "a" tvMap)

20+ _ -> err

21+ else

22+ err

23+ where

24+ err = error "intervalSubType on non-interval type"

25+

26+

10-- in lieu of typeclass support, we just hard-code the types which can be part of an interval

27-- in lieu of typeclass support, we just hard-code the types which can be part of an interval

11supportsInterval :: AtomType -> Bool

28supportsInterval :: AtomType -> Bool

12supportsInterval typ = case typ of

29supportsInterval typ = case typ of

@@ -18,9 +35,9 @@ supportsInterval typ = case typ of

18 DateTimeAtomType -> True

35 DateTimeAtomType -> True

19 ByteStringAtomType -> False

36 ByteStringAtomType -> False

20 BoolAtomType -> False

37 BoolAtomType -> False

21− IntervalAtomType _ -> False

22 RelationAtomType _ -> False

38 RelationAtomType _ -> False

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

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

40+ RelationalExprAtomType -> False

24 TypeVariableType _ -> False

41 TypeVariableType _ -> False

26supportsOrdering :: AtomType -> Bool

43supportsOrdering :: AtomType -> Bool

@@ -33,8 +50,8 @@ supportsOrdering typ = case typ of

33 DateTimeAtomType -> True

50 DateTimeAtomType -> True

34 ByteStringAtomType -> False

51 ByteStringAtomType -> False

35 BoolAtomType -> False

52 BoolAtomType -> False

36− IntervalAtomType _ -> False

37 RelationAtomType _ -> False

53 RelationAtomType _ -> False

54+ RelationalExprAtomType -> False

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

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

39 TypeVariableType _ -> False

56 TypeVariableType _ -> False

@@ -67,7 +84,11 @@ createInterval atom1 atom2 bopen eopen = do

67 else

84 else

68 Right valid

85 Right valid

69 LT -> Right valid

86 LT -> Right valid

70− where valid = IntervalAtom atom1 atom2 bopen eopen

87+ where valid = ConstructedAtom "Interval" iType [atom1, atom2, BoolAtom bopen, BoolAtom eopen]

88+ iType = intervalAtomType (atomTypeForAtom atom1)

89+

90+intervalAtomType :: AtomType -> AtomType

91+intervalAtomType typ = ConstructedAtomType "Interval" (M.singleton "a" typ)

72intervalAtomFunctions :: AtomFunctions

93intervalAtomFunctions :: AtomFunctions

73intervalAtomFunctions = HS.fromList [

94intervalAtomFunctions = HS.fromList [

@@ -76,7 +97,7 @@ intervalAtomFunctions = HS.fromList [

76 TypeVariableType "a",

97 TypeVariableType "a",

77 BoolAtomType,

98 BoolAtomType,

78 BoolAtomType,

99 BoolAtomType,

79− IntervalAtomType (TypeVariableType "a")],

100+ intervalAtomType (TypeVariableType "a")],

80 atomFuncBody = compiledAtomFunctionBody $ \(atom1:atom2:BoolAtom bopen:BoolAtom eopen:_) -> do

101 atomFuncBody = compiledAtomFunctionBody $ \(atom1:atom2:BoolAtom bopen:BoolAtom eopen:_) -> do

81 let aType = atomTypeForAtom atom1

102 let aType = atomTypeForAtom atom1

82 if supportsInterval aType then

103 if supportsInterval aType then

@@ -86,23 +107,40 @@ intervalAtomFunctions = HS.fromList [

86 },

107 },

87 AtomFunction {

108 AtomFunction {

88 atomFuncName = "interval_overlaps",

109 atomFuncName = "interval_overlaps",

89− atomFuncType = [IntervalAtomType (TypeVariableType "a"),

110+ atomFuncType = [intervalAtomType (TypeVariableType "a"),

90− IntervalAtomType (TypeVariableType "a"),

111+ intervalAtomType (TypeVariableType "a"),

91 BoolAtomType],

112 BoolAtomType],

92− atomFuncBody = compiledAtomFunctionBody $ \(i1@IntervalAtom{}:i2@IntervalAtom{}:_) -> do

113+ atomFuncBody = compiledAtomFunctionBody $ \(i1@ConstructedAtom{}:i2@ConstructedAtom{}:_) ->

93− res <- intervalOverlaps i1 i2

114+ BoolAtom <$> intervalOverlaps i1 i2

94− pure (BoolAtom res)

95 }]

115 }]

96−

116+

97−

117+isIntervalAtomType :: AtomType -> Bool

118+isIntervalAtomType (ConstructedAtomType nam tvMap) =

119+ nam == "Interval" && M.keys tvMap == ["a"] && case M.lookup "a" tvMap of

120+ Nothing -> False

121+ Just subType -> supportsInterval subType || subType == TypeVariableType "a"

122+isIntervalAtomType _ = False

123+

98intervalOverlaps :: Atom -> Atom -> Either AtomFunctionError Bool

124intervalOverlaps :: Atom -> Atom -> Either AtomFunctionError Bool

99−intervalOverlaps (IntervalAtom i1start i1end i1startopen i1endopen) (IntervalAtom i2start i2end i2startopen i2endopen) = do

125+intervalOverlaps (ConstructedAtom dCons1 typ1 [i1start,

126+ i1end,

127+ BoolAtom i1startopen,

128+ BoolAtom i1endopen]) (ConstructedAtom dCons2 typ2

129+ [i2start,

130+ i2end,

131+ BoolAtom i2startopen,

132+ BoolAtom i2endopen]) = do

133+ when (dCons1 /= "Interval" || dCons2 /= "Interval" || not (isIntervalAtomType typ1) || not (isIntervalAtomType typ2)) (Left AtomFunctionTypeMismatchError)

100− cmp1 <- atomCompare i1start i2end

134+ cmp1 <- atomCompare i1start i2end

101− cmp2 <- atomCompare i2start i1end

135+ cmp2 <- atomCompare i2start i1end

102− let startcmp = if i1startopen || i2endopen then oplt else oplte

136+ let startcmp = if i1startopen || i2endopen then oplt else oplte

103− endcmp = if i2startopen || i1endopen then oplt else oplte

137+ endcmp = if i2startopen || i1endopen then oplt else oplte

104− oplte op = op == LT || op == EQ

138+ oplte op = op == LT || op == EQ

105− oplt op = op == LT

139+ oplt op = op == LT

106− pure (startcmp cmp1 && endcmp cmp2)

140+ pure (startcmp cmp1 && endcmp cmp2)

107intervalOverlaps _ _ = Left AtomFunctionTypeMismatchError

141intervalOverlaps _ _ = Left AtomFunctionTypeMismatchError

108

142

143+intervalTypeConstructorMapping :: TypeConstructorMapping

144+intervalTypeConstructorMapping = [(ADTypeConstructorDef "Interval" ["a"], [])]

145+

146+

src/lib/ProjectM36/DataTypes/List.hs+2−3

@@ -37,9 +37,8 @@ listAtomFunctions = HS.fromList [

37 AtomFunction {

38 atomFuncName = "length",

39 atomFuncType = [listAtomType (TypeVariableType "a"), IntAtomType],

40− atomFuncBody = AtomFunctionBody Nothing (\(listAtom:_) -> do

40+ atomFuncBody = AtomFunctionBody Nothing (\(listAtom:_) ->

41− c <- listLength listAtom

42− pure (IntAtom (fromIntegral c)))

41+ IntAtom . fromIntegral <$> listLength listAtom)

43 },

42 },

44 AtomFunction {

43 AtomFunction {

45 atomFuncName = "maybeHead",

44 atomFuncName = "maybeHead",

src/lib/ProjectM36/DataTypes/NonEmptyList.hsnew file+53

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

1+module ProjectM36.DataTypes.NonEmptyList where

2+import ProjectM36.Base

3+import qualified Data.Map as M

4+import qualified Data.HashSet as HS

5+import ProjectM36.AtomFunctionError

6+import ProjectM36.DataTypes.List

8+nonEmptyListAtomType :: AtomType -> AtomType

9+nonEmptyListAtomType arg = ConstructedAtomType "NonEmptyList" (M.singleton "a" arg)

10+

11+-- data NonEmptyList = NECons a (Cons a)

12+nonEmptyListTypeConstructorMapping :: TypeConstructorMapping

13+nonEmptyListTypeConstructorMapping = [(ADTypeConstructorDef "NonEmptyList" ["a"],

14+ [DataConstructorDef "NECons" [DataConstructorDefTypeVarNameArg "a",

15+ DataConstructorDefTypeConstructorArg (ADTypeConstructor "List" [TypeVariable "a"])]])]

16+

17+nonEmptyListLength :: Atom -> Either AtomFunctionError Int

18+nonEmptyListLength (ConstructedAtom "NECons" _ (_:nextCons:_)) = do

19+ c <- listLength nextCons

20+ pure (c + 1)

21+nonEmptyListLength (ConstructedAtom "NECons" _ _) = pure 1

22+nonEmptyListLength _ = Left AtomFunctionTypeMismatchError

23+

24+nonEmptyListHead :: Atom -> Either AtomFunctionError Atom

25+nonEmptyListHead (ConstructedAtom "NECons" _ (val:_)) = pure val

26+nonEmptyListHead _ = Left AtomFunctionTypeMismatchError

27+

28+{-

29+listMaybeHead :: Atom -> Either AtomFunctionError Atom

30+listMaybeHead (ConstructedAtom "Cons" _ (val:_)) = pure (ConstructedAtom "Just" aType [val])

31+ where

32+ aType = maybeAtomType (atomTypeForAtom val)

33+listMaybeHead (ConstructedAtom "Empty" (ConstructedAtomType _ tvMap) _) =

34+ case M.lookup "a" tvMap of

35+ Nothing -> Left AtomFunctionTypeMismatchError

36+ Just aType -> pure (ConstructedAtom "Nothing" aType [])

37+listMaybeHead _ = Left AtomFunctionTypeMismatchError

38+-}

39+

40+nonEmptyListAtomFunctions :: AtomFunctions

41+nonEmptyListAtomFunctions = HS.fromList [

42+ AtomFunction {

43+ atomFuncName = "nonEmptyListLength",

44+ atomFuncType = [nonEmptyListAtomType (TypeVariableType "a"), IntAtomType],

45+ atomFuncBody = AtomFunctionBody Nothing (\(nonEmptyListAtom:_) ->

46+ IntAtom . fromIntegral <$> nonEmptyListLength nonEmptyListAtom)

47+ },

48+ AtomFunction {

49+ atomFuncName = "nonEmptyListHead",

50+ atomFuncType = [nonEmptyListAtomType (TypeVariableType "a"), TypeVariableType "a"],

51+ atomFuncBody = AtomFunctionBody Nothing (\(nonEmptyListAtom:_) -> nonEmptyListHead nonEmptyListAtom)

52+ }

53+ ]

src/lib/ProjectM36/DataTypes/Primitive.hs+7−2

@@ -10,7 +10,9 @@ primitiveTypeConstructorMapping = map (\(name, aType) ->

10 ("Text", TextAtomType),

11 ("Double", DoubleAtomType),

12 ("Bool", BoolAtomType),

13− ("ByteString", ByteStringAtomType)

13+ ("ByteString", ByteStringAtomType),

14+ ("DateTime", DateTimeAtomType),

15+ ("Day", DayAtomType)

14 ]

16 ]

16intTypeConstructor :: TypeConstructor

18intTypeConstructor :: TypeConstructor

@@ -25,6 +27,9 @@ textTypeConstructor = PrimitiveTypeConstructor "Text" TextAtomType

25dayTypeConstructor :: TypeConstructor

27dayTypeConstructor :: TypeConstructor

26dayTypeConstructor = PrimitiveTypeConstructor "Day" DayAtomType

28dayTypeConstructor = PrimitiveTypeConstructor "Day" DayAtomType

30+dateTimeTypeConstructor :: TypeConstructor

31+dateTimeTypeConstructor = PrimitiveTypeConstructor "DateTime" DayAtomType

32+

28-- | Return the type of an 'Atom'.

33-- | Return the type of an 'Atom'.

29atomTypeForAtom :: Atom -> AtomType

34atomTypeForAtom :: Atom -> AtomType

30atomTypeForAtom (IntAtom _) = IntAtomType

35atomTypeForAtom (IntAtom _) = IntAtomType

@@ -35,6 +40,6 @@ atomTypeForAtom (DayAtom _) = DayAtomType

35atomTypeForAtom (DateTimeAtom _) = DateTimeAtomType

40atomTypeForAtom (DateTimeAtom _) = DateTimeAtomType

36atomTypeForAtom (ByteStringAtom _) = ByteStringAtomType

41atomTypeForAtom (ByteStringAtom _) = ByteStringAtomType

37atomTypeForAtom (BoolAtom _) = BoolAtomType

42atomTypeForAtom (BoolAtom _) = BoolAtomType

38−atomTypeForAtom (IntervalAtom a _ _ _) = IntervalAtomType (atomTypeForAtom a)

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

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

40atomTypeForAtom (ConstructedAtom _ aType _) = aType

44atomTypeForAtom (ConstructedAtom _ aType _) = aType

45+atomTypeForAtom (RelationalExprAtom _) = RelationalExprAtomType

src/lib/ProjectM36/DataTypes/Sorting.hsnew file+31

@@ -0,0 +1,31 @@

1+module ProjectM36.DataTypes.Sorting where

2+import ProjectM36.Base

4+compareAtoms :: Atom -> Atom -> Ordering

5+compareAtoms (IntegerAtom i1) (IntegerAtom i2) = compare i1 i2

6+compareAtoms (IntAtom i1) (IntAtom i2) = compare i1 i2

7+compareAtoms (DoubleAtom d1) (DoubleAtom d2) = compare d1 d2

8+compareAtoms (TextAtom t1) (TextAtom t2) = compare t1 t2

9+compareAtoms (DayAtom d1) (DayAtom d2) = compare d1 d2

10+compareAtoms (DateTimeAtom d1) (DateTimeAtom d2) = compare d1 d2

11+compareAtoms (ByteStringAtom b1) (ByteStringAtom b2) = compare b1 b2

12+compareAtoms (BoolAtom b1) (BoolAtom b2) = compare b1 b2

13+compareAtoms (RelationAtom _) _ = EQ

14+compareAtoms ConstructedAtom{} _ = EQ

15+compareAtoms _ _ = EQ

16+

17+isSortableAtomType :: AtomType -> Bool

18+isSortableAtomType typ = case typ of

19+ IntAtomType -> True

20+ IntegerAtomType -> True

21+ DoubleAtomType -> True

22+ TextAtomType -> True

23+ DayAtomType -> True

24+ DateTimeAtomType -> True

25+ ByteStringAtomType -> False

26+ BoolAtomType -> True

27+ RelationalExprAtomType -> False

28+ RelationAtomType _ -> False

29+ ConstructedAtomType _ _ -> False

30+ TypeVariableType _ -> False

31+

src/lib/ProjectM36/DatabaseContext.hs+24−5

@@ -1,11 +1,15 @@

1module ProjectM36.DatabaseContext where

2import ProjectM36.Base

3+import Control.Monad (void)

3import qualified Data.Map as M

4import qualified Data.Map as M

4import qualified Data.HashSet as HS

5import qualified Data.HashSet as HS

5import ProjectM36.DataTypes.Basic

6import ProjectM36.DataTypes.Basic

6import ProjectM36.AtomFunctions.Basic

7import ProjectM36.AtomFunctions.Basic

7−import ProjectM36.DatabaseContextFunction

8import ProjectM36.Relation

9+import qualified Data.ByteString.Lazy as BL

10+import ProjectM36.AtomFunction as AF

11+import ProjectM36.DatabaseContextFunction as DBCF

12+import Codec.Winery

10empty :: DatabaseContext

14empty :: DatabaseContext

11empty = DatabaseContext { inclusionDependencies = M.empty,

15empty = DatabaseContext { inclusionDependencies = M.empty,

@@ -14,22 +18,37 @@ empty = DatabaseContext { inclusionDependencies = M.empty,

14 atomFunctions = HS.empty,

18 atomFunctions = HS.empty,

15 dbcFunctions = HS.empty,

19 dbcFunctions = HS.empty,

16 typeConstructorMapping = [] }

20 typeConstructorMapping = [] }

21+

22+-- | Remove TransactionId markers on GraphRefRelationalExpr

23+stripGraphRefRelationalExpr :: GraphRefRelationalExpr -> RelationalExpr

24+stripGraphRefRelationalExpr = void

18-- | convert an existing database context into its constituent expression.

26-- | convert an existing database context into its constituent expression.

19databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr

27databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr

20databaseContextAsDatabaseContextExpr context = MultipleExpr $ relVarsExprs ++ incDepsExprs ++ funcsExprs

28databaseContextAsDatabaseContextExpr context = MultipleExpr $ relVarsExprs ++ incDepsExprs ++ funcsExprs

21 where

29 where

22− relVarsExprs = map (\(name, rel) -> Assign name (ExistingRelation rel)) (M.toList (relationVariables context))

30+ relVarsExprs = map (\(name, rel) -> Assign name (stripGraphRefRelationalExpr rel)) (M.toList (relationVariables context))

23 incDepsExprs :: [DatabaseContextExpr]

31 incDepsExprs :: [DatabaseContextExpr]

24 incDepsExprs = map (uncurry AddInclusionDependency) (M.toList (inclusionDependencies context))

32 incDepsExprs = map (uncurry AddInclusionDependency) (M.toList (inclusionDependencies context))

25− funcsExprs = [] -- map (\func -> ) (HS.toList funcs) -- there are no databaseExprs to add atom functions yet

33+ funcsExprs = [] -- map (\func -> ) (HS.toList funcs) -- there are no databaseExprs to add atom functions yet-}

27basicDatabaseContext :: DatabaseContext

35basicDatabaseContext :: DatabaseContext

28basicDatabaseContext = DatabaseContext { inclusionDependencies = M.empty,

36basicDatabaseContext = DatabaseContext { inclusionDependencies = M.empty,

29− relationVariables = M.fromList [("true", relationTrue),

37+ relationVariables = M.fromList [("true", ExistingRelation relationTrue),

30− ("false", relationFalse)],

38+ ("false", ExistingRelation relationFalse)],

31 atomFunctions = basicAtomFunctions,

39 atomFunctions = basicAtomFunctions,

32 dbcFunctions = basicDatabaseContextFunctions,

40 dbcFunctions = basicDatabaseContextFunctions,

33 notifications = M.empty,

41 notifications = M.empty,

34 typeConstructorMapping = basicTypeConstructorMapping

42 typeConstructorMapping = basicTypeConstructorMapping

35 }

43 }

44+

45+--for building the Merkle hash

46+hashBytes :: DatabaseContext -> BL.ByteString

47+hashBytes ctx = BL.fromChunks [incDeps, rvs, nots, tConsMap] <> atomFs <> dbcFs

48+ where

49+ incDeps = serialise (inclusionDependencies ctx)

50+ rvs = serialise (relationVariables ctx)

51+ atomFs = HS.foldr (mappend . AF.hashBytes) mempty (atomFunctions ctx)

52+ dbcFs = HS.foldr (mappend . DBCF.hashBytes) mempty (dbcFunctions ctx)

53+ nots = serialise (notifications ctx)

54+ tConsMap = serialise (typeConstructorMapping ctx)

src/lib/ProjectM36/DatabaseContextFunction.hs+36−1

@@ -1,9 +1,18 @@

1+{-# LANGUAGE CPP #-}

1module ProjectM36.DatabaseContextFunction where

2module ProjectM36.DatabaseContextFunction where

2--implements functions which operate as: [Atom] -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr

3--implements functions which operate as: [Atom] -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr

3import ProjectM36.Base

4import ProjectM36.Base

4import ProjectM36.Error

5import ProjectM36.Error

6+import ProjectM36.Serialise.Base ()

7+import ProjectM36.Attribute as A

8+import ProjectM36.Relation

9+import ProjectM36.AtomType

5import qualified Data.HashSet as HS

10import qualified Data.HashSet as HS

6import qualified Data.Map as M

11import qualified Data.Map as M

12+import ProjectM36.ScriptSession

13+import qualified Data.Text as T

14+import qualified Data.ByteString.Lazy as BL

15+import Codec.Winery

8emptyDatabaseContextFunction :: DatabaseContextFunctionName -> DatabaseContextFunction

17emptyDatabaseContextFunction :: DatabaseContextFunctionName -> DatabaseContextFunction

9emptyDatabaseContextFunction name = DatabaseContextFunction {

18emptyDatabaseContextFunction name = DatabaseContextFunction {

@@ -53,4 +62,30 @@ databaseContextFunctionReturnType tCons = ADTypeConstructor "Either" [

53 tCons]

62 tCons]

55createScriptedDatabaseContextFunction :: DatabaseContextFunctionName -> [TypeConstructor] -> TypeConstructor -> DatabaseContextFunctionBodyScript -> DatabaseContextIOExpr

64createScriptedDatabaseContextFunction :: DatabaseContextFunctionName -> [TypeConstructor] -> TypeConstructor -> DatabaseContextFunctionBodyScript -> DatabaseContextIOExpr

56−createScriptedDatabaseContextFunction funcName argsIn retArg = AddDatabaseContextFunction funcName (argsIn ++ [databaseContextFunctionReturnType retArg])

65+createScriptedDatabaseContextFunction funcName argsIn retArg = AddDatabaseContextFunction funcName (argsIn ++ [databaseContextFunctionReturnType retArg])

66+

67+loadDatabaseContextFunctions :: ModName -> FuncName -> FilePath -> IO (Either LoadSymbolError [DatabaseContextFunction])

68+#ifdef PM36_HASKELL_SCRIPTING

69+loadDatabaseContextFunctions = loadFunction

70+#else

71+loadDatabaseContextFunctions _ _ _ = pure (Left LoadSymbolError)

72+#endif

73+

74+databaseContextFunctionsAsRelation :: DatabaseContextFunctions -> Either RelationalError Relation

75+databaseContextFunctionsAsRelation dbcFuncs = mkRelationFromList attrs tups

76+ where

77+ attrs = A.attributesFromList [Attribute "name" TextAtomType,

78+ Attribute "arguments" TextAtomType]

79+ tups = map dbcFuncToTuple (HS.toList dbcFuncs)

80+ dbcFuncToTuple func = [TextAtom (dbcFuncName func),

81+ TextAtom (dbcTextType (dbcFuncType func))]

82+ dbcTextType typ = T.intercalate " -> " (map prettyAtomType typ ++ ["DatabaseContext", "DatabaseContext"])

83+

84+-- for merkle hash

85+hashBytes :: DatabaseContextFunction -> BL.ByteString

86+hashBytes func = BL.fromChunks [fname, ftype, fbody]

87+ where

88+ fname = serialise (dbcFuncName func)

89+ ftype = serialise (dbcFuncType func)

90+ fbody = case dbcFuncBody func of

91+ DatabaseContextFunctionBody mBody _ -> serialise mBody

src/lib/ProjectM36/DatabaseContextFunctionError.hs+1−2

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

1{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}

2module ProjectM36.DatabaseContextFunctionError where

3import GHC.Generics

4−import Data.Binary

5import Control.DeepSeq

4import Control.DeepSeq

7{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}

6{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}

8data DatabaseContextFunctionError = DatabaseContextFunctionUserError String

7data DatabaseContextFunctionError = DatabaseContextFunctionUserError String

9− deriving (Generic, Eq, Show, Binary, NFData)

8+ deriving (Generic, Eq, Show, NFData)

src/lib/ProjectM36/DatabaseContextFunctionUtils.hs+15−8

@@ -3,13 +3,20 @@ import ProjectM36.RelationalExpression

3import ProjectM36.Base

4import ProjectM36.DatabaseContextFunctionError

5import ProjectM36.Error

6−import Control.Monad.State

6+import ProjectM36.StaticOptimizer

7−import Control.Monad.Trans.Reader

9−executeDatabaseContextExpr :: DatabaseContextExpr -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext

8+executeDatabaseContextExpr :: DatabaseContextExpr -> TransactionId -> TransactionGraph -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext

10−executeDatabaseContextExpr expr context = case runState (evalDatabaseContextExpr expr) (freshDatabaseState context) of

9+executeDatabaseContextExpr expr transId graph context' =

11− (Nothing, (context', _, _)) -> pure context'

10+ case run of

11+ Right st -> pure (dbc_context st)

12− (Just err, _) -> error (show err)

12+ Left err -> error (show err)

13+ where

14+ env = mkDatabaseContextEvalEnv transId graph

15+ run = runDatabaseContextEvalMonad context' env (optimizeAndEvalDatabaseContextExpr True expr)

14−executeRelationalExpr :: RelationalExpr -> DatabaseContext -> Either RelationalError Relation

17+executeRelationalExpr :: RelationalExpr -> DatabaseContext -> TransactionGraph -> Either RelationalError Relation

15−executeRelationalExpr expr context = runReader (evalRelationalExpr expr) (mkRelationalExprState context)

18+executeRelationalExpr expr context graph =

19+ run

20+ where

21+ env = mkRelationalExprEnv context graph

22+ run = optimizeAndEvalRelationalExpr env expr

src/lib/ProjectM36/DateExamples.hs+10−7

@@ -16,16 +16,19 @@ dateExamples = empty { inclusionDependencies = dateIncDeps,

16 atomFunctions = basicAtomFunctions,

17 typeConstructorMapping = basicTypeConstructorMapping }

18 where -- these must be lower case now that data constructors are in play

19− dateRelVars = M.fromList [("s", suppliers),

19+ dateRelVars = M.fromList [("s", ExistingRelation suppliers),

20− ("p", products),

20+ ("p", ExistingRelation products),

21− ("sp", supplierProducts)]

21+ ("sp", ExistingRelation supplierProducts)]

22 suppliers = suppliersRel

23 products = productsRel

24 supplierProducts = supplierProductsRel

25− dateIncDeps = M.fromList [("s_pkey", simplePKey ["s#"] "s"),

25+ dateIncDeps = M.fromList [

26+ ("s_pkey", simplePKey ["s#"] "s"),

26− ("p_pkey", simplePKey ["p#"] "p"),

27+ ("p_pkey", simplePKey ["p#"] "p"),

27− ("sp_pkey", simplePKey ["s#", "p#"] "sp")

28+ ("sp_pkey", simplePKey ["s#", "p#"] "sp"),

29+ ("s_sp_fk", inclusionDependencyForForeignKey ("sp", ["s#"]) ("s", ["s#"])),

30+ ("p_sp_fk", inclusionDependencyForForeignKey ("sp", ["p#"]) ("p", ["p#"]))

28− ]

31+ ]

29 simplePKey attrNames relvarName = inclusionDependencyForKey (AttributeNames $ S.fromList attrNames) (RelationVariable relvarName ())

32 simplePKey attrNames relvarName = inclusionDependencyForKey (AttributeNames $ S.fromList attrNames) (RelationVariable relvarName ())

31suppliersRel :: Relation

34suppliersRel :: Relation

src/lib/ProjectM36/DisconnectedTransaction.hs+7−1

@@ -8,4 +8,10 @@ schemas :: DisconnectedTransaction -> Schemas

8schemas (DisconnectedTransaction _ s _) = s

10parentId :: DisconnectedTransaction -> TransactionId

11−parentId (DisconnectedTransaction pid _ _) = pid

11+parentId (DisconnectedTransaction pid _ _) = pid

12+

13+isDirty :: DisconnectedTransaction -> Bool

14+isDirty (DisconnectedTransaction _ _ flag) = flag

15+

16+freshTransaction :: TransactionId -> Schemas -> DisconnectedTransaction

17+freshTransaction tid schemas' = DisconnectedTransaction tid schemas' False

src/lib/ProjectM36/Error.hs+29−15

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

1{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}

2module ProjectM36.Error where

3import ProjectM36.Base

4+import ProjectM36.MerkleHash

4import ProjectM36.DatabaseContextFunctionError

5import ProjectM36.DatabaseContextFunctionError

5import ProjectM36.AtomFunctionError

6import ProjectM36.AtomFunctionError

6import qualified Data.Set as S

7import qualified Data.Set as S

@@ -8,12 +9,13 @@ import Control.DeepSeq (NFData, rnf)

8import Control.DeepSeq.Generics (genericRnf)

9import Control.DeepSeq.Generics (genericRnf)

9import GHC.Generics (Generic)

10import GHC.Generics (Generic)

10import qualified Data.Text as T

11import qualified Data.Text as T

11−import Data.Binary

12import Data.Typeable

13import Control.Exception

15data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

16 | TupleAttributeCountMismatchError Int --attribute name

17+ | EmptyAttributesError

18+ | DuplicateAttributeNamesError (S.Set AttributeName)

17 | TupleAttributeTypeMismatchError Attributes

19 | TupleAttributeTypeMismatchError Attributes

18 | AttributeCountMismatchError Int

20 | AttributeCountMismatchError Int

19 | AttributeNamesMismatchError (S.Set AttributeName)

21 | AttributeNamesMismatchError (S.Set AttributeName)

@@ -22,7 +24,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

22 | CouldNotInferAttributes

24 | CouldNotInferAttributes

23 | RelVarNotDefinedError RelVarName

25 | RelVarNotDefinedError RelVarName

24 | RelVarAlreadyDefinedError RelVarName

26 | RelVarAlreadyDefinedError RelVarName

25− | RelVarAssignmentTypeMismatchError Attributes Attributes --expected, found

27+ | RelationTypeMismatchError Attributes Attributes --expected, found

26 | InclusionDependencyCheckError IncDepName

28 | InclusionDependencyCheckError IncDepName

27 | InclusionDependencyNameInUseError IncDepName

29 | InclusionDependencyNameInUseError IncDepName

28 | InclusionDependencyNameNotInUseError IncDepName

30 | InclusionDependencyNameNotInUseError IncDepName

@@ -60,6 +62,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

60 | AtomTypeNameInUseError AtomTypeName

62 | AtomTypeNameInUseError AtomTypeName

61 | IncompletelyDefinedAtomTypeWithConstructorError

63 | IncompletelyDefinedAtomTypeWithConstructorError

62 | AtomTypeNameNotInUseError AtomTypeName

64 | AtomTypeNameNotInUseError AtomTypeName

65+ | AttributeNotSortableError Attribute

63 | FunctionNameInUseError AtomFunctionName

66 | FunctionNameInUseError AtomFunctionName

64 | FunctionNameNotInUseError AtomFunctionName

67 | FunctionNameNotInUseError AtomFunctionName

65 | EmptyCommitError

68 | EmptyCommitError

@@ -78,11 +81,12 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

78 | RelationValuedAttributesNotSupportedError [AttributeName]

81 | RelationValuedAttributesNotSupportedError [AttributeName]

79 | NotificationNameInUseError NotificationName

82 | NotificationNameInUseError NotificationName

80 | NotificationNameNotInUseError NotificationName

83 | NotificationNameNotInUseError NotificationName

81− | ImportError T.Text -- really? This should be broken out into some other error type- this has nothing to do with relational algebra

84+ | ImportError ImportError'

82 | ExportError T.Text

85 | ExportError T.Text

83 | UnhandledExceptionError String

86 | UnhandledExceptionError String

84 | MergeTransactionError MergeError

87 | MergeTransactionError MergeError

85 | ScriptError ScriptCompilationError

88 | ScriptError ScriptCompilationError

89+ | LoadFunctionError

86 | DatabaseContextFunctionUserError DatabaseContextFunctionError

90 | DatabaseContextFunctionUserError DatabaseContextFunctionError

87 | DatabaseLoadError PersistenceError

91 | DatabaseLoadError PersistenceError

@@ -92,14 +96,21 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

92 | SchemaCreationError SchemaError

96 | SchemaCreationError SchemaError

94 | ImproperDatabaseStateError

98 | ImproperDatabaseStateError

95−

99+

100+ | NonConcreteSchemaPlanError

101+

102+ | NoUncommittedContextInEvalError

103+ | TupleExprsReferenceMultipleMarkersError

104+

105+ | MerkleHashValidationError TransactionId MerkleHash MerkleHash

106+

96 | MultipleErrors [RelationalError]

107 | MultipleErrors [RelationalError]

97− deriving (Show,Eq,Generic,Binary,Typeable, NFData)

108+ deriving (Show,Eq,Generic,Typeable, NFData)

109

99data PersistenceError = InvalidDirectoryError FilePath |

110data PersistenceError = InvalidDirectoryError FilePath |

100 MissingTransactionError TransactionId |

111 MissingTransactionError TransactionId |

101 WrongDatabaseFormatVersionError String String

112 WrongDatabaseFormatVersionError String String

102− deriving (Show, Eq, Generic, Binary, NFData)

113+ deriving (Show, Eq, Generic, NFData)

103

114

104--collapse list of errors into normal error- if there is just one, just return one

115--collapse list of errors into normal error- if there is just one, just return one

105someErrors :: [RelationalError] -> RelationalError

116someErrors :: [RelationalError] -> RelationalError

@@ -117,7 +128,7 @@ data MergeError = SelectedHeadMismatchMergeError |

117 StrategyViolatesComponentMergeError | --failed merge in inc deps, relvars, etc.

128 StrategyViolatesComponentMergeError | --failed merge in inc deps, relvars, etc.

118 StrategyViolatesRelationVariableMergeError |

129 StrategyViolatesRelationVariableMergeError |

119 StrategyViolatesTypeConstructorMergeError

130 StrategyViolatesTypeConstructorMergeError

120− deriving (Show, Eq, Generic, Binary, Typeable)

131+ deriving (Show, Eq, Generic, Typeable)

121

132

122instance NFData MergeError where rnf = genericRnf

133instance NFData MergeError where rnf = genericRnf

123

134

@@ -125,17 +136,20 @@ data ScriptCompilationError = TypeCheckCompilationError String String | --expect

125 SyntaxErrorCompilationError String |

136 SyntaxErrorCompilationError String |

126 ScriptCompilationDisabledError |

137 ScriptCompilationDisabledError |

127 OtherScriptCompilationError String

138 OtherScriptCompilationError String

128− deriving (Show, Eq, Generic, Binary, Typeable, NFData)

139+ deriving (Show, Eq, Generic, Typeable, NFData)

129

140

130instance Exception ScriptCompilationError

141instance Exception ScriptCompilationError

131

142

132data SchemaError = RelVarReferencesMissing (S.Set RelVarName) |

143data SchemaError = RelVarReferencesMissing (S.Set RelVarName) |

133 RelVarInReferencedMoreThanOnce RelVarName |

144 RelVarInReferencedMoreThanOnce RelVarName |

134 RelVarOutReferencedMoreThanOnce RelVarName

145 RelVarOutReferencedMoreThanOnce RelVarName

135− deriving (Show, Eq, Generic, Binary, Typeable, NFData)

146+ deriving (Show, Eq, Generic, Typeable, NFData)

136−

147+

137−

148+

138−-- errors returned from the distributed-process call handlers

149+data ImportError' = InvalidSHA256Error T.Text

139−data ServerError = RequestTimeoutError |

150+ | SHA256MismatchError T.Text T.Text

140− ProcessDiedError String

151+ | InvalidFileURIError T.Text

152+ | ImportFileDecodeError T.Text

153+ | ImportFileError T.Text

154+ | ImportDownloadError T.Text

141− deriving (Generic, Binary, Eq)

155+ deriving (Show, Eq, Generic, Typeable, NFData)

src/lib/ProjectM36/FSType.hs+4

@@ -45,6 +45,10 @@ fsTypeSupportsJournaling path = do

45 pure (fsFlags .&. FILE_SUPPORTS_USN_JOURNAL /= 0)

47#elif darwin_HOST_OS

48+import Foreign.C.Error

49+import Foreign.C.String

50+import Foreign.C.Types

51+

48--Darwin reports journaling directly in the fs flags

52--Darwin reports journaling directly in the fs flags

50type CStatFS = ()

54type CStatFS = ()

src/lib/ProjectM36/FileLock.hs+8−19

@@ -1,12 +1,10 @@

1−{-# LANGUAGE CPP, NamedFieldPuns #-}

1+{-# LANGUAGE CPP #-}

2--cross-platform file locking utilizing POSIX file locking on Unix/Linux and Windows file locking

3--hackage's System.FileLock doesn't support POSIX advisory locks nor locking file based on file descriptors, hence this needless rewrite

4module ProjectM36.FileLock where

5−import System.IO

8#if defined(mingw32_HOST_OS)

7#if defined(mingw32_HOST_OS)

9−import ProjectM36.Win32Handle

10import System.Win32.Types

8import System.Win32.Types

11import Foreign.Marshal.Alloc

9import Foreign.Marshal.Alloc

12import System.Win32.File

10import System.Win32.File

@@ -30,14 +28,13 @@ openLockFile :: FilePath -> IO LockFile

30openLockFile path = createFile path

28openLockFile path = createFile path

31 (gENERIC_READ .|. gENERIC_WRITE)

29 (gENERIC_READ .|. gENERIC_WRITE)

32 (fILE_SHARE_READ .|. fILE_SHARE_WRITE)

30 (fILE_SHARE_READ .|. fILE_SHARE_WRITE)

33− nullPtr

31+ Nothing

34 oPEN_ALWAYS

32 oPEN_ALWAYS

35 fILE_ATTRIBUTE_NORMAL

33 fILE_ATTRIBUTE_NORMAL

36− nullPtr

34+ Nothing

38closeLockFile :: LockFile -> IO ()

36closeLockFile :: LockFile -> IO ()

39closeLockFile file = do

37closeLockFile file = do

40− unlockFile file

41 closeHandle file

38 closeHandle file

43--swiped from System.FileLock package

40--swiped from System.FileLock package

@@ -51,28 +48,21 @@ lockFile winHandle lock = do

52 allocaBytes sizeof_OVERLAPPED $ \op -> do

49 allocaBytes sizeof_OVERLAPPED $ \op -> do

53 zeroMemory op $ fromIntegral sizeof_OVERLAPPED

50 zeroMemory op $ fromIntegral sizeof_OVERLAPPED

54− res <- c_lockFileEx winHandle (exFlag .|. blockFlag) 0 1 0 op

51+ failIfFalse_ "LockFileEx" $ c_lockFileEx winHandle (exFlag .|. blockFlag) 0 1 0 op

55− if res then

56− pure ()

57− else

58− error "failed to wait for database lock"

60unlockFile :: HANDLE -> IO ()

53unlockFile :: HANDLE -> IO ()

61unlockFile winHandle = do

54unlockFile winHandle = do

62 let sizeof_OVERLAPPED = 32

55 let sizeof_OVERLAPPED = 32

63 allocaBytes sizeof_OVERLAPPED $ \op -> do

56 allocaBytes sizeof_OVERLAPPED $ \op -> do

64 zeroMemory op $ fromIntegral sizeof_OVERLAPPED

57 zeroMemory op $ fromIntegral sizeof_OVERLAPPED

65− res <- c_unlockFileEx winHandle 0 1 0 op

58+ failIfFalse_ "UnlockFileEx" $ c_unlockFileEx winHandle 0 1 0 op

66− if res then

67− pure ()

68− else

69− error ("failed to unlock database lock: " ++ show res)

71#else

60#else

72--all of this complicated nonsense is fixed if we switch to GHC 8.2 which includes native flock support on handles

61--all of this complicated nonsense is fixed if we switch to GHC 8.2 which includes native flock support on handles

73import qualified System.Posix.IO as P

62import qualified System.Posix.IO as P

74import System.Posix.Types

63import System.Posix.Types

75import System.Posix.Files

64import System.Posix.Files

65+import System.IO

77lockStruct :: P.LockRequest -> P.FileLock

67lockStruct :: P.LockRequest -> P.FileLock

78lockStruct req = (req, AbsoluteSeek, 0, 0)

68lockStruct req = (req, AbsoluteSeek, 0, 0)

@@ -85,8 +75,7 @@ openLockFile path =

85 LockFile <$> P.createFile path ownerWriteMode

75 LockFile <$> P.createFile path ownerWriteMode

87closeLockFile :: LockFile -> IO ()

77closeLockFile :: LockFile -> IO ()

88−closeLockFile l@(LockFile fd) = do

78+closeLockFile (LockFile fd) =

89− unlockFile l

90 P.closeFd fd

79 P.closeFd fd

92--blocks on lock, if necessary

81--blocks on lock, if necessary

@@ -102,6 +91,6 @@ unlockFile (LockFile fd) =

102 P.waitToSetLock fd (lockStruct P.Unlock)

91 P.waitToSetLock fd (lockStruct P.Unlock)

103#endif

92#endif

104

105−data LockType = ReadLock | WriteLock

94+data LockType = ReadLock | WriteLock deriving (Show)

106

107

src/lib/ProjectM36/GraphRefRelationalExpr.hsnew file+45

@@ -0,0 +1,45 @@

1+module ProjectM36.GraphRefRelationalExpr where

2+--evaluate relational expressions across the entire transaction graph to support cross-transaction referencing

3+import ProjectM36.Base

4+import qualified Data.Set as S

6+--import Debug.Trace

8+data SingularTransactionRef = SingularTransactionRef GraphRefTransactionMarker |

9+ MultipleTransactionsRef |

10+ NoTransactionsRef

11+ deriving (Eq, Show)

12+

13+instance Semigroup SingularTransactionRef where

14+ NoTransactionsRef <> x = x

15+ MultipleTransactionsRef <> _ = MultipleTransactionsRef

16+ SingularTransactionRef tidA <> s@(SingularTransactionRef tidB) =

17+ if tidA == tidB then

18+ s

19+ else

20+ MultipleTransactionsRef

21+ s@SingularTransactionRef{} <> NoTransactionsRef = s

22+ _ <> MultipleTransactionsRef = MultipleTransactionsRef

23+

24+instance Monoid SingularTransactionRef where

25+ mempty = NoTransactionsRef

26+

27+-- | return `Just transid` if this GraphRefRelationalExpr refers to just one transaction in the graph. This is useful for determining if certain optimizations can apply.

28+singularTransaction :: Foldable t => t GraphRefTransactionMarker -> SingularTransactionRef

29+singularTransaction expr

30+ | S.null transSet = NoTransactionsRef

31+ | S.size transSet == 1 = SingularTransactionRef (head (S.toList transSet))

32+ | otherwise = MultipleTransactionsRef

33+ where

34+ transSet = foldr S.insert S.empty expr

35+

36+-- | Return True if two 'GraphRefRelationalExpr's both refer exclusively to the same transaction (or none at all).

37+inSameTransaction :: GraphRefRelationalExpr -> GraphRefRelationalExpr -> Maybe GraphRefTransactionMarker

38+inSameTransaction exprA exprB = case (stA, stB) of

39+ (SingularTransactionRef tA, SingularTransactionRef tB) | tA == tB -> Just tA

40+ _ -> Nothing

41+ where stA = singularTransaction exprA

42+ stB = singularTransaction exprB

43+

44+singularTransactions :: (Foldable f, Foldable t) => f (t GraphRefTransactionMarker) -> SingularTransactionRef

45+singularTransactions = foldMap singularTransaction

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

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

4import ProjectM36.Error

5import ProjectM36.Relation

6import qualified Data.Map as M

7−import qualified Data.Text as T

9inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation

8inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation

10inclusionDependenciesAsRelation incDeps =

9inclusionDependenciesAsRelation incDeps =

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

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

12 where

11 where

13 attrs = attributesFromList [Attribute "name" TextAtomType,

12 attrs = attributesFromList [Attribute "name" TextAtomType,

14− Attribute "sub" TextAtomType,

13+ Attribute "sub" RelationalExprAtomType,

15− Attribute "super" TextAtomType

14+ Attribute "super" RelationalExprAtomType

16 ]

15 ]

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

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

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

17+ RelationalExprAtom exprA,

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

18+ RelationalExprAtom exprB]

20−

19+

src/lib/ProjectM36/IsomorphicSchema.hs+37−40

@@ -1,22 +1,20 @@

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

1+{-# LANGUAGE DeriveGeneric, LambdaCase, DerivingVia #-}

2module ProjectM36.IsomorphicSchema where

3import ProjectM36.Base

4import ProjectM36.Error

5import ProjectM36.MiscUtils

6−import ProjectM36.RelationalExpression

7import ProjectM36.Relation

6import ProjectM36.Relation

7+import ProjectM36.NormalizeExpr

8+import ProjectM36.RelationalExpression

8import qualified ProjectM36.AttributeNames as AN

9import qualified ProjectM36.AttributeNames as AN

9import Control.Monad

10import Control.Monad

10−import Control.Monad.State

11−import Control.Monad.Trans.Reader

12import GHC.Generics

11import GHC.Generics

13−import Data.Binary

14import qualified Data.Map as M

12import qualified Data.Map as M

15import qualified Data.Set as S

13import qualified Data.Set as S

16import qualified Data.List as L

14import qualified Data.List as L

17−import qualified Data.Text as T

15+#if __GLASGOW_HASKELL__ < 804

18import Data.Monoid

16import Data.Monoid

19−--import Debug.Trace

17+#endif

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

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

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

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

@@ -29,8 +27,7 @@ import Data.Monoid

30data SchemaExpr = AddSubschema SchemaName SchemaIsomorphs |

28data SchemaExpr = AddSubschema SchemaName SchemaIsomorphs |

31 RemoveSubschema SchemaName

29 RemoveSubschema SchemaName

32− deriving (Generic, Binary, Show)

30+ deriving (Generic, Show)

33−

35isomorphs :: Schema -> SchemaIsomorphs

32isomorphs :: Schema -> SchemaIsomorphs

36isomorphs (Schema i) = i

33isomorphs (Schema i) = i

@@ -82,9 +79,9 @@ isomorphsOutRelVarNames morphs = S.fromList (foldr rvnames [] morphs)

83-- | Check that all mentioned relvars are actually present in the current schema.

80-- | Check that all mentioned relvars are actually present in the current schema.

84validateRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError ()

81validateRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError ()

85−validateRelationalExprInSchema schema relExprIn = relExprMogrify (\expr -> case expr of

82+validateRelationalExprInSchema schema relExprIn = relExprMogrify (\case

86− RelationVariable rv () | S.notMember rv validRelVarNames -> Left (RelVarNotDefinedError rv)

83+ RelationVariable rv () | S.notMember rv validRelVarNames -> Left (RelVarNotDefinedError rv)

87− ex -> Right ex) relExprIn >> pure ()

84+ ex -> Right ex) relExprIn >> pure ()

88 where

85 where

89 validRelVarNames = isomorphsInRelVarNames (isomorphs schema)

86 validRelVarNames = isomorphsInRelVarNames (isomorphs schema)

@@ -133,16 +130,16 @@ applySchemaToInclusionDependencies (Schema morphs) incDeps =

133

130

134-- | Morph a relational expression in one schema to another isomorphic schema.

131-- | Morph a relational expression in one schema to another isomorphic schema.

135relExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr)

132relExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr)

136−relExprMorph (IsoRestrict relIn _ (relOutTrue, relOutFalse)) = \expr -> case expr of

133+relExprMorph (IsoRestrict relIn _ (relOutTrue, relOutFalse)) = \case

137 RelationVariable rv () | rv == relIn -> Right (Union (RelationVariable relOutTrue ()) (RelationVariable relOutFalse ()))

134 RelationVariable rv () | rv == relIn -> Right (Union (RelationVariable relOutTrue ()) (RelationVariable relOutFalse ()))

138 orig -> Right orig

135 orig -> Right orig

139−relExprMorph (IsoUnion (relInT, relInF) predi relTarget) = \expr -> case expr of

136+relExprMorph (IsoUnion (relInT, relInF) predi relTarget) = \case

140 --only the true predicate portion appears in the virtual schema

137 --only the true predicate portion appears in the virtual schema

141 RelationVariable rv () | rv == relInT -> Right (Restrict predi (RelationVariable relTarget ()))

138 RelationVariable rv () | rv == relInT -> Right (Restrict predi (RelationVariable relTarget ()))

142

139

143 RelationVariable rv () | rv == relInF -> Right (Restrict (NotPredicate predi) (RelationVariable relTarget ()))

140 RelationVariable rv () | rv == relInF -> Right (Restrict (NotPredicate predi) (RelationVariable relTarget ()))

144 orig -> Right orig

141 orig -> Right orig

145−relExprMorph (IsoRename relIn relOut) = \expr -> case expr of

142+relExprMorph (IsoRename relIn relOut) = \case

146 RelationVariable rv () | rv == relIn -> Right (RelationVariable relOut ())

143 RelationVariable rv () | rv == relIn -> Right (RelationVariable relOut ())

147 orig -> Right orig

144 orig -> Right orig

148

145

@@ -254,17 +251,17 @@ inclusionDependencyInSchema schema (InclusionDependency rexprA rexprB) = do

254-- also, it's inverse to IsoRestrict which adds two constraints at the base level

251-- also, it's inverse to IsoRestrict which adds two constraints at the base level

255-- for IsoRestrict, consider hiding the two, generated constraints since they can never be thrown in the isomorphic schema

252-- for IsoRestrict, consider hiding the two, generated constraints since they can never be thrown in the isomorphic schema

256inclusionDependenciesInSchema :: Schema -> InclusionDependencies -> Either RelationalError InclusionDependencies

253inclusionDependenciesInSchema :: Schema -> InclusionDependencies -> Either RelationalError InclusionDependencies

257−inclusionDependenciesInSchema schema incDeps = mapM (\(depName, dep) -> inclusionDependencyInSchema schema dep >>= \newDep -> pure (depName, newDep)) (M.toList incDeps) >>= pure . M.fromList

254+inclusionDependenciesInSchema schema incDeps = M.fromList <$> mapM (\(depName, dep) -> inclusionDependencyInSchema schema dep >>= \newDep -> pure (depName, newDep)) (M.toList incDeps)

258

255

259−relationVariablesInSchema :: Schema -> DatabaseContext -> Either RelationalError RelationVariables

256+relationVariablesInSchema :: Schema -> Either RelationalError RelationVariables

260−relationVariablesInSchema schema@(Schema morphs) context = foldM transform M.empty morphs

257+relationVariablesInSchema schema@(Schema morphs) = foldM transform M.empty morphs

261 where

258 where

262 transform newRvMap morph = do

259 transform newRvMap morph = do

263 let rvNames = isomorphInRelVarNames morph

260 let rvNames = isomorphInRelVarNames morph

264 rvAssocs <- mapM (\rv -> do

261 rvAssocs <- mapM (\rv -> do

265 expr' <- processRelationalExprInSchema schema (RelationVariable rv ())

262 expr' <- processRelationalExprInSchema schema (RelationVariable rv ())

266− rel <- runReader (evalRelationalExpr expr') (RelationalExprStateElems context)

263+ let gfExpr = runProcessExprM UncommittedContextMarker (processRelationalExpr expr')

267− pure (rv, rel)) rvNames

264+ pure (rv, gfExpr)) rvNames

268 pure (M.union newRvMap (M.fromList rvAssocs))

265 pure (M.union newRvMap (M.fromList rvAssocs))

269

266

270

267

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

304

301

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

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

306createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies

303createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies

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

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

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

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

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

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

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

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

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

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

312createIncDepsForIsomorph _ _ = M.empty

309createIncDepsForIsomorph _ _ = M.empty

313

310

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

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

315−evalSchemaExpr :: SchemaExpr -> DatabaseContext -> Subschemas -> Either RelationalError (Subschemas, DatabaseContext)

312+evalSchemaExpr :: SchemaExpr -> DatabaseContext -> TransactionId -> TransactionGraph -> Subschemas -> Either RelationalError (Subschemas, DatabaseContext)

316−evalSchemaExpr (AddSubschema sname morphs) context sschemas =

313+evalSchemaExpr (AddSubschema sname morphs) context transId graph sschemas =

317 if M.member sname sschemas then

314 if M.member sname sschemas then

318 Left (SubschemaNameInUseError sname)

315 Left (SubschemaNameInUseError sname)

319− else case valid of

316+ else

317+ case validateSchema (Schema morphs) context of

320− Just err -> Left (SchemaCreationError err)

318+ Just err -> Left (SchemaCreationError err)

321− Nothing ->

319+ Nothing -> do

322− let newSchemas = M.insert sname newSchema sschemas

320+ let newSchemas = M.insert sname newSchema sschemas

321+ newSchema = Schema morphs

323− moreIncDeps = foldr (\morph acc -> M.union acc (createIncDepsForIsomorph sname morph)) M.empty morphs

322+ moreIncDeps = foldr (\morph acc -> M.union acc (createIncDepsForIsomorph sname morph)) M.empty morphs

324− incDepExprs = MultipleExpr (map (uncurry AddInclusionDependency) (M.toList moreIncDeps))

323+ incDepExprs = MultipleExpr (map (uncurry AddInclusionDependency) (M.toList moreIncDeps))

325− in

324+ dbenv = mkDatabaseContextEvalEnv transId graph

326− case runState (evalDatabaseContextExpr incDepExprs) (context, M.empty, False) of

325+ dbstate <- runDatabaseContextEvalMonad context dbenv (evalGraphRefDatabaseContextExpr incDepExprs)

327− (Just err, _) -> Left err

326+ pure (newSchemas, dbc_context dbstate)

328− (Nothing, (newContext,_,_)) -> pure (newSchemas, newContext) --need to propagate dirty flag here

327+--need to propagate dirty flag here

329− where

328+

330− newSchema = Schema morphs

331− valid = validateSchema newSchema context

332−evalSchemaExpr (RemoveSubschema sname) context sschemas = if M.member sname sschemas then

329+evalSchemaExpr (RemoveSubschema sname) context _ _ sschemas = if M.member sname sschemas then

333 pure (M.delete sname sschemas, context)

330 pure (M.delete sname sschemas, context)

334 else

331 else

335 Left (SubschemaNameNotInUseError sname)

332 Left (SubschemaNameNotInUseError sname)

src/lib/ProjectM36/Key.hs+22−7

@@ -2,7 +2,9 @@ module ProjectM36.Key where

2import ProjectM36.Base

3import ProjectM36.Relation

4import qualified Data.Set as S

5+#if __GLASGOW_HASKELL__ < 804

5import Data.Monoid

6import Data.Monoid

7+#endif

7{-

9{-

8keys can be implemented using inclusion dependencies as well: the count of the projection of the keys' attributes must be equal to the count of the tuples- p. 120 Database in Depth

10keys can be implemented using inclusion dependencies as well: the count of the projection of the keys' attributes must be equal to the count of the tuples- p. 120 Database in Depth

@@ -39,16 +41,29 @@ databaseContextExprForUniqueKey rvName attrNames = AddInclusionDependency (rvNam

40-- | Create a foreign key constraint from the first relation variable and attributes to the second.

42-- | Create a foreign key constraint from the first relation variable and attributes to the second.

41databaseContextExprForForeignKey :: IncDepName -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> DatabaseContextExpr

43databaseContextExprForForeignKey :: IncDepName -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> DatabaseContextExpr

42−databaseContextExprForForeignKey fkName (rvA, attrsA) (rvB, attrsB) =

44+databaseContextExprForForeignKey fkName infoA infoB =

43− AddInclusionDependency fkName (InclusionDependency

45+ AddInclusionDependency fkName (inclusionDependencyForForeignKey infoA infoB)

46+

47+inclusionDependencyForForeignKey :: (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> InclusionDependency

48+inclusionDependencyForForeignKey (rvA, attrsA) (rvB, attrsB) =

49+ InclusionDependency (

44− (renameIfNecessary attrsB attrsA (Project (attrsL attrsA)

50+ renameIfNecessary attrsB attrsA (Project (attrsL attrsA)

45− (RelationVariable rvA ())))

51+ (RelationVariable rvA ()))) (

46− (Project (attrsL attrsB)

52+ Project (attrsL attrsB) (RelationVariable rvB ()))

47− (RelationVariable rvB ())))

48 where

53 where

49 attrsL = AttributeNames . S.fromList

54 attrsL = AttributeNames . S.fromList

50 renameIfNecessary attrsExpected attrsExisting expr = foldr folder expr (zip attrsExpected attrsExisting)

55 renameIfNecessary attrsExpected attrsExisting expr = foldr folder expr (zip attrsExpected attrsExisting)

51 folder (attrExpected, attrExisting) expr = if attrExpected == attrExisting then

56 folder (attrExpected, attrExisting) expr = if attrExpected == attrExisting then

52 expr

57 expr

53 else

58 else

54− Rename attrExisting attrExpected expr

59+ Rename attrExisting attrExpected expr

60+

61+-- if the constraint is a foreign key constraint, then return the relations and attributes involved - this only detects foreign keys created with `databaseContextExprForForeignKey`

62+isForeignKeyFor :: InclusionDependency -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> Bool

63+isForeignKeyFor incDep infoA infoB = incDep == checkIncDep

64+ where

65+ checkIncDep = inclusionDependencyForForeignKey infoA infoB

66+

67+

68+

69+

src/lib/ProjectM36/MerkleHash.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric, DerivingVia #-}

2+module ProjectM36.MerkleHash where

3+import Data.ByteString (ByteString)

4+import GHC.Generics

5+import Control.DeepSeq (NFData)

7+newtype MerkleHash = MerkleHash { _unMerkleHash :: ByteString }

8+ deriving (Show, Eq, Generic, Monoid, Semigroup, NFData)

src/lib/ProjectM36/MiscUtils.hs+6

@@ -7,3 +7,9 @@ dupes [_] = []

7dupes [x,y] = [x | x == y]

8dupes (x:y:xs) = dupes(x:[y]) ++ dupes(y : xs)

10+--Data.Vector.indexed but for lists

11+indexed :: [a] -> [(Int, a)]

12+indexed = go 0

13+ where

14+ go _ [] = []

15+ go i (v:ys) = (i,v):go (i+1) ys

src/lib/ProjectM36/NormalizeExpr.hsnew file+132

@@ -0,0 +1,132 @@

1+-- | Functions to convert all types of expresions into their GraphRef- equivalents.

2+module ProjectM36.NormalizeExpr where

3+import ProjectM36.Base

4+import Control.Monad.Trans.Reader as R

5+import qualified Data.Map as M

7+--used to process/normalize exprs to their respective graph ref forms

8+type ProcessExprM a = Reader GraphRefTransactionMarker a

10+type CurrentTransactionId = TransactionId

11+

12+runProcessExprM :: GraphRefTransactionMarker -> ProcessExprM a -> a

13+runProcessExprM mtid m = runReader m mtid

14+

15+askMarker :: ProcessExprM GraphRefTransactionMarker

16+askMarker = R.ask

17+

18+-- convert a RelationalExpr into a GraphRefRelationalExpr using the current trans Id

19+processRelationalExpr :: RelationalExpr -> ProcessExprM GraphRefRelationalExpr

20+processRelationalExpr (MakeRelationFromExprs mAttrs tupleExprs) = do

21+ mAttrs' <- case mAttrs of

22+ Nothing -> pure Nothing

23+ Just mAttrs'' -> Just <$> mapM processAttributeExpr mAttrs''

24+ MakeRelationFromExprs mAttrs' <$> processTupleExprs tupleExprs

25+processRelationalExpr (MakeStaticRelation attrs tupSet) = pure (MakeStaticRelation attrs tupSet)

26+processRelationalExpr (ExistingRelation rel) = pure (ExistingRelation rel)

27+--requires current trans id and graph

28+processRelationalExpr (RelationVariable rv ()) = RelationVariable rv <$> askMarker

29+processRelationalExpr (Project attrNames expr) = Project <$> processAttributeNames attrNames <*> processRelationalExpr expr

30+processRelationalExpr (Union exprA exprB) = Union <$> processRelationalExpr exprA <*> processRelationalExpr exprB

31+processRelationalExpr (Join exprA exprB) = Join <$> processRelationalExpr exprA <*> processRelationalExpr exprB

32+processRelationalExpr (Rename attrA attrB expr) =

33+ Rename attrA attrB <$> processRelationalExpr expr

34+processRelationalExpr (Difference exprA exprB) = Difference <$> processRelationalExpr exprA <*> processRelationalExpr exprB

35+processRelationalExpr (Group attrNames attrName expr) = Group <$> processAttributeNames attrNames <*> pure attrName <*> processRelationalExpr expr

36+processRelationalExpr (Ungroup attrName expr) = Ungroup attrName <$> processRelationalExpr expr

37+processRelationalExpr (Restrict pred' expr) = Restrict <$> processRestrictionPredicateExpr pred' <*> processRelationalExpr expr

38+processRelationalExpr (Equals exprA exprB) =

39+ Equals <$> processRelationalExpr exprA <*> processRelationalExpr exprB

40+processRelationalExpr (NotEquals exprA exprB) =

41+ NotEquals <$> processRelationalExpr exprA <*> processRelationalExpr exprB

42+processRelationalExpr (Extend extendExpr expr) =

43+ Extend <$> processExtendTupleExpr extendExpr <*> processRelationalExpr expr

44+processRelationalExpr (With macros expr) =

45+ With <$> mapM (\(wnexpr, macroExpr) -> (,) <$> processWithNameExpr wnexpr <*> processRelationalExpr macroExpr) macros <*> processRelationalExpr expr

46+

47+processWithNameExpr :: WithNameExpr -> ProcessExprM GraphRefWithNameExpr

48+processWithNameExpr (WithNameExpr rvname ()) =

49+ WithNameExpr rvname <$> askMarker

50+

51+processAttributeNames :: AttributeNames -> ProcessExprM GraphRefAttributeNames

52+processAttributeNames (AttributeNames nameSet) = pure $ AttributeNames nameSet

53+processAttributeNames (InvertedAttributeNames attrNameSet) =

54+ pure $ InvertedAttributeNames attrNameSet

55+processAttributeNames (UnionAttributeNames attrNamesA attrNamesB) = UnionAttributeNames <$> processAttributeNames attrNamesA <*> processAttributeNames attrNamesB

56+processAttributeNames (IntersectAttributeNames attrNamesA attrNamesB) = IntersectAttributeNames <$> processAttributeNames attrNamesA <*> processAttributeNames attrNamesB

57+processAttributeNames (RelationalExprAttributeNames expr) = RelationalExprAttributeNames <$> processRelationalExpr expr

58+

59+processDatabaseContextExpr :: DatabaseContextExpr -> ProcessExprM GraphRefDatabaseContextExpr

60+processDatabaseContextExpr expr =

61+ case expr of

62+ NoOperation -> pure NoOperation

63+ Define nam attrExprs -> Define nam <$> mapM processAttributeExpr attrExprs

64+ Undefine nam -> pure (Undefine nam)

65+ Assign nam rexpr -> Assign nam <$> processRelationalExpr rexpr

66+ Insert nam rexpr -> Insert nam <$> processRelationalExpr rexpr

67+ Delete nam pred' -> Delete nam <$> processRestrictionPredicateExpr pred'

68+ Update nam attrMap pred' -> Update nam attrMap <$> processRestrictionPredicateExpr pred'

69+

70+ AddInclusionDependency nam dep -> pure (AddInclusionDependency nam dep)

71+ RemoveInclusionDependency nam -> pure (RemoveInclusionDependency nam)

72+ AddNotification nam exprA exprB exprC -> pure (AddNotification nam exprA exprB exprC)

73+ RemoveNotification nam -> pure (RemoveNotification nam)

74+ AddTypeConstructor tyDef consDefs -> pure (AddTypeConstructor tyDef consDefs)

75+ RemoveTypeConstructor tyName -> pure (RemoveTypeConstructor tyName)

76+

77+ RemoveAtomFunction aFuncName -> pure (RemoveAtomFunction aFuncName)

78+ RemoveDatabaseContextFunction funcName -> pure (RemoveDatabaseContextFunction funcName)

79+ ExecuteDatabaseContextFunction funcName atomExprs -> ExecuteDatabaseContextFunction funcName <$> mapM processAtomExpr atomExprs

80+ MultipleExpr exprs -> MultipleExpr <$> mapM processDatabaseContextExpr exprs

81+

82+processDatabaseContextIOExpr :: DatabaseContextIOExpr -> ProcessExprM GraphRefDatabaseContextIOExpr

83+processDatabaseContextIOExpr (AddAtomFunction f tcs sc) =

84+ pure (AddAtomFunction f tcs sc)

85+processDatabaseContextIOExpr (LoadAtomFunctions mod' fun file) =

86+ pure (LoadAtomFunctions mod' fun file)

87+processDatabaseContextIOExpr (AddDatabaseContextFunction mod' fun path) =

88+ pure (AddDatabaseContextFunction mod' fun path)

89+processDatabaseContextIOExpr (LoadDatabaseContextFunctions mod' fun path) =

90+ pure (LoadDatabaseContextFunctions mod' fun path)

91+processDatabaseContextIOExpr (CreateArbitraryRelation rvName attrExprs range) =

92+ CreateArbitraryRelation rvName <$> mapM processAttributeExpr attrExprs <*> pure range

93+

94+processRestrictionPredicateExpr :: RestrictionPredicateExpr -> ProcessExprM GraphRefRestrictionPredicateExpr

95+processRestrictionPredicateExpr TruePredicate = pure TruePredicate

96+processRestrictionPredicateExpr (AndPredicate a b) = AndPredicate <$> processRestrictionPredicateExpr a <*> processRestrictionPredicateExpr b

97+processRestrictionPredicateExpr (OrPredicate a b) = OrPredicate <$> processRestrictionPredicateExpr a <*> processRestrictionPredicateExpr b

98+processRestrictionPredicateExpr (NotPredicate a) = NotPredicate <$> processRestrictionPredicateExpr a

99+processRestrictionPredicateExpr (RelationalExprPredicate expr) =

100+ RelationalExprPredicate <$> processRelationalExpr expr

101+processRestrictionPredicateExpr (AtomExprPredicate expr) =

102+ AtomExprPredicate <$> processAtomExpr expr

103+processRestrictionPredicateExpr (AttributeEqualityPredicate nam expr) =

104+ AttributeEqualityPredicate nam <$> processAtomExpr expr

105+

106+processExtendTupleExpr :: ExtendTupleExpr -> ProcessExprM GraphRefExtendTupleExpr

107+processExtendTupleExpr (AttributeExtendTupleExpr nam atomExpr) =

108+ AttributeExtendTupleExpr nam <$> processAtomExpr atomExpr

109+

110+processAtomExpr :: AtomExpr -> ProcessExprM GraphRefAtomExpr

111+processAtomExpr (AttributeAtomExpr nam) = pure $ AttributeAtomExpr nam

112+processAtomExpr (NakedAtomExpr atom) = pure $ NakedAtomExpr atom

113+processAtomExpr (FunctionAtomExpr fName atomExprs ()) =

114+ FunctionAtomExpr fName <$> mapM processAtomExpr atomExprs <*> askMarker

115+processAtomExpr (RelationAtomExpr expr) = RelationAtomExpr <$> processRelationalExpr expr

116+processAtomExpr (ConstructedAtomExpr dConsName atomExprs ()) = ConstructedAtomExpr dConsName <$> mapM processAtomExpr atomExprs <*> askMarker

117+

118+processTupleExprs :: TupleExprs -> ProcessExprM GraphRefTupleExprs

119+processTupleExprs (TupleExprs () tupleExprs) = do

120+ marker <- askMarker

121+ TupleExprs marker <$> mapM processTupleExpr tupleExprs

122+

123+processTupleExpr :: TupleExpr -> ProcessExprM GraphRefTupleExpr

124+processTupleExpr (TupleExpr tMap) =

125+ TupleExpr . M.fromList <$> mapM (\(k,v) -> (,) k <$> processAtomExpr v) (M.toList tMap)

126+

127+--convert AttributeExpr to GraphRefAttributeExpr

128+processAttributeExpr :: AttributeExpr -> ProcessExprM GraphRefAttributeExpr

129+processAttributeExpr (AttributeAndTypeNameExpr nam tCons ()) =

130+ AttributeAndTypeNameExpr nam tCons <$> askMarker

131+processAttributeExpr (NakedAttributeExpr attr) = pure $ NakedAttributeExpr attr

132+

src/lib/ProjectM36/Notifications.hs+12−7

@@ -1,17 +1,22 @@

1module ProjectM36.Notifications where

2import ProjectM36.Base

3+import ProjectM36.Error

3import ProjectM36.RelationalExpression

4import ProjectM36.RelationalExpression

4−import Control.Monad.Trans.Reader

5+import ProjectM36.StaticOptimizer

5import qualified Data.Map as M

6import qualified Data.Map as M

6import Data.Either (isRight)

7import Data.Either (isRight)

8-- | Returns the notifications which should be triggered based on the transition from the first 'DatabaseContext' to the second 'DatabaseContext'.

9-- | Returns the notifications which should be triggered based on the transition from the first 'DatabaseContext' to the second 'DatabaseContext'.

9−notificationChanges :: Notifications -> DatabaseContext -> DatabaseContext -> Notifications

10+notificationChanges :: Notifications -> TransactionGraph -> DatabaseContext -> DatabaseContext -> Notifications

10−notificationChanges nots context1 context2 = M.filter notificationFilter nots

11+notificationChanges nots graph context1 context2 = M.filter notificationFilter nots

11 where

12 where

12− notificationFilter (Notification chExpr _ _) = let oldChangeEval = evalChangeExpr chExpr (RelationalExprStateElems context1)

13− newChangeEval = evalChangeExpr chExpr (RelationalExprStateElems context2) in

14− oldChangeEval /= newChangeEval && isRight oldChangeEval

13+ notificationFilter (Notification chExpr _ _) = oldChangeEval /= newChangeEval && isRight oldChangeEval

15− evalChangeExpr chExpr = runReader (evalRelationalExpr chExpr)

14+ where

15+ oldChangeEval = evalChangeExpr chExpr (mkRelationalExprEnv context1 graph)

16+ newChangeEval = evalChangeExpr chExpr (mkRelationalExprEnv context2 graph)

17+

18+ evalChangeExpr :: RelationalExpr -> RelationalExprEnv -> Either RelationalError Relation

19+ evalChangeExpr chExpr env =

20+ optimizeAndEvalRelationalExpr env chExpr

src/lib/ProjectM36/Persist.hs+61−13

@@ -2,11 +2,26 @@

2--this module is related to persisting Project:M36 structures to disk and not related to the persistent library

3module ProjectM36.Persist (writeFileSync,

4 writeBSFileSync,

5− renameSync,

5+ renameSync,

6+ printFdCount,

6 DiskSync(..)) where

7 DiskSync(..)) where

7-- on Windows, use FlushFileBuffers and MoveFileEx

8-- on Windows, use FlushFileBuffers and MoveFileEx

8−import qualified Data.Text.IO as TIO

9+import qualified Data.Text as T

9−import Data.Text

10+

11+#if defined(linux_HOST_OS)

12+# define FDCOUNTSUPPORTED 1

13+# define FDDIR "/proc/self/fd"

14+#elif defined(darwin_HOST_OS)

15+# define FDCOUNTSUPPORTED 1

16+# define FDDIR "/dev/fd"

17+#else

18+# define FDCOUNTSUPPORTED 0

19+#endif

20+

21+#if FDCOUNTSUPPORTED

22+import System.Directory

23+#endif

24+

10#if defined(mingw32_HOST_OS)

25#if defined(mingw32_HOST_OS)

11import qualified System.Win32 as Win32

26import qualified System.Win32 as Win32

12#else

27#else

@@ -16,12 +31,13 @@ import System.Posix.Unistd (fileSynchroniseDataOnly)

16#else

31#else

17import System.Posix.Unistd (fileSynchronise)

32import System.Posix.Unistd (fileSynchronise)

18#endif

33#endif

19−import System.Posix.IO (handleToFd)

34+import System.Posix.IO (handleToFd, closeFd)

20import Foreign.C

35import Foreign.C

21#endif

36#endif

23import System.IO (withFile, IOMode(WriteMode), Handle)

38import System.IO (withFile, IOMode(WriteMode), Handle)

24−import qualified Data.ByteString.Lazy as BS

39+import qualified Data.ByteString as BS'

40+import qualified Data.Text.Encoding as TE

26#if defined(mingw32_HOST_OS)

42#if defined(mingw32_HOST_OS)

27import ProjectM36.Win32Handle

43import ProjectM36.Win32Handle

@@ -32,11 +48,11 @@ foreign import ccall unsafe "cDirectoryFsync" cHSDirectoryFsync :: CString -> IO

32data DiskSync = NoDiskSync | FsyncDiskSync

48data DiskSync = NoDiskSync | FsyncDiskSync

34--using withFile here is OK because we use a WORM strategy- the file is written but not read until after the handle is synced, closed, and unhidden (moved from ".X" to "X") at the top level in the transaction directory

50--using withFile here is OK because we use a WORM strategy- the file is written but not read until after the handle is synced, closed, and unhidden (moved from ".X" to "X") at the top level in the transaction directory

35−writeFileSync :: DiskSync -> FilePath -> Text -> IO()

51+writeFileSync :: DiskSync -> FilePath -> T.Text -> IO()

36writeFileSync sync path strOut = withFile path WriteMode handler

52writeFileSync sync path strOut = withFile path WriteMode handler

37 where

53 where

38 handler handle = do

54 handler handle = do

39− TIO.hPutStr handle strOut

55+ BS'.hPut handle (TE.encodeUtf8 strOut)

40 syncHandle sync handle

56 syncHandle sync handle

42renameSync :: DiskSync -> FilePath -> FilePath -> IO ()

58renameSync :: DiskSync -> FilePath -> FilePath -> IO ()

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

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

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

50atomicRename srcPath dstPath =

66atomicRename srcPath dstPath =

51#if defined(mingw32_HOST_OS)

67#if defined(mingw32_HOST_OS)

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

69+ let dst = Just dstPath

70+#else

71+ let dst = dstPath

72+#endif

73+ in

52− Win32.moveFileEx srcPath dstPath Win32.mOVEFILE_REPLACE_EXISTING

74+ Win32.moveFileEx srcPath dst Win32.mOVEFILE_REPLACE_EXISTING

53#else

75#else

54 Posix.rename srcPath dstPath

76 Posix.rename srcPath dstPath

55#endif

77#endif

@@ -59,21 +81,28 @@ syncHandle FsyncDiskSync handle =

59#if defined(mingw32_HOST_OS)

81#if defined(mingw32_HOST_OS)

60 withHandleToHANDLE handle (\h -> Win32.flushFileBuffers h)

82 withHandleToHANDLE handle (\h -> Win32.flushFileBuffers h)

61#elif defined(linux_HOST_OS)

83#elif defined(linux_HOST_OS)

84+ do

62 --fdatasync doesn't exist on macOS

85 --fdatasync doesn't exist on macOS

86+ fd <- handleToFd handle

63− handleToFd handle >>= fileSynchroniseDataOnly

87+ fileSynchroniseDataOnly fd

88+ closeFd fd

64−#else

89+#else

90+ do

91+ fd <- handleToFd handle

65− handleToFd handle >>= fileSynchronise

92+ fileSynchronise fd

93+ closeFd fd

66#endif

94#endif

95+

67syncHandle NoDiskSync _ = pure ()

96syncHandle NoDiskSync _ = pure ()

69syncDirectory :: DiskSync -> FilePath -> IO ()

98syncDirectory :: DiskSync -> FilePath -> IO ()

70syncDirectory FsyncDiskSync path = directoryFsync path

99syncDirectory FsyncDiskSync path = directoryFsync path

71syncDirectory NoDiskSync _ = pure ()

100syncDirectory NoDiskSync _ = pure ()

101

73−writeBSFileSync :: DiskSync -> FilePath -> BS.ByteString -> IO ()

102+writeBSFileSync :: DiskSync -> FilePath -> BS'.ByteString -> IO ()

74writeBSFileSync sync path bstring =

103writeBSFileSync sync path bstring =

75 withFile path WriteMode $ \handle -> do

104 withFile path WriteMode $ \handle -> do

76− BS.hPut handle bstring

105+ BS'.hPut handle bstring

77 syncHandle sync handle

106 syncHandle sync handle

107

79directoryFsync :: FilePath -> IO ()

108directoryFsync :: FilePath -> IO ()

@@ -83,3 +112,22 @@ directoryFsync _ = pure () -- on Windows directory metadata cannot be synchroniz

83directoryFsync path = throwErrnoIfMinus1Retry_ "directoryFsync" (withCString path $ \cpath -> cHSDirectoryFsync cpath)

112directoryFsync path = throwErrnoIfMinus1Retry_ "directoryFsync" (withCString path $ \cpath -> cHSDirectoryFsync cpath)

84#endif

113#endif

114

115+--prints out number of consumed file descriptors

116+printFdCount :: IO ()

117+printFdCount =

118+#if FDCOUNTSUPPORTED

119+ do

120+ fdc <- fdCount

121+ putStrLn ("Fd count: " ++ show fdc)

122+ --getLine >> pure ()

123+#else

124+ putStrLn "Fd count not supported on this OS."

125+#endif

126+

127+#if FDCOUNTSUPPORTED

128+fdCount :: IO Int

129+fdCount = do

130+ fds <- getDirectoryContents FDDIR

131+ pure ((length fds) - 2)

132+--not supported on non-linux

133+#endif

src/lib/ProjectM36/Relation.hs+43−56

@@ -4,12 +4,9 @@ import qualified Data.Set as S

4import qualified Data.HashSet as HS

5import Control.Monad

6import qualified Data.Vector as V

7−import qualified Data.Map as M

8−import ProjectM36.AtomType

9import ProjectM36.Base

7import ProjectM36.Base

10import ProjectM36.Tuple

8import ProjectM36.Tuple

11import qualified ProjectM36.Attribute as A

9import qualified ProjectM36.Attribute as A

12−import qualified ProjectM36.AttributeNames as AS

13import ProjectM36.TupleSet

10import ProjectM36.TupleSet

14import ProjectM36.Error

11import ProjectM36.Error

15--import qualified Control.Parallel.Strategies as P

12--import qualified Control.Parallel.Strategies as P

@@ -37,19 +34,18 @@ atomTypeForName attrName (Relation attrs _) = A.atomTypeForAttributeName attrNam

38mkRelationFromList :: Attributes -> [[Atom]] -> Either RelationalError Relation

35mkRelationFromList :: Attributes -> [[Atom]] -> Either RelationalError Relation

39mkRelationFromList attrs atomMatrix = do

36mkRelationFromList attrs atomMatrix = do

40− tupSet <- mkTupleSetFromList attrs atomMatrix

37+ Relation attrs <$> mkTupleSetFromList attrs atomMatrix

41− return $ Relation attrs tupSet

43emptyRelationWithAttrs :: Attributes -> Relation

39emptyRelationWithAttrs :: Attributes -> Relation

44emptyRelationWithAttrs attrs = Relation attrs emptyTupleSet

40emptyRelationWithAttrs attrs = Relation attrs emptyTupleSet

46mkRelation :: Attributes -> RelationTupleSet -> Either RelationalError Relation

42mkRelation :: Attributes -> RelationTupleSet -> Either RelationalError Relation

47−mkRelation attrs tupleSet =

43+mkRelation attrs tupleSet =

48− --check that all tuples have the same keys

44+ --check that all tuples have the same keys

49− --check that all tuples have keys (1-N) where N is the attribute count

45+ --check that all tuples have keys (1-N) where N is the attribute count

50− case verifyTupleSet attrs tupleSet of

46+ case verifyTupleSet attrs tupleSet of

51− Left err -> Left err

47+ Left err -> Left err

52− Right verifiedTupleSet -> return $ Relation attrs verifiedTupleSet

48+ Right verifiedTupleSet -> return $ Relation attrs verifiedTupleSet

54--less safe version of mkRelation skips verifyTupleSet

50--less safe version of mkRelation skips verifyTupleSet

55--useful for infinite or thunked tuple sets

51--useful for infinite or thunked tuple sets

@@ -59,6 +55,10 @@ mkRelationDeferVerify :: Attributes -> RelationTupleSet -> Either RelationalErro

59mkRelationDeferVerify attrs tupleSet = return $ Relation attrs (RelationTupleSet (filter tupleFilter (asList tupleSet)))

55mkRelationDeferVerify attrs tupleSet = return $ Relation attrs (RelationTupleSet (filter tupleFilter (asList tupleSet)))

60 where

56 where

61 tupleFilter tuple = isRight (verifyTuple attrs tuple)

57 tupleFilter tuple = isRight (verifyTuple attrs tuple)

58+

59+--return a relation of the same type except without any tuples

60+relationWithEmptyTupleSet :: Relation -> Relation

61+relationWithEmptyTupleSet (Relation attrs _) = emptyRelationWithAttrs attrs

63mkRelationFromTuples :: Attributes -> [RelationTuple] -> Either RelationalError Relation

64mkRelationFromTuples attrs tupleSetList = do

@@ -78,6 +78,7 @@ singletonTuple rel@(Relation _ tupleSet) = if cardinality rel == Finite 1 then

78 else

79 Nothing

81+-- this is still unncessarily expensive for (bigx union bigx) because each tuple is hashed and compared for equality (when the hashes match), but the major expense is attributesEqual, but we already know that all tuple attributes are equal (it's a precondition)

81union :: Relation -> Relation -> Either RelationalError Relation

82union :: Relation -> Relation -> Either RelationalError Relation

82union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =

83union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =

83 if not (A.attributesEqual attrs1 attrs2)

84 if not (A.attributesEqual attrs1 attrs2)

@@ -85,17 +86,13 @@ union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =

85 else

86 else

86 Right $ Relation attrs1 newtuples

87 Right $ Relation attrs1 newtuples

87 where

88 where

88− newtuples = RelationTupleSet $ HS.toList . HS.fromList $ asList tupSet1 ++ map (reorderTuple attrs1) (asList tupSet2)

89+ newtuples = tupleSetUnion attrs1 tupSet1 tupSet2

90−project :: AttributeNames -> Relation -> Either RelationalError Relation

91+project :: S.Set AttributeName -> Relation -> Either RelationalError Relation

91−project projectionAttrNames rel =

92+project attrNames rel@(Relation _ tupSet) = do

92− case AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames of

93+ newAttrs <- A.projectionAttributesForNames attrNames (attributes rel)

93− Left err -> Left err

94+ newTupleList <- mapM (tupleProject newAttrs) (asList tupSet)

94− Right newAttrs -> relFold (folder newAttrs) (Right $ Relation newAttrs emptyTupleSet) rel

95+ pure (Relation newAttrs (RelationTupleSet (HS.toList (HS.fromList newTupleList))))

95− where

96− folder newAttrs tupleToProject acc = case acc of

97− Left err -> Left err

98− Right acc2 -> acc2 `union` Relation newAttrs (RelationTupleSet [tupleProject (A.attributeNameSet newAttrs) tupleToProject])

100rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

97rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

101rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet)

98rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet)

@@ -142,14 +139,14 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do

142-}

139-}

143

140

144--algorithm: self-join with image relation

141--algorithm: self-join with image relation

145−group :: AttributeNames -> AttributeName -> Relation -> Either RelationalError Relation

142+group :: S.Set AttributeName -> AttributeName -> Relation -> Either RelationalError Relation

146group groupAttrNames newAttrName rel = do

143group groupAttrNames newAttrName rel = do

147− let nonGroupAttrNames = AS.invertAttributeNames groupAttrNames

144+ let nonGroupAttrNames = A.nonMatchingAttributeNameSet groupAttrNames (S.fromList (V.toList (A.attributeNames (attributes rel))))

148− nonGroupProjectionAttributes <- AS.projectionAttributesForAttributeNames (attributes rel) nonGroupAttrNames

145+ nonGroupProjectionAttributes <- A.projectionAttributesForNames nonGroupAttrNames (attributes rel)

149− groupProjectionAttributes <- AS.projectionAttributesForAttributeNames (attributes rel) groupAttrNames

146+ groupProjectionAttributes <- A.projectionAttributesForNames groupAttrNames (attributes rel)

150 let groupAttr = Attribute newAttrName (RelationAtomType groupProjectionAttributes)

147 let groupAttr = Attribute newAttrName (RelationAtomType groupProjectionAttributes)

151 matchingRelTuple tupIn = case imageRelationFor tupIn rel of

148 matchingRelTuple tupIn = case imageRelationFor tupIn rel of

152− Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))

149+ Right rel2 -> RelationTuple (A.singleton groupAttr) (V.singleton (RelationAtom rel2))

153 Left _ -> undefined

150 Left _ -> undefined

154 mogrifier tupIn = pure (tupleExtend tupIn (matchingRelTuple tupIn))

151 mogrifier tupIn = pure (tupleExtend tupIn (matchingRelTuple tupIn))

155 newAttrs = A.addAttribute groupAttr nonGroupProjectionAttributes

152 newAttrs = A.addAttribute groupAttr nonGroupProjectionAttributes

@@ -163,7 +160,8 @@ restrictEq :: RelationTuple -> Relation -> Either RelationalError Relation

163restrictEq tuple = restrict rfilter

160restrictEq tuple = restrict rfilter

164 where

161 where

165 rfilter :: RelationTuple -> Either RelationalError Bool

162 rfilter :: RelationTuple -> Either RelationalError Bool

163+ rfilter tupleIn = do

166− rfilter tupleIn = pure (tupleIntersection tuple tupleIn == tuple)

164+ pure (tupleIntersection tuple tupleIn == tuple)

167

165

168-- unwrap relation-valued attribute

166-- unwrap relation-valued attribute

169-- return error if relval attrs and nongroup attrs overlap

167-- return error if relval attrs and nongroup attrs overlap

@@ -185,13 +183,13 @@ ungroup relvalAttrName rel = case attributesForRelval relvalAttrName rel of

185tupleUngroup :: AttributeName -> Attributes -> RelationTuple -> Either RelationalError Relation

183tupleUngroup :: AttributeName -> Attributes -> RelationTuple -> Either RelationalError Relation

186tupleUngroup relvalAttrName newAttrs tuple = do

184tupleUngroup relvalAttrName newAttrs tuple = do

187 relvalRelation <- relationForAttributeName relvalAttrName tuple

185 relvalRelation <- relationForAttributeName relvalAttrName tuple

186+ let nonGroupAttrs = A.intersection newAttrs (tupleAttributes tuple)

187+ nonGroupTupleProjection <- tupleProject nonGroupAttrs tuple

188+ let folder tupleIn acc = case acc of

189+ Left err -> Left err

190+ Right accRel ->

191+ union accRel $ Relation newAttrs (RelationTupleSet [tupleExtend nonGroupTupleProjection tupleIn])

188 relFold folder (Right $ Relation newAttrs emptyTupleSet) relvalRelation

192 relFold folder (Right $ Relation newAttrs emptyTupleSet) relvalRelation

189− where

190− nonGroupTupleProjection = tupleProject nonGroupAttrNames tuple

191− nonGroupAttrNames = A.attributeNameSet newAttrs

192− folder tupleIn acc = case acc of

193− Left err -> Left err

194− Right accRel -> union accRel $ Relation newAttrs (RelationTupleSet [tupleExtend nonGroupTupleProjection tupleIn])

195

193

196attributesForRelval :: AttributeName -> Relation -> Either RelationalError Attributes

194attributesForRelval :: AttributeName -> Relation -> Either RelationalError Attributes

197attributesForRelval relvalAttrName (Relation attrs _) = do

195attributesForRelval relvalAttrName (Relation attrs _) = do

@@ -216,8 +214,7 @@ join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = do

216 joinedTupSet <- singleTupleSetJoin newAttrs tuple1 tupSet2

214 joinedTupSet <- singleTupleSetJoin newAttrs tuple1 tupSet2

217 return $ joinedTupSet ++ accumulator

215 return $ joinedTupSet ++ accumulator

218 newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)

216 newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)

219− newTupSet <- mkTupleSet newAttrs newTupSetList

217+ Relation newAttrs <$> mkTupleSet newAttrs newTupSetList

220− return $ Relation newAttrs newTupSet

221

218

222-- | Difference takes two relations of the same type and returns a new relation which contains only tuples which appear in the first relation but not the second.

219-- | Difference takes two relations of the same type and returns a new relation which contains only tuples which appear in the first relation but not the second.

223difference :: Relation -> Relation -> Either RelationalError Relation

220difference :: Relation -> Relation -> Either RelationalError Relation

@@ -247,7 +244,8 @@ relMap mapper (Relation attrs tupleSet) =

247

244

248relMogrify :: (RelationTuple -> Either RelationalError RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation

245relMogrify :: (RelationTuple -> Either RelationalError RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation

249relMogrify mapper newAttributes (Relation _ tupSet) = do

246relMogrify mapper newAttributes (Relation _ tupSet) = do

250− newTuples <- mapM mapper (asList tupSet)

247+ newTuples <- mapM (fmap (reorderTuple newAttributes) . mapper) (asList tupSet)

248+

251 mkRelationFromTuples newAttributes newTuples

249 mkRelationFromTuples newAttributes newTuples

252

250

253relFold :: (RelationTuple -> a -> a) -> a -> Relation -> a

251relFold :: (RelationTuple -> a -> a) -> a -> Relation -> a

@@ -267,7 +265,7 @@ toList rel = do

267imageRelationFor :: RelationTuple -> Relation -> Either RelationalError Relation

265imageRelationFor :: RelationTuple -> Relation -> Either RelationalError Relation

268imageRelationFor matchTuple rel = do

266imageRelationFor matchTuple rel = do

269 restricted <- restrictEq matchTuple rel --restrict across matching tuples

267 restricted <- restrictEq matchTuple rel --restrict across matching tuples

270− let projectionAttrNames = AttributeNames $ A.nonMatchingAttributeNameSet (attributeNames rel) (tupleAttributeNameSet matchTuple)

268+ let projectionAttrNames = A.nonMatchingAttributeNameSet (attributeNames rel) (tupleAttributeNameSet matchTuple)

271 project projectionAttrNames restricted --project across attributes not in rel

269 project projectionAttrNames restricted --project across attributes not in rel

272

270

273--returns a relation-valued attribute image relation for each tuple in rel1

271--returns a relation-valued attribute image relation for each tuple in rel1

@@ -293,33 +291,22 @@ typesAsRelation types = mkRelationFromTuples attrs tuples

293 dConsType = RelationAtomType subAttrs

291 dConsType = RelationAtomType subAttrs

294 tuples = map mkTypeConsDescription types

292 tuples = map mkTypeConsDescription types

295

293

294+ mkTypeConsDescription (tCons, dConsList) =

296− mkTypeConsDescription (tCons, dConsList) = RelationTuple attrs (V.fromList [TextAtom (TCD.name tCons), mkDataConsRelation dConsList])

295+ RelationTuple attrs (V.fromList [TextAtom (TCD.name tCons), mkDataConsRelation dConsList])

297

296

298 mkDataConsRelation dConsList = case mkRelationFromTuples subAttrs $ map (\dCons -> RelationTuple subAttrs (V.singleton $ TextAtom $ T.intercalate " " (DCD.name dCons:map (T.pack . show) (DCD.fields dCons)))) dConsList of

297 mkDataConsRelation dConsList = case mkRelationFromTuples subAttrs $ map (\dCons -> RelationTuple subAttrs (V.singleton $ TextAtom $ T.intercalate " " (DCD.name dCons:map (T.pack . show) (DCD.fields dCons)))) dConsList of

299 Left err -> error ("mkRelationFromTuples pooped " ++ show err)

298 Left err -> error ("mkRelationFromTuples pooped " ++ show err)

300 Right rel -> RelationAtom rel

299 Right rel -> RelationAtom rel

301−

302−-- | Return a Relation describing the relation variables.

303−relationVariablesAsRelation :: M.Map RelVarName Relation -> Either RelationalError Relation

304−relationVariablesAsRelation relVarMap = mkRelationFromList attrs tups

305− where

306− subrelAttrs = A.attributesFromList [Attribute "attribute" TextAtomType, Attribute "type" TextAtomType]

307− attrs = A.attributesFromList [Attribute "name" TextAtomType,

308− Attribute "attributes" (RelationAtomType subrelAttrs)]

309− tups = map relVarToAtomList (M.toList relVarMap)

310− relVarToAtomList (rvName, rel) = [TextAtom rvName, attributesToRel (attributes rel)]

311− attributesToRel attrl = case mkRelationFromList subrelAttrs (map attrAtoms (V.toList attrl)) of

312− Left err -> error ("relationVariablesAsRelation pooped " ++ show err)

313− Right rel -> RelationAtom rel

314− attrAtoms a = [TextAtom (A.attributeName a), TextAtom (prettyAtomType (A.atomType a))]

315

300

316-- | Randomly resort the tuples. This is useful for emphasizing that two relations are equal even when they are printed to the console in different orders.

301-- | Randomly resort the tuples. This is useful for emphasizing that two relations are equal even when they are printed to the console in different orders.

317randomizeTupleOrder :: MonadRandom m => Relation -> m Relation

302randomizeTupleOrder :: MonadRandom m => Relation -> m Relation

318−randomizeTupleOrder (Relation attrs tupSet) = do

303+randomizeTupleOrder (Relation attrs tupSet) =

319− newTupSet <- shuffleM (asList tupSet)

304+ Relation attrs . RelationTupleSet <$> shuffleM (asList tupSet)

320− pure (Relation attrs (RelationTupleSet newTupSet))

321

305

322-- returns a tuple from the tupleset- this is useful for priming folds over the tuples

306-- returns a tuple from the tupleset- this is useful for priming folds over the tuples

323oneTuple :: Relation -> Maybe RelationTuple

307oneTuple :: Relation -> Maybe RelationTuple

324oneTuple (Relation _ (RelationTupleSet [])) = Nothing

308oneTuple (Relation _ (RelationTupleSet [])) = Nothing

325−oneTuple (Relation _ (RelationTupleSet (x:_))) = Just x

309+oneTuple (Relation _ (RelationTupleSet (x:_))) = Just x

310+

311+tuplesList :: Relation -> [RelationTuple]

312+tuplesList (Relation _ tupleSet) = asList tupleSet

src/lib/ProjectM36/Relation/Parse/CSV.hs+47−39

@@ -4,6 +4,7 @@ import ProjectM36.Base

4import ProjectM36.Error

5import ProjectM36.Relation

6import ProjectM36.AtomType

7+import ProjectM36.DataTypes.Interval

7import qualified ProjectM36.Attribute as A

8import qualified ProjectM36.Attribute as A

9import Data.Csv.Parser

10import Data.Csv.Parser

@@ -37,8 +38,7 @@ csvAsRelation attrs tConsMap inString = case APBL.parse (csvWithHeader csvDecode

37 let strHeader = V.map decodeUtf8 headerRaw

38 let strHeader = V.map decodeUtf8 headerRaw

38 strMapRecords = V.map convertMap vecMapsRaw

39 strMapRecords = V.map convertMap vecMapsRaw

39 convertMap hmap = HM.fromList $ L.map (decodeUtf8 *** (T.unpack . decodeUtf8)) (HM.toList hmap)

40 convertMap hmap = HM.fromList $ L.map (decodeUtf8 *** (T.unpack . decodeUtf8)) (HM.toList hmap)

40− attrNames = V.map A.attributeName attrs

41+ attrNameSet = A.attributeNameSet attrs

41− attrNameSet = S.fromList (V.toList attrNames)

42 headerSet = S.fromList (V.toList strHeader)

43 parseAtom attrName aType textIn = case APT.parseOnly (parseCSVAtomP attrName tConsMap aType <* APT.endOfInput) textIn of

44 Left err -> Left (ParseError (T.pack err))

@@ -46,7 +46,7 @@ csvAsRelation attrs tConsMap inString = case APBL.parse (csvWithHeader csvDecode

46 makeTupleList :: HM.HashMap AttributeName String -> [Either CsvImportError Atom]

47 makeTupleList tupMap = V.toList $ V.map (\attr ->

48 either (Left . AttributeMappingError) Right $

49− parseAtom (A.attributeName attr) (A.atomType attr) (T.pack $ tupMap HM.! A.attributeName attr)) attrs

49+ parseAtom (A.attributeName attr) (A.atomType attr) (T.pack $ tupMap HM.! A.attributeName attr)) (attributesVec attrs)

50 if attrNameSet == headerSet then do

51 tupleList <- mapM sequence $ V.toList (V.map makeTupleList strMapRecords)

52 case mkRelationFromList attrs tupleList of

@@ -57,12 +57,11 @@ csvAsRelation attrs tConsMap inString = case APBL.parse (csvWithHeader csvDecode

59parseCSVAtomP :: AttributeName -> TypeConstructorMapping -> AtomType -> APT.Parser (Either RelationalError Atom)

60−parseCSVAtomP _ _ IntegerAtomType = (Right . IntegerAtom) <$> APT.decimal

60+parseCSVAtomP _ _ IntegerAtomType = Right . IntegerAtom <$> APT.decimal

61parseCSVAtomP _ _ IntAtomType = Right . IntAtom <$> APT.decimal

62parseCSVAtomP _ _ DoubleAtomType = Right . DoubleAtom <$> APT.double

63−parseCSVAtomP _ _ TextAtomType = do

63+parseCSVAtomP _ _ TextAtomType =

64− s <- quotedString <|> takeToEndOfData

64+ Right . TextAtom <$> (quotedString <|> takeToEndOfData)

65− pure (Right (TextAtom s))

66parseCSVAtomP _ _ DayAtomType = do

65parseCSVAtomP _ _ DayAtomType = do

67 dString <- T.unpack <$> takeToEndOfData

66 dString <- T.unpack <$> takeToEndOfData

68 case readMaybe dString of

67 case readMaybe dString of

@@ -83,41 +82,50 @@ parseCSVAtomP _ _ BoolAtomType = do

83 case readMaybe bString of

82 case readMaybe bString of

84 Nothing -> fail ("invalid BoolAtom string: " ++ bString)

83 Nothing -> fail ("invalid BoolAtom string: " ++ bString)

85 Just b -> pure (Right (BoolAtom b))

84 Just b -> pure (Right (BoolAtom b))

86−parseCSVAtomP attrName tConsMap (IntervalAtomType iType) = do

85+parseCSVAtomP _ _ RelationalExprAtomType = do

87− begin <- (APT.char '[' >> pure False) <|> (APT.char '(' >> pure True)

86+ reString <- T.unpack <$> takeToEndOfData

88− eBeginv <- parseCSVAtomP attrName tConsMap iType

87+ case readMaybe reString of

89− case eBeginv of

88+ Nothing -> fail ("invalid RelationalExprAtom string: " ++ reString)

90− Left err -> pure (Left err)

89+ Just b -> pure (Right (RelationalExprAtom b))

91− Right beginv -> do

92− _ <- APT.char ','

93− eEndv <- parseCSVAtomP attrName tConsMap iType

94− case eEndv of

95− Left err -> pure (Left err)

96− Right endv -> do

97− end <- (APT.char ']' >> pure False) <|> (APT.char ')' >> pure True)

98− pure (Right (IntervalAtom beginv endv begin end))

99−parseCSVAtomP attrName tConsMap typ@(ConstructedAtomType _ tvmap) = do

90+parseCSVAtomP attrName tConsMap typ@(ConstructedAtomType _ tvmap)

91+ | isIntervalAtomType typ = do

92+ begin <- (APT.char '[' >> pure False) <|> (APT.char '(' >> pure True)

93+ let iType = intervalSubType typ

94+ eBeginv <- parseCSVAtomP attrName tConsMap iType

95+ case eBeginv of

96+ Left err -> pure (Left err)

97+ Right beginv -> do

98+ _ <- APT.char ','

99+ eEndv <- parseCSVAtomP attrName tConsMap iType

100+ case eEndv of

101+ Left err -> pure (Left err)

102+ Right endv -> do

103+ end <- (APT.char ']' >> pure False) <|>

104+ (APT.char ')' >> pure True)

105+ pure (Right (ConstructedAtom "Interval" typ [beginv, endv,

106+ BoolAtom begin, BoolAtom end]))

107+ | otherwise = do

100− dConsName <- capitalizedIdentifier

108+ dConsName <- capitalizedIdentifier

101− APT.skipSpace

109+ APT.skipSpace

102 --we need to look up the name right away in order to determine the types of the following arguments

110 --we need to look up the name right away in order to determine the types of the following arguments

103 -- grab the data constructor

111 -- grab the data constructor

104− case findDataConstructor dConsName tConsMap of

112+ case findDataConstructor dConsName tConsMap of

105− Nothing -> pure (Left (NoSuchDataConstructorError dConsName))

113+ Nothing -> pure (Left (NoSuchDataConstructorError dConsName))

106− Just (_, dConsDef) ->

114+ Just (_, dConsDef) ->

107 -- identify the data constructor's expected atom type args

115 -- identify the data constructor's expected atom type args

108− case resolvedAtomTypesForDataConstructorDefArgs tConsMap tvmap dConsDef of

116+ case resolvedAtomTypesForDataConstructorDefArgs tConsMap tvmap dConsDef of

109− Left err -> pure (Left err)

117+ Left err -> pure (Left err)

110− Right argAtomTypes -> do

118+ Right argAtomTypes -> do

111− atomArgs <- mapM (\argTyp -> let parseNextAtom = parseCSVAtomP attrName tConsMap argTyp <* APT.skipSpace in

119+ atomArgs <- mapM (\argTyp -> let parseNextAtom = parseCSVAtomP attrName tConsMap argTyp <* APT.skipSpace in

112− case argTyp of

120+ case argTyp of

113− ConstructedAtomType _ _ ->

121+ ConstructedAtomType _ _ ->

114− parens parseNextAtom <|>

122+ parens parseNextAtom <|>

115− parseNextAtom

123+ parseNextAtom

116− _ -> parseNextAtom

124+ _ -> parseNextAtom

117− ) argAtomTypes

125+ ) argAtomTypes

118− case lefts atomArgs of

126+ case lefts atomArgs of

119− [] -> pure (Right (ConstructedAtom dConsName typ (rights atomArgs)))

127+ [] -> pure (Right (ConstructedAtom dConsName typ (rights atomArgs)))

120− errs -> pure (Left (someErrors errs))

128+ errs -> pure (Left (someErrors errs))

121parseCSVAtomP attrName _ (RelationAtomType _) = pure (Left (RelationValuedAttributesNotSupportedError [attrName]))

129parseCSVAtomP attrName _ (RelationAtomType _) = pure (Left (RelationValuedAttributesNotSupportedError [attrName]))

122parseCSVAtomP _ _ (TypeVariableType x) = pure (Left (TypeConstructorTypeVarMissing x))

130parseCSVAtomP _ _ (TypeVariableType x) = pure (Left (TypeConstructorTypeVarMissing x))

123

131

src/lib/ProjectM36/Relation/Show/CSV.hs+6−6

@@ -1,7 +1,7 @@

1{-# OPTIONS_GHC -fno-warn-orphans #-}

2module ProjectM36.Relation.Show.CSV where

3import ProjectM36.Base

4−import ProjectM36.Attribute

4+import ProjectM36.Attribute as A

5import Data.Csv

6import ProjectM36.Tuple

7import qualified Data.ByteString.Lazy as BS

@@ -17,13 +17,13 @@ relationAsCSV (Relation attrs tupleSet)

17 | relValAttrs /= [] =

18 Left $ RelationValuedAttributesNotSupportedError (map attributeName relValAttrs)

19 --check that there is at least one attribute

20− | V.null attrs =

20+ | A.null attrs =

21 Left $ TupleAttributeCountMismatchError 0

22 | otherwise =

23 Right $ encodeByName bsAttrNames $ map RecordRelationTuple (asList tupleSet)

24 where

25− relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) attrs

25+ relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) (attributesVec attrs)

26− bsAttrNames = V.map (TE.encodeUtf8 . attributeName) attrs

26+ bsAttrNames = V.map (TE.encodeUtf8 . attributeName) (attributesVec attrs)

28{-

29instance ToRecord RelationTuple where

@@ -36,12 +36,12 @@ instance ToNamedRecord RecordRelationTuple where

36 toNamedRecord rTuple = namedRecord $ map (\(k,v) -> TE.encodeUtf8 k .= RecordAtom v) (tupleAssocs $ unTuple rTuple)

38instance DefaultOrdered RecordRelationTuple where

39− headerOrder (RecordRelationTuple tuple) = V.map (TE.encodeUtf8 . attributeName) (tupleAttributes tuple)

39+ headerOrder (RecordRelationTuple tuple) = V.map (TE.encodeUtf8 . attributeName) (attributesVec (tupleAttributes tuple))

41newtype RecordAtom = RecordAtom {unAtom :: Atom}

43instance ToField RecordAtom where

44− toField (RecordAtom (TextAtom atomVal)) = TE.encodeUtf8 atomVal --squelch extraneous quotes for text type- the CSV library will add them if necessary

44+ toField (RecordAtom (TextAtom atomVal)) = TE.encodeUtf8 atomVal --without this, CSV text atoms are doubly quoted

45 toField (RecordAtom atomVal) = (TE.encodeUtf8 . atomToText) atomVal

src/lib/ProjectM36/Relation/Show/HTML.hs+36−10

@@ -3,22 +3,44 @@ import ProjectM36.Base

3import ProjectM36.Relation

4import ProjectM36.Tuple

5import ProjectM36.Atom

6+import ProjectM36.Attribute as A

7+import ProjectM36.AtomType

6import qualified Data.List as L

8import qualified Data.List as L

7−import ProjectM36.Attribute

8−import Data.Text (append, Text, pack)

9+import Data.Text (Text, pack)

9import qualified Data.Text as T

10import qualified Data.Text as T

10import qualified Data.Text.IO as TIO

11import qualified Data.Text.IO as TIO

12+#if __GLASGOW_HASKELL__ < 804

13+import Data.Monoid

14+#endif

12attributesAsHTML :: Attributes -> Text

16attributesAsHTML :: Attributes -> Text

13−attributesAsHTML attrs = "<tr>" `append` T.concat (map oneAttrHTML attrNameList) `append` "</tr>"

17+attributesAsHTML attrs = "<tr>" <> T.concat (map oneAttrHTML (A.toList attrs)) <> "</tr>"

14 where

18 where

15− oneAttrHTML attrName = "<th>" `append` attrName `append` "</th>"

19+ oneAttrHTML attr = "<th>" <> prettyAttribute attr <> "</th>"

16− attrNameList = sortedAttributeNameList (attributeNameSet attrs)

18relationAsHTML :: Relation -> Text

21relationAsHTML :: Relation -> Text

22+-- web browsers don't display tables with empty cells or empty headers, so we have to insert some placeholders- it's not technically the same, but looks as expected in the browser

19−relationAsHTML rel@(Relation attrNameSet tupleSet) = "<table border=\"1\">" `append` attributesAsHTML attrNameSet `append` tupleSetAsHTML tupleSet `append` "<tfoot>" `append` tablefooter `append` "</tfoot></table>"

23+relationAsHTML rel@(Relation attrNameSet tupleSet)

24+ | rel == relationTrue = pm36relcss <>

25+ tablestart <>

26+ "<tr><th></th></tr>" <>

27+ "<tr><td></td></tr>" <>

28+ tablefooter <> "</table>"

29+ | rel == relationFalse = pm36relcss <>

30+ tablestart <>

31+ "<tr><th></th></tr>" <>

32+ tablefooter <>

33+ "</table>"

34+ | otherwise = pm36relcss <>

35+ tablestart <>

36+ attributesAsHTML attrNameSet <>

37+ tupleSetAsHTML tupleSet <>

38+ tablefooter <>

39+ "</table>"

20 where

40 where

41+ pm36relcss = "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style>"

21− tablefooter = "<tr><td colspan=\"100%\">" `append` pack (show (cardinality rel)) `append` " tuples</td></tr>"

42+ tablefooter = "<tfoot><tr><td colspan=\"100%\">" <> pack (show (cardinality rel)) <> " tuples</td></tr></tfoot>"

43+ tablestart = "<table class=\"pm36relation\"\">"

23writeHTML :: Text -> IO ()

45writeHTML :: Text -> IO ()

24writeHTML = TIO.writeFile "/home/agentm/rel.html"

46writeHTML = TIO.writeFile "/home/agentm/rel.html"

@@ -27,11 +49,15 @@ writeRel :: Relation -> IO ()

27writeRel = writeHTML . relationAsHTML

49writeRel = writeHTML . relationAsHTML

29tupleAsHTML :: RelationTuple -> Text

51tupleAsHTML :: RelationTuple -> Text

30−tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleSortedAssocs tuple)) `append` "</tr>"

52+tupleAsHTML tuple = "<tr>" <> T.concat (L.map tupleFrag (tupleAssocs tuple)) <> "</tr>"

31 where

53 where

32− tupleFrag tup = "<td>" `append` atomToText (snd tup) `append` "</td>"

54+ tupleFrag tup = "<td>" <> atomAsHTML (snd tup) <> "</td>"

55+ atomAsHTML (RelationAtom rel) = relationAsHTML rel

56+ atomAsHTML (TextAtom t) = """ <> t <> """

57+ atomAsHTML atom = atomToText atom

34tupleSetAsHTML :: RelationTupleSet -> Text

59tupleSetAsHTML :: RelationTupleSet -> Text

35tupleSetAsHTML tupSet = foldr folder "" (asList tupSet)

60tupleSetAsHTML tupSet = foldr folder "" (asList tupSet)

36 where

61 where

37− folder tuple acc = acc `append` tupleAsHTML tuple

62+ folder tuple acc = acc <> tupleAsHTML tuple

63+

src/lib/ProjectM36/Relation/Show/Term.hs+24−21

@@ -8,8 +8,13 @@ import ProjectM36.Relation

8import ProjectM36.Attribute hiding (null)

9import qualified Data.List as L

10import qualified Data.Text as T

11−import qualified Data.Vector as V

12import Control.Arrow hiding (left)

11import Control.Arrow hiding (left)

12+import Data.ByteString.Base64 as B64

13+import qualified Data.Text.Encoding as TE

14+#if __GLASGOW_HASKELL__ < 804

15+import Data.Monoid

16+#endif

17+import ProjectM36.WCWidth --guess the width that the character will appear as in the terminal

14boxV :: StringType

19boxV :: StringType

15boxV = "│"

20boxV = "│"

@@ -37,16 +42,6 @@ boxBB = "┴"

37boxC :: StringType

42boxC :: StringType

38boxC = "┼"

43boxC = "┼"

40−dboxH :: StringType

41−dboxH = "═"

42−dboxL :: StringType

43−dboxL = "╞"

44−dboxR :: StringType

45−dboxR = "╡"

46−

47−class TermSize a where

48− termLength :: a -> Int

49−

50--represent a relation as a table similar to those drawn by Date

45--represent a relation as a table similar to those drawn by Date

51type Cell = StringType

46type Cell = StringType

52type Table = ([Cell], [[Cell]]) --header, body

47type Table = ([Cell], [[Cell]]) --header, body

@@ -78,14 +73,14 @@ cellSizes (header, body) = map (map maxRowWidth &&& map (length . breakLines)) a

78 0

73 0

79 else

74 else

80 L.maximum (lengths row)

75 L.maximum (lengths row)

81− lengths row = map T.length (breakLines row)

76+ lengths row = map stringDisplayLength (breakLines row)

82 allRows = header : body

77 allRows = header : body

84relationAsTable :: Relation -> Table

79relationAsTable :: Relation -> Table

85relationAsTable rel@(Relation _ tupleSet) = (header, body)

80relationAsTable rel@(Relation _ tupleSet) = (header, body)

86 where

81 where

87− oAttrs = orderedAttributes rel

82+ oAttrs = orderedAttributes (attributes rel)

88− oAttrNames = orderedAttributeNames rel

83+ oAttrNames = orderedAttributeNames (attributes rel)

89 header = map prettyAttribute oAttrs

84 header = map prettyAttribute oAttrs

90 body :: [[Cell]]

85 body :: [[Cell]]

91 body = L.foldl' tupleFolder [] (asList tupleSet)

86 body = L.foldl' tupleFolder [] (asList tupleSet)

@@ -103,6 +98,8 @@ showParens predicate f = if predicate then

103showAtom :: Int -> Atom -> StringType

98showAtom :: Int -> Atom -> StringType

104showAtom _ (RelationAtom rel) = renderTable $ relationAsTable rel

99showAtom _ (RelationAtom rel) = renderTable $ relationAsTable rel

105showAtom level (ConstructedAtom dConsName _ atoms) = showParens (level >= 1 && not (null atoms)) $ T.concat (L.intersperse " " (dConsName : map (showAtom 1) atoms))

100showAtom level (ConstructedAtom dConsName _ atoms) = showParens (level >= 1 && not (null atoms)) $ T.concat (L.intersperse " " (dConsName : map (showAtom 1) atoms))

101+showAtom _ (TextAtom t) = "\"" <> t <> "\""

102+showAtom _ (ByteStringAtom bs) = TE.decodeUtf8 (B64.encode bs)

106showAtom _ atom = atomToText atom

103showAtom _ atom = atomToText atom

107

104

108renderTable :: Table -> StringType

105renderTable :: Table -> StringType

@@ -121,13 +118,14 @@ renderHeader (header, body) columnLocations = renderTopBar `T.append` renderHead

121renderHBar :: StringType -> StringType -> StringType -> [Int] -> StringType

118renderHBar :: StringType -> StringType -> StringType -> [Int] -> StringType

122renderHBar left middle end columnLocations = left `T.append` T.concat (L.intersperse middle (map (`repeatString` boxH) columnLocations)) `T.append` end

119renderHBar left middle end columnLocations = left `T.append` T.concat (L.intersperse middle (map (`repeatString` boxH) columnLocations)) `T.append` end

123

120

121+--pad a block of potentially multi-lined text

124leftPaddedString :: Int -> Int -> StringType -> StringType

122leftPaddedString :: Int -> Int -> StringType -> StringType

125leftPaddedString lineNum size str = if lineNum > length paddedLines -1 then

123leftPaddedString lineNum size str = if lineNum > length paddedLines -1 then

126 repeatString size " "

124 repeatString size " "

127 else

125 else

128 paddedLines !! lineNum

126 paddedLines !! lineNum

129 where

127 where

130− paddedLines = map (\line -> line `T.append` repeatString (size - T.length line) " ") (breakLines str)

128+ paddedLines = map (\line -> line `T.append` repeatString (size - stringDisplayLength line) " ") (breakLines str)

131

129

132renderRow :: [Cell] -> [Int] -> Int -> StringType -> StringType

130renderRow :: [Cell] -> [Int] -> Int -> StringType -> StringType

133renderRow cells columnLocations rowHeight interspersed = T.unlines $ map renderOneLine [0..rowHeight-1]

131renderRow cells columnLocations rowHeight interspersed = T.unlines $ map renderOneLine [0..rowHeight-1]

@@ -143,14 +141,19 @@ renderBody cellMatrix cellLocs = renderRows `T.append` renderBottomBar

143 rowHeightMatrix = zip cellMatrix (tail rowLocations)

141 rowHeightMatrix = zip cellMatrix (tail rowLocations)

144 renderBottomBar = renderHBar boxBL boxBB boxBR columnLocations

142 renderBottomBar = renderHBar boxBL boxBB boxBR columnLocations

145

143

146−orderedAttributes :: Relation -> [Attribute]

147−orderedAttributes rel = L.sortBy (\a b -> attributeName a `compare` attributeName b) (V.toList (attributes rel))

148−

149−orderedAttributeNames :: Relation -> [AttributeName]

150−orderedAttributeNames rel = map attributeName (orderedAttributes rel)

151−

152repeatString :: Int -> StringType -> StringType

144repeatString :: Int -> StringType -> StringType

153repeatString c s = T.concat (replicate c s)

145repeatString c s = T.concat (replicate c s)

154

146

155showRelation :: Relation -> StringType

147showRelation :: Relation -> StringType

156showRelation rel = renderTable (relationAsTable rel)

148showRelation rel = renderTable (relationAsTable rel)

149+

150+--use wcwidth to guess the string width in the terminal- many CJK characters can take multiple columns in a fixed width font

151+stringDisplayLength :: StringType -> Int

152+stringDisplayLength = T.foldr charSize 0

153+ where

154+ charSize char accum = let w = wcwidth char in

155+ accum + if w < 0 then

156+ 1

157+ else

158+ w

159+

src/lib/ProjectM36/RelationalExpression.hs+1090−572

@@ -1,32 +1,53 @@

1{-# LANGUAGE ScopedTypeVariables #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE OverloadedStrings #-}

2module ProjectM36.RelationalExpression where

5module ProjectM36.RelationalExpression where

3import ProjectM36.Relation

6import ProjectM36.Relation

4import ProjectM36.Tuple

7import ProjectM36.Tuple

5import ProjectM36.TupleSet

8import ProjectM36.TupleSet

6import ProjectM36.Base

9import ProjectM36.Base

10+import qualified Data.UUID as U

7import ProjectM36.Error

11import ProjectM36.Error

8import ProjectM36.AtomType

12import ProjectM36.AtomType

9−import ProjectM36.Attribute (emptyAttributes)

13+import ProjectM36.Attribute (emptyAttributes, attributesFromList)

10import ProjectM36.ScriptSession

14import ProjectM36.ScriptSession

11import ProjectM36.DataTypes.Primitive

15import ProjectM36.DataTypes.Primitive

12import ProjectM36.AtomFunction

16import ProjectM36.AtomFunction

13import ProjectM36.DatabaseContextFunction

17import ProjectM36.DatabaseContextFunction

18+import ProjectM36.Arbitrary

19+import ProjectM36.GraphRefRelationalExpr

20+import ProjectM36.Transaction

14import qualified ProjectM36.Attribute as A

21import qualified ProjectM36.Attribute as A

15import qualified Data.Map as M

22import qualified Data.Map as M

16import qualified Data.HashSet as HS

23import qualified Data.HashSet as HS

24+import qualified Data.Set as S

17import Control.Monad.State hiding (join)

25import Control.Monad.State hiding (join)

18−import Control.Exception

26+import Data.Bifunctor (second)

19import Data.Maybe

27import Data.Maybe

20import Data.Either

28import Data.Either

21import Data.Char (isUpper)

29import Data.Char (isUpper)

30+import Data.Time

31+import qualified Data.List.NonEmpty as NE

32+import Data.Functor.Identity

22import qualified Data.Text as T

33import qualified Data.Text as T

23import qualified Data.Vector as V

34import qualified Data.Vector as V

24import qualified ProjectM36.TypeConstructorDef as TCD

35import qualified ProjectM36.TypeConstructorDef as TCD

25−import Control.Monad.Trans.Except

36+import qualified Control.Monad.RWS.Strict as RWS

37+import Control.Monad.RWS.Strict (RWST, execRWST, runRWST)

38+import Control.Monad.Except hiding (join)

26−import Control.Monad.Trans.Reader

39+import Control.Monad.Trans.Except (except)

27−

40+import Control.Monad.Reader as R hiding (join)

41+import ProjectM36.NormalizeExpr

42+import ProjectM36.WithNameExpr

43+import Test.QuickCheck

44+import qualified Data.Functor.Foldable as Fold

45+import Control.Applicative

46+#ifdef PM36_HASKELL_SCRIPTING

28−import GHC

47+import GHC hiding (getContext)

48+import Control.Exception

29import GHC.Paths

49import GHC.Paths

50+#endif

31data DatabaseContextExprDetails = CountUpdatedTuples

52data DatabaseContextExprDetails = CountUpdatedTuples

@@ -43,32 +64,63 @@ databaseContextExprDetailsFunc CountUpdatedTuples _ relIn = Relation attrs newTu

43 Right ts -> ts

64 Right ts -> ts

45-- | Used to start a fresh database state for a new database context expression.

66-- | Used to start a fresh database state for a new database context expression.

46−freshDatabaseState :: DatabaseContext -> DatabaseStateElems

67+mkDatabaseContextEvalState :: DatabaseContext -> DatabaseContextEvalState

68+mkDatabaseContextEvalState context = DatabaseContextEvalState {

69+ dbc_context = context,

70+ dbc_accum = M.empty,

71+ dbc_dirty = False

47−freshDatabaseState ctx = (ctx, M.empty, False) --future work: propagate return accumulator

72+ } --future work: propagate return accumulator

49-- we need to pass around a higher level RelationTuple and Attributes in order to solve #52

74-- we need to pass around a higher level RelationTuple and Attributes in order to solve #52

50−data RelationalExprStateElems = RelationalExprStateTupleElems DatabaseContext RelationTuple | -- used when fully evaluating a relexpr

75+data RelationalExprEnv = RelationalExprEnv {

51− RelationalExprStateAttrsElems DatabaseContext Attributes | --used when evaluating the type of a relexpr

76+ re_context :: DatabaseContext,

52− RelationalExprStateElems DatabaseContext --used by default at the top level of evaluation

77+ re_graph :: TransactionGraph,

53−

78+ re_extra :: Maybe (Either RelationTuple Attributes)

54−instance Show RelationalExprStateElems where

79+ }

55− show (RelationalExprStateTupleElems _ tup) = "RelationalExprStateTupleElems " ++ show tup

80+

56− show (RelationalExprStateAttrsElems _ attrs) = "RelationalExprStateAttrsElems" ++ show attrs

81+envTuple :: GraphRefRelationalExprEnv -> RelationTuple

57− show (RelationalExprStateElems _) = "RelationalExprStateElems"

82+envTuple e = fromLeft emptyTuple (fromMaybe (Left emptyTuple) (gre_extra e))

58−

83+

59−mkRelationalExprState :: DatabaseContext -> RelationalExprStateElems

84+envAttributes :: GraphRefRelationalExprEnv -> Attributes

60−mkRelationalExprState = RelationalExprStateElems

85+envAttributes e = fromRight emptyAttributes (fromMaybe (Right emptyAttributes) (gre_extra e))

61−

62−mergeTuplesIntoRelationalExprState :: RelationTuple -> RelationalExprStateElems -> RelationalExprStateElems

63−mergeTuplesIntoRelationalExprState tupIn (RelationalExprStateElems ctx) = RelationalExprStateTupleElems ctx tupIn

64−mergeTuplesIntoRelationalExprState _ st@(RelationalExprStateAttrsElems _ _) = st

65−mergeTuplesIntoRelationalExprState tupIn (RelationalExprStateTupleElems ctx existingTuple) = let mergedTupMap = M.union (tupleToMap tupIn) (tupleToMap existingTuple) in

66− RelationalExprStateTupleElems ctx (mkRelationTupleFromMap mergedTupMap)

68−mergeAttributesIntoRelationalExprState :: Attributes -> RelationalExprStateElems -> RelationalExprStateElems

87+instance Show RelationalExprEnv where

69−mergeAttributesIntoRelationalExprState attrs (RelationalExprStateElems ctx) = RelationalExprStateAttrsElems ctx attrs

88+ show e@RelationalExprEnv{} = "RelationalExprEnv " ++ show (re_extra e)

70−mergeAttributesIntoRelationalExprState _ st@(RelationalExprStateTupleElems _ _) = st

89+

71−mergeAttributesIntoRelationalExprState attrsIn (RelationalExprStateAttrsElems ctx attrs) = RelationalExprStateAttrsElems ctx (A.union attrsIn attrs)

90+--used to eval relationalexpr

91+type RelationalExprM a = ReaderT RelationalExprEnv (ExceptT RelationalError Identity) a

92+

93+runRelationalExprM :: RelationalExprEnv -> RelationalExprM a -> Either RelationalError a

94+runRelationalExprM env m = runIdentity (runExceptT (runReaderT m env))

95+

96+reGraph :: RelationalExprM TransactionGraph

97+reGraph = asks re_graph

98+

99+reContext :: RelationalExprM DatabaseContext

100+reContext = asks re_context

101+

102+mkRelationalExprEnv :: DatabaseContext -> TransactionGraph -> RelationalExprEnv

103+mkRelationalExprEnv ctx graph =

104+ RelationalExprEnv

105+ { re_context = ctx,

106+ re_graph = graph,

107+ re_extra = Nothing }

108+

109+askEnv :: GraphRefRelationalExprM GraphRefRelationalExprEnv

110+askEnv = R.ask

111+

112+mergeTuplesIntoGraphRefRelationalExprEnv :: RelationTuple -> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv

113+mergeTuplesIntoGraphRefRelationalExprEnv tupIn env =

114+ env { gre_extra = new_elems }

115+ where

116+ new_elems = Just (Left newTuple)

117+ mergedTupMap = M.union (tupleToMap tupIn) (tupleToMap (envTuple env))

118+ newTuple = mkRelationTupleFromMap mergedTupMap

119+

120+mergeAttributesIntoGraphRefRelationalExprEnv :: Attributes -> GraphRefRelationalExprEnv -> GraphRefRelationalExprEnv

121+mergeAttributesIntoGraphRefRelationalExprEnv attrsIn e = e { gre_extra = newattrs }

122+ where

123+ newattrs = Just (Right (A.union attrsIn (envAttributes e)))

124

73type ResultAccumName = StringType

125type ResultAccumName = StringType

126

@@ -78,416 +130,403 @@ data ResultAccum = ResultAccum { resultAccumFunc :: ResultAccumFunc,

78 resultAccumResult :: Relation

130 resultAccumResult :: Relation

79 }

131 }

132

133+data DatabaseContextEvalState = DatabaseContextEvalState {

134+ dbc_context :: DatabaseContext, --new, alterable context for a new transaction

81−type DatabaseStateElems = (DatabaseContext, M.Map ResultAccumName ResultAccum, DirtyFlag)

135+ dbc_accum :: M.Map ResultAccumName ResultAccum,

136+ dbc_dirty :: DirtyFlag

137+ }

138

83−type DatabaseState a = State DatabaseStateElems a

139+data DatabaseContextEvalEnv = DatabaseContextEvalEnv

140+ { dce_transId :: TransactionId,

141+ dce_graph :: TransactionGraph

142+ }

143

85−getStateContext :: DatabaseState DatabaseContext

144+mkDatabaseContextEvalEnv :: TransactionId -> TransactionGraph -> DatabaseContextEvalEnv

86−getStateContext = do

145+mkDatabaseContextEvalEnv = DatabaseContextEvalEnv

87− (ctx,_, _) <- get

146+

88− pure ctx

147+type DatabaseContextEvalMonad a = RWST DatabaseContextEvalEnv () DatabaseContextEvalState (ExceptT RelationalError Identity) a

89−

148+

90−putStateContext :: DatabaseContext -> DatabaseState ()

149+runDatabaseContextEvalMonad :: DatabaseContext -> DatabaseContextEvalEnv -> DatabaseContextEvalMonad () -> Either RelationalError DatabaseContextEvalState

91−putStateContext ctx = do

150+runDatabaseContextEvalMonad ctx env m = runIdentity (runExceptT (fst <$> execRWST m env freshEnv))

92− (_, accum, _) <- get

151+ where

93− put (ctx, accum, True)

152+ freshEnv = mkDatabaseContextEvalState ctx

94−

95−type RelationalExprState a = Reader RelationalExprStateElems a

96−

97−stateElemsContext :: RelationalExprStateElems -> DatabaseContext

98−stateElemsContext (RelationalExprStateTupleElems ctx _) = ctx

99−stateElemsContext (RelationalExprStateElems ctx) = ctx

100−stateElemsContext (RelationalExprStateAttrsElems ctx _) = ctx

101−

102−setStateElemsContext :: RelationalExprStateElems -> DatabaseContext -> RelationalExprStateElems

103−setStateElemsContext (RelationalExprStateTupleElems _ tup) ctx = RelationalExprStateTupleElems ctx tup

104−setStateElemsContext (RelationalExprStateElems _) ctx = RelationalExprStateElems ctx

105−setStateElemsContext (RelationalExprStateAttrsElems _ attrs) ctx = RelationalExprStateAttrsElems ctx attrs

106−

107−--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values

108−evalRelationalExpr :: RelationalExpr -> RelationalExprState (Either RelationalError Relation)

109−evalRelationalExpr (RelationVariable name _) = do

110− relvarTable <- fmap (relationVariables . stateElemsContext) ask

111− return $ case M.lookup name relvarTable of

112− Just res -> Right res

113− Nothing -> Left $ RelVarNotDefinedError name

114−

115−evalRelationalExpr (Project attrNames expr) = do

116− rel <- evalRelationalExpr expr

117− case rel of

118− Right rel2 -> return $ project attrNames rel2

119− Left err -> return $ Left err

120−

121−evalRelationalExpr (Union exprA exprB) = do

122− relA <- evalRelationalExpr exprA

123− relB <- evalRelationalExpr exprB

124− case relA of

125− Left err -> return $ Left err

126− Right relA2 -> case relB of

127− Left err -> return $ Left err

128− Right relB2 -> return $ union relA2 relB2

129−

130−evalRelationalExpr (Join exprA exprB) = do

131− relA <- evalRelationalExpr exprA

132− relB <- evalRelationalExpr exprB

133− case relA of

134− Left err -> return $ Left err

135− Right relA2 -> case relB of

136− Left err -> return $ Left err

137− Right relB2 -> return $ join relA2 relB2

138−

139−evalRelationalExpr (Difference exprA exprB) = do

140− relA <- evalRelationalExpr exprA

141− relB <- evalRelationalExpr exprB

142− case relA of

143− Left err -> return $ Left err

144− Right relA2 -> case relB of

145− Left err -> return $ Left err

146− Right relB2 -> return $ difference relA2 relB2

147−

148−evalRelationalExpr (MakeStaticRelation attributeSet tupleSet) =

149− case mkRelation attributeSet tupleSet of

150− Right rel -> return $ Right rel

151− Left err -> return $ Left err

152

153

153−evalRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do

154+

154− currentContext <- fmap stateElemsContext ask

155+dbcTransId :: DatabaseContextEvalMonad TransactionId

155− let tConss = typeConstructorMapping currentContext

156+dbcTransId = dce_transId <$> RWS.ask

156− -- if the mAttrExprs is Nothing, then we should attempt to infer the tuple attributes from the first tuple itself- note that this is not always possible

157+

157− runExceptT $ do

158+dbcGraph :: DatabaseContextEvalMonad TransactionGraph

158− mAttrs <- case mAttrExprs of

159+dbcGraph = dce_graph <$> RWS.ask

159− Just _ -> do

160+

160− attrs <- mapM (either throwE pure . evalAttrExpr tConss) (fromMaybe [] mAttrExprs)

161+dbcRelationalExprEnv :: DatabaseContextEvalMonad RelationalExprEnv

161− pure (Just (A.attributesFromList attrs))

162+dbcRelationalExprEnv =

162− Nothing -> pure Nothing

163+ mkRelationalExprEnv <$> getStateContext <*> dbcGraph

163− tuples <- mapM (liftE . evalTupleExpr mAttrs) tupleExprs

164+

164− let attrs = fromMaybe firstTupleAttrs mAttrs

165+getStateContext :: DatabaseContextEvalMonad DatabaseContext

165− firstTupleAttrs = if null tuples then A.emptyAttributes else tupleAttributes (head tuples)

166+getStateContext = gets dbc_context

166− either throwE pure (mkRelation attrs (RelationTupleSet tuples))

167+

168+putStateContext :: DatabaseContext -> DatabaseContextEvalMonad ()

169+putStateContext ctx' = do

170+ s <- get

171+ put (s {dbc_context = ctx', dbc_dirty = True})

172+

173+-- | The context is optionally passed down along in cases where the current context is uncommitted.

174+data GraphRefRelationalExprEnv =

175+ GraphRefRelationalExprEnv {

176+ gre_context :: Maybe DatabaseContext,

177+ gre_graph :: TransactionGraph,

178+ gre_extra :: Maybe (Either RelationTuple Attributes)

179+ }

167

180

168−evalRelationalExpr (ExistingRelation rel) = pure (Right rel)

181+type GraphRefRelationalExprM a = ReaderT GraphRefRelationalExprEnv (ExceptT RelationalError Identity) a

169−

182+

170−evalRelationalExpr (Rename oldAttrName newAttrName relExpr) = do

183+gfTransForId :: TransactionId -> GraphRefRelationalExprM Transaction

171− evald <- evalRelationalExpr relExpr

184+gfTransForId tid = do

172− case evald of

185+ graph <- gfGraph

173− Right rel -> return $ rename oldAttrName newAttrName rel

186+ lift $ except $ transactionForId tid graph

174− Left err -> return $ Left err

187+

175−

188+gfDatabaseContextForMarker :: GraphRefTransactionMarker -> GraphRefRelationalExprM DatabaseContext

176−evalRelationalExpr (Group oldAttrNameSet newAttrName relExpr) = do

189+gfDatabaseContextForMarker (TransactionMarker transId) = concreteDatabaseContext <$> gfTransForId transId

177− evald <- evalRelationalExpr relExpr

190+gfDatabaseContextForMarker UncommittedContextMarker = do

191+ mctx <- gre_context <$> askEnv

178− case evald of

192+ case mctx of

179− Right rel -> return $ group oldAttrNameSet newAttrName rel

193+ Nothing -> throwError NoUncommittedContextInEvalError

180− Left err -> return $ Left err

194+ Just ctx -> pure ctx

181−

195+

182−evalRelationalExpr (Ungroup attrName relExpr) = do

196+runGraphRefRelationalExprM :: GraphRefRelationalExprEnv -> GraphRefRelationalExprM a -> Either RelationalError a

183− evald <- evalRelationalExpr relExpr

197+runGraphRefRelationalExprM env m = runIdentity (runExceptT (runReaderT m env))

184− case evald of

198+

185− Right rel -> return $ ungroup attrName rel

199+freshGraphRefRelationalExprEnv :: Maybe DatabaseContext -> TransactionGraph -> GraphRefRelationalExprEnv

186− Left err -> return $ Left err

200+freshGraphRefRelationalExprEnv mctx graph = GraphRefRelationalExprEnv {

187−

201+ gre_context = mctx,

188−evalRelationalExpr (Restrict predicateExpr relExpr) = do

202+ gre_graph = graph,

189− evald <- evalRelationalExpr relExpr

203+ gre_extra = Nothing

190− case evald of

204+ }

191− Left err -> return $ Left err

205+

192− Right rel -> do

206+gfGraph :: GraphRefRelationalExprM TransactionGraph

193− eFilterFunc <- predicateRestrictionFilter (attributes rel) predicateExpr

207+gfGraph = asks gre_graph

194− case eFilterFunc of

208+

195− Left err -> return $ Left err

209+envContext :: RelationalExprEnv -> DatabaseContext

196− Right filterfunc ->

210+envContext = re_context

197− pure (restrict filterfunc rel)

211+

198−

212+setEnvContext :: RelationalExprEnv -> DatabaseContext -> RelationalExprEnv

199−evalRelationalExpr (Equals relExprA relExprB) = do

213+setEnvContext e ctx = e { re_context = ctx }

200− evaldA <- evalRelationalExpr relExprA

201− evaldB <- evalRelationalExpr relExprB

202− case evaldA of

203− Left err -> return $ Left err

204− Right relA -> case evaldB of

205− Left err -> return $ Left err

206− Right relB -> return $ Right $ if relA == relB then relationTrue else relationFalse

207−

208−--warning: copy-pasta from above- refactor

209−evalRelationalExpr (NotEquals relExprA relExprB) = do

210− evaldA <- evalRelationalExpr relExprA

211− evaldB <- evalRelationalExpr relExprB

212− case evaldA of

213− Left err -> return $ Left err

214− Right relA -> case evaldB of

215− Left err -> return $ Left err

216− Right relB -> return $ Right $ if relA /= relB then relationTrue else relationFalse

217−

218−-- extending a relation adds a single attribute with the results of the per-tuple expression evaluated

219−evalRelationalExpr (Extend tupleExpression relExpr) = do

220− rstate <- ask

221− let evald = runReader (evalRelationalExpr relExpr) rstate

222− case evald of

223− Left err -> pure (Left err)

224− Right rel -> do

225− tupProc <- extendTupleExpressionProcessor rel tupleExpression

226− case tupProc of

227− Left err -> pure (Left err)

228− Right (newAttrs, tupProc') -> pure $ relMogrify tupProc' newAttrs rel

229

214

230--helper function to process relation variable creation/assignment

215--helper function to process relation variable creation/assignment

231−setRelVar :: RelVarName -> Relation -> DatabaseState (Maybe RelationalError)

216+setRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()

232−setRelVar relVarName rel = do

217+setRelVar relVarName relExpr = do

233 currentContext <- getStateContext

218 currentContext <- getStateContext

219+ --prevent recursive relvar definition by resolving references to relvars in previous states

220+ relExpr' <- resolve relExpr

234− let newRelVars = M.insert relVarName rel $ relationVariables currentContext

221+ let newRelVars = M.insert relVarName relExpr' $ relationVariables currentContext

235 potentialContext = currentContext { relationVariables = newRelVars }

222 potentialContext = currentContext { relationVariables = newRelVars }

236−

223+ --optimization: if the relexpr is unchanged, skip the update

224+ if M.lookup relVarName (relationVariables currentContext) == Just relExpr then

225+ pure ()

226+ else do

227+ --determine when to check constraints

228+ graph <- dbcGraph

229+ tid <- dbcTransId

237− case checkConstraints potentialContext of

230+ case checkConstraints potentialContext tid graph of

238− Just err -> return $ Just err

231+ Left err -> dbErr err

239− Nothing -> do

240− putStateContext potentialContext

232+ Right _ -> putStateContext potentialContext

241− return Nothing

233+

234+--fast-path insertion- we already know that the previous relvar validated correctly, so we can validate just the relation that is being inserted for attribute matches- without this, even a single tuple relation inserted causes the entire relation to be re-validated unnecessarily

235+--insertIntoRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()

242

236

243-- it is not an error to delete a relvar which does not exist, just like it is not an error to insert a pre-existing tuple into a relation

237-- it is not an error to delete a relvar which does not exist, just like it is not an error to insert a pre-existing tuple into a relation

244−deleteRelVar :: RelVarName -> DatabaseState (Maybe RelationalError)

238+deleteRelVar :: RelVarName -> DatabaseContextEvalMonad ()

245deleteRelVar relVarName = do

239deleteRelVar relVarName = do

246 currContext <- getStateContext

240 currContext <- getStateContext

247 let relVars = relationVariables currContext

241 let relVars = relationVariables currContext

248 if M.notMember relVarName relVars then

242 if M.notMember relVarName relVars then

249− pure Nothing

243+ pure ()

250 else do

244 else do

251 let newRelVars = M.delete relVarName relVars

245 let newRelVars = M.delete relVarName relVars

252 newContext = currContext { relationVariables = newRelVars }

246 newContext = currContext { relationVariables = newRelVars }

253 putStateContext newContext

247 putStateContext newContext

254− pure Nothing

248+ pure ()

255

249

256−evalDatabaseContextExpr :: DatabaseContextExpr -> DatabaseState (Maybe RelationalError)

250+evalGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad ()

257−evalDatabaseContextExpr NoOperation = pure Nothing

251+evalGraphRefDatabaseContextExpr NoOperation = pure ()

258

252

259−evalDatabaseContextExpr (Define relVarName attrExprs) = do

253+evalGraphRefDatabaseContextExpr (Define relVarName attrExprs) = do

254+ context <- getStateContext

260 relvars <- fmap relationVariables getStateContext

255 relvars <- fmap relationVariables getStateContext

261 tConss <- fmap typeConstructorMapping getStateContext

256 tConss <- fmap typeConstructorMapping getStateContext

262− let eAttrs = map (evalAttrExpr tConss) attrExprs

257+ graph <- dbcGraph

258+ let eAttrs = runGraphRefRelationalExprM gfEnv (mapM evalGraphRefAttrExpr attrExprs)

259+ gfEnv = freshGraphRefRelationalExprEnv (Just context) graph

263− case lefts eAttrs of

260+ case eAttrs of

264− err:_ -> pure (Just err)

261+ Left err -> dbErr err

262+ Right attrsList -> do

263+ lift $ except $ validateAttributes tConss (A.attributesFromList attrsList)

265− [] -> case M.member relVarName relvars of

264+ case M.member relVarName relvars of

266− True -> return (Just (RelVarAlreadyDefinedError relVarName))

265+ True -> dbErr (RelVarAlreadyDefinedError relVarName)

267− False -> setRelVar relVarName emptyRelation >> pure Nothing

266+ False -> setRelVar relVarName (ExistingRelation emptyRelation)

268− where

267+ where

269− attrs = A.attributesFromList (rights eAttrs)

268+ attrs = A.attributesFromList attrsList

270− emptyRelation = Relation attrs emptyTupleSet

269+ emptyRelation = Relation attrs emptyTupleSet

271−

270+

272−evalDatabaseContextExpr (Undefine relVarName) = deleteRelVar relVarName

271+evalGraphRefDatabaseContextExpr (Undefine relVarName) = deleteRelVar relVarName

273−

272+

274−evalDatabaseContextExpr (Assign relVarName expr) = do

273+evalGraphRefDatabaseContextExpr (Assign relVarName expr) = do

275− -- in the future, it would be nice to get types from the RelationalExpr instead of needing to evaluate it

274+ graph <- re_graph <$> dbcRelationalExprEnv

276− context <- getStateContext

277− let existingRelVar = M.lookup relVarName relVarTable

278− relVarTable = relationVariables context

279− value = runReader (evalRelationalExpr expr) (RelationalExprStateElems context)

280− case value of

281− Left err -> return $ Just err

282− Right rel -> case existingRelVar of

283− Nothing -> setRelVar relVarName rel

284− Just existingRel -> let expectedAttributes = attributes existingRel

285− foundAttributes = attributes rel in

286− if A.attributesEqual expectedAttributes foundAttributes then

287− setRelVar relVarName rel

288− else

289− return $ Just (RelVarAssignmentTypeMismatchError expectedAttributes foundAttributes)

290−

291−evalDatabaseContextExpr (Insert relVarName relExpr) = do

292− context <- getStateContext

293− let unionexp = Union relExpr rv

294− rv = RelationVariable relVarName ()

295− unioned = runReader (evalRelationalExpr unionexp) (RelationalExprStateElems context)

296− origRel = runReader (evalRelationalExpr rv) (RelationalExprStateElems context)

297− case unioned of

298− Left err -> pure (Just err)

299− Right unioned' -> case origRel of

300− Left err -> pure (Just err)

301− Right origRel' -> if cardinality unioned' == cardinality origRel' then --no tuples actually inserted

302− pure Nothing

303− else

304− evalDatabaseContextExpr $ Assign relVarName (ExistingRelation unioned')

305−

306−evalDatabaseContextExpr (Delete relVarName predicate) = do

307 context <- getStateContext

275 context <- getStateContext

308− let rv = RelationVariable relVarName ()

276+ let existingRelVar = M.lookup relVarName (relationVariables context)

309− let updatedRel = runReader (evalRelationalExpr (Restrict (NotPredicate predicate) rv)) (RelationalExprStateElems context)

277+ reEnv = freshGraphRefRelationalExprEnv (Just context) graph

310− origRel = runReader (evalRelationalExpr rv) (RelationalExprStateElems context)

278+ eNewExprType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr)

311− case updatedRel of

279+ case existingRelVar of

280+ Nothing -> do

281+ case runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr) of

282+ Left err -> dbErr err

283+ Right reltype -> do

284+ lift $ except $ validateAttributes (typeConstructorMapping context) (attributes reltype)

285+ setRelVar relVarName expr

286+ Just existingRel -> do

287+ let eExpectedType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr existingRel)

288+ case eExpectedType of

312− Left err -> pure (Just err)

289+ Left err -> dbErr err

313− Right updatedRel' -> case origRel of

290+ Right expectedType ->

291+ case eNewExprType of

314− Left err -> pure (Just err)

292+ Left err -> dbErr err

315− Right origRel' -> if cardinality origRel' == cardinality updatedRel' then

293+ Right newExprType -> do

316− pure Nothing

294+ if newExprType == expectedType then do

295+ lift $ except $ validateAttributes (typeConstructorMapping context) (attributes newExprType)

296+ setRelVar relVarName expr

317− else

297+ else

318− setRelVar relVarName updatedRel'

298+ dbErr (RelationTypeMismatchError (attributes expectedType) (attributes newExprType))

319

299

300+evalGraphRefDatabaseContextExpr (Insert relVarName relExpr) = do

301+ gfExpr <- relVarByName relVarName

302+ let optExpr = applyUnionCollapse (Union

303+ relExpr

304+ gfExpr)

305+ evalGraphRefDatabaseContextExpr (Assign relVarName optExpr)

306+

307+evalGraphRefDatabaseContextExpr (Delete relVarName predicate) = do

308+ gfExpr <- relVarByName relVarName

309+ let optExpr = applyRestrictionCollapse (Restrict (NotPredicate predicate) gfExpr)

310+ setRelVar relVarName optExpr

311+

320--union of restricted+updated portion and the unrestricted+unupdated portion

312--union of restricted+updated portion and the unrestricted+unupdated portion

321−evalDatabaseContextExpr (Update relVarName atomExprMap restrictionPredicateExpr) = do

313+evalGraphRefDatabaseContextExpr (Update relVarName atomExprMap pred') = do

314+ rvExpr <- relVarByName relVarName

315+ graph <- re_graph <$> dbcRelationalExprEnv

322 context <- getStateContext

316 context <- getStateContext

323− let relVarTable = relationVariables context

317+ let reEnv = freshGraphRefRelationalExprEnv (Just context) graph

324− case M.lookup relVarName relVarTable of

318+ --get the current attributes name in the relvar to ensure that we don't conflict when renaming

325− Nothing -> return $ Just (RelVarNotDefinedError relVarName)

319+ eExprType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr rvExpr)

326− Just rel ->

320+ exprType' <- case eExprType of

327− case runReader (predicateRestrictionFilter (attributes rel) restrictionPredicateExpr) (RelationalExprStateElems context) of

328− Left err -> return $ Just err

321+ Left err -> throwError err

329− Right predicateFunc -> do

322+ Right t -> pure t

330− let ret = do

323+ let unrestrictedPortion = Restrict (NotPredicate pred') rvExpr

331− restrictedPortion <- restrict predicateFunc rel

324+ tmpAttr = tmpAttrC 1

332− if cardinality restrictedPortion == Finite 0 then

325+ tmpAttrC :: Int -> AttributeName -> AttributeName

333− pure Nothing

326+ tmpAttrC c attr =

327+ let tmpAttrName = "_tmp_" <> T.pack (show c) <> attr in

328+ if tmpAttrName `S.member` A.attributeNameSet (attributes exprType') then

329+ tmpAttrC (c+1) attr

334− else do

330+ else

335− unrestrictedPortion <- restrict (predicateFunc >=> (pure . not)) rel

331+ tmpAttrName

336− updatedPortion <- relMap (updateTupleWithAtomExprs atomExprMap context) restrictedPortion

332+ updateAttr nam atomExpr = Extend (AttributeExtendTupleExpr (tmpAttr nam) atomExpr)

337− updatedRel <- updatedPortion `union` unrestrictedPortion

333+ projectAndRename attr expr = Rename (tmpAttr attr) attr (Project (InvertedAttributeNames (S.singleton attr)) expr)

338− pure (Just updatedRel)

334+ restrictedPortion = Restrict pred' rvExpr

339− case ret of

335+ updated = foldr (\(oldname, atomExpr) accum ->

340− Left err -> pure (Just err)

336+ let procAtomExpr = runProcessExprM UncommittedContextMarker (processAtomExpr atomExpr) in

341− Right Nothing -> pure Nothing

337+ updateAttr oldname procAtomExpr accum

342− Right (Just updatedRel) -> setRelVar relVarName updatedRel

338+ ) restrictedPortion (M.toList atomExprMap)

343−

339+ -- the atomExprMap could reference other attributes, so we must perform multi-pass folds

340+ updatedPortion = foldr projectAndRename updated (M.keys atomExprMap)

341+ setRelVar relVarName (Union unrestrictedPortion updatedPortion)

342+

344−evalDatabaseContextExpr (AddInclusionDependency newDepName newDep) = do

343+evalGraphRefDatabaseContextExpr (AddInclusionDependency newDepName newDep) = do

345 currContext <- getStateContext

344 currContext <- getStateContext

345+ transId <- dbcTransId

346+ graph <- dbcGraph

346 let currDeps = inclusionDependencies currContext

347 let currDeps = inclusionDependencies currContext

347 newDeps = M.insert newDepName newDep currDeps

348 newDeps = M.insert newDepName newDep currDeps

348 if M.member newDepName currDeps then

349 if M.member newDepName currDeps then

349− return $ Just (InclusionDependencyNameInUseError newDepName)

350+ dbErr (InclusionDependencyNameInUseError newDepName)

350 else do

351 else do

351 let potentialContext = currContext { inclusionDependencies = newDeps }

352 let potentialContext = currContext { inclusionDependencies = newDeps }

353+ -- if the potential context passes all constraints, then save it

354+ -- potential optimization: validate only the new constraint- all old constraints must already hold

352− case checkConstraints potentialContext of

355+ case checkConstraints potentialContext transId graph of

353− Just err -> return $ Just err

356+ Left err -> dbErr err

354− Nothing -> do

357+ Right _ ->

355 putStateContext potentialContext

358 putStateContext potentialContext

356− return Nothing

357

359

358−evalDatabaseContextExpr (RemoveInclusionDependency depName) = do

360+evalGraphRefDatabaseContextExpr (RemoveInclusionDependency depName) = do

359 currContext <- getStateContext

361 currContext <- getStateContext

360 let currDeps = inclusionDependencies currContext

362 let currDeps = inclusionDependencies currContext

361 newDeps = M.delete depName currDeps

363 newDeps = M.delete depName currDeps

362 if M.notMember depName currDeps then

364 if M.notMember depName currDeps then

363− return $ Just (InclusionDependencyNameNotInUseError depName)

365+ dbErr (InclusionDependencyNameNotInUseError depName)

364− else do

366+ else

365 putStateContext $ currContext {inclusionDependencies = newDeps }

367 putStateContext $ currContext {inclusionDependencies = newDeps }

366− return Nothing

367

368

368-- | Add a notification which will send the resultExpr when triggerExpr changes between commits.

369-- | Add a notification which will send the resultExpr when triggerExpr changes between commits.

369−evalDatabaseContextExpr (AddNotification notName triggerExpr resultOldExpr resultNewExpr) = do

370+evalGraphRefDatabaseContextExpr (AddNotification notName triggerExpr resultOldExpr resultNewExpr) = do

370 currentContext <- getStateContext

371 currentContext <- getStateContext

371 let nots = notifications currentContext

372 let nots = notifications currentContext

372 if M.member notName nots then

373 if M.member notName nots then

373− return $ Just (NotificationNameInUseError notName)

374+ dbErr (NotificationNameInUseError notName)

374 else do

375 else do

375 let newNotifications = M.insert notName newNotification nots

376 let newNotifications = M.insert notName newNotification nots

376 newNotification = Notification { changeExpr = triggerExpr,

377 newNotification = Notification { changeExpr = triggerExpr,

377 reportOldExpr = resultOldExpr,

378 reportOldExpr = resultOldExpr,

378 reportNewExpr = resultNewExpr}

379 reportNewExpr = resultNewExpr}

379 putStateContext $ currentContext { notifications = newNotifications }

380 putStateContext $ currentContext { notifications = newNotifications }

380− return Nothing

381

382−evalDatabaseContextExpr (RemoveNotification notName) = do

382+evalGraphRefDatabaseContextExpr (RemoveNotification notName) = do

383 currentContext <- getStateContext

384 let nots = notifications currentContext

385 if M.notMember notName nots then

386− return $ Just (NotificationNameNotInUseError notName)

386+ dbErr (NotificationNameNotInUseError notName)

387 else do

388 let newNotifications = M.delete notName nots

389 putStateContext $ currentContext { notifications = newNotifications }

390− return Nothing

390+

391

392-- | Adds type and data constructors to the database context.

393-- validate that the type *and* constructor names are unique! not yet implemented!

394−evalDatabaseContextExpr (AddTypeConstructor tConsDef dConsDefList) = do

394+evalGraphRefDatabaseContextExpr (AddTypeConstructor tConsDef dConsDefList) = do

395 currentContext <- getStateContext

396 let oldTypes = typeConstructorMapping currentContext

397 tConsName = TCD.name tConsDef

398 -- validate that the constructor's types exist

399− case validateTypeConstructorDef tConsDef dConsDefList of

399+ case validateTypeConstructorDef tConsDef dConsDefList oldTypes of

400− errs@(_:_) -> pure $ Just (someErrors errs)

400+ Left err -> throwError err

401− [] | T.null tConsName || not (isUpper (T.head tConsName)) -> pure $ Just (InvalidAtomTypeName tConsName)

401+ Right () | T.null tConsName || not (isUpper (T.head tConsName)) -> dbErr (InvalidAtomTypeName tConsName)

402− | isJust (findTypeConstructor tConsName oldTypes) -> pure $ Just (AtomTypeNameInUseError tConsName)

402+ | isJust (findTypeConstructor tConsName oldTypes) -> dbErr (AtomTypeNameInUseError tConsName)

403 | otherwise -> do

404 let newTypes = oldTypes ++ [(tConsDef, dConsDefList)]

405 putStateContext $ currentContext { typeConstructorMapping = newTypes }

406− pure Nothing

407

406

408-- | Removing the atom constructor prevents new atoms of the type from being created. Existing atoms of the type remain. Thus, the atomTypes list in the DatabaseContext need not be all-inclusive.

407-- | Removing the atom constructor prevents new atoms of the type from being created. Existing atoms of the type remain. Thus, the atomTypes list in the DatabaseContext need not be all-inclusive.

409−evalDatabaseContextExpr (RemoveTypeConstructor tConsName) = do

408+evalGraphRefDatabaseContextExpr (RemoveTypeConstructor tConsName) = do

410 currentContext <- getStateContext

409 currentContext <- getStateContext

411 let oldTypes = typeConstructorMapping currentContext

410 let oldTypes = typeConstructorMapping currentContext

412 if isNothing (findTypeConstructor tConsName oldTypes) then

411 if isNothing (findTypeConstructor tConsName oldTypes) then

413− pure $ Just (AtomTypeNameNotInUseError tConsName)

412+ dbErr (AtomTypeNameNotInUseError tConsName)

414 else do

413 else do

415 let newTypes = filter (\(tCons, _) -> TCD.name tCons /= tConsName) oldTypes

414 let newTypes = filter (\(tCons, _) -> TCD.name tCons /= tConsName) oldTypes

416 putStateContext $ currentContext { typeConstructorMapping = newTypes }

415 putStateContext $ currentContext { typeConstructorMapping = newTypes }

417− pure Nothing

418

416

419−evalDatabaseContextExpr (MultipleExpr exprs) = do

417+evalGraphRefDatabaseContextExpr (MultipleExpr exprs) =

420 --the multiple expressions must pass the same context around- not the old unmodified context

418 --the multiple expressions must pass the same context around- not the old unmodified context

421− evald <- forM exprs evalDatabaseContextExpr

419+ mapM_ evalGraphRefDatabaseContextExpr exprs

422− --some lifting magic needed here

420+

423− case catMaybes evald of

424− [] -> pure Nothing

425− err:_ -> pure (Just err)

426−

427−evalDatabaseContextExpr (RemoveAtomFunction funcName) = do

421+evalGraphRefDatabaseContextExpr (RemoveAtomFunction funcName) = do

428 currentContext <- getStateContext

422 currentContext <- getStateContext

429 let atomFuncs = atomFunctions currentContext

423 let atomFuncs = atomFunctions currentContext

430 case atomFunctionForName funcName atomFuncs of

424 case atomFunctionForName funcName atomFuncs of

431− Left err -> pure (Just err)

425+ Left err -> dbErr err

426+ Right realFunc ->

432− Right realFunc -> if isScriptedAtomFunction realFunc then do

427+ if isScriptedAtomFunction realFunc then do

433− let updatedFuncs = HS.delete realFunc atomFuncs

428+ let updatedFuncs = HS.delete realFunc atomFuncs

434− putStateContext (currentContext {atomFunctions = updatedFuncs })

429+ putStateContext (currentContext {atomFunctions = updatedFuncs })

435− pure Nothing

436− else

430+ else

437− pure (Just (PrecompiledFunctionRemoveError funcName))

431+ dbErr (PrecompiledFunctionRemoveError funcName)

438−

439

432

440−evalDatabaseContextExpr (RemoveDatabaseContextFunction funcName) = do

433+evalGraphRefDatabaseContextExpr (RemoveDatabaseContextFunction funcName) = do

441 context <- getStateContext

434 context <- getStateContext

442 let dbcFuncs = dbcFunctions context

435 let dbcFuncs = dbcFunctions context

443 case databaseContextFunctionForName funcName dbcFuncs of

436 case databaseContextFunctionForName funcName dbcFuncs of

444− Left err -> pure (Just err)

437+ Left err -> dbErr err

438+ Right realFunc ->

445− Right realFunc -> if isScriptedDatabaseContextFunction realFunc then do

439+ if isScriptedDatabaseContextFunction realFunc then do

446− let updatedFuncs = HS.delete realFunc dbcFuncs

440+ let updatedFuncs = HS.delete realFunc dbcFuncs

447− putStateContext (context { dbcFunctions = updatedFuncs })

441+ putStateContext (context { dbcFunctions = updatedFuncs })

448− pure Nothing

449− else

442+ else

450− pure (Just (PrecompiledFunctionRemoveError funcName))

443+ dbErr (PrecompiledFunctionRemoveError funcName)

451

444

452−evalDatabaseContextExpr (ExecuteDatabaseContextFunction funcName atomArgExprs) = do

445+evalGraphRefDatabaseContextExpr (ExecuteDatabaseContextFunction funcName atomArgExprs) = do

453 context <- getStateContext

446 context <- getStateContext

447+ graph <- dbcGraph

454 --resolve atom arguments

448 --resolve atom arguments

455− let relExprState = mkRelationalExprState context

449+ let eAtomTypes = mapM (runGraphRefRelationalExprM gfEnv . typeForGraphRefAtomExpr emptyAttributes) atomArgExprs

456− eAtomTypes = map (\atomExpr -> runReader (typeFromAtomExpr emptyAttributes atomExpr) relExprState) atomArgExprs

457 eFunc = databaseContextFunctionForName funcName (dbcFunctions context)

450 eFunc = databaseContextFunctionForName funcName (dbcFunctions context)

451+ gfEnv = freshGraphRefRelationalExprEnv (Just context) graph

458 case eFunc of

452 case eFunc of

459− Left err -> pure (Just err)

453+ Left err -> dbErr err

460 Right func -> do

454 Right func -> do

461 let expectedArgCount = length (dbcFuncType func)

455 let expectedArgCount = length (dbcFuncType func)

462 actualArgCount = length atomArgExprs

456 actualArgCount = length atomArgExprs

463 if expectedArgCount /= actualArgCount then

457 if expectedArgCount /= actualArgCount then

464− pure (Just (FunctionArgumentCountMismatchError expectedArgCount actualArgCount))

458+ dbErr (FunctionArgumentCountMismatchError expectedArgCount actualArgCount)

465 else

459 else

466 --check that the atom types are valid

460 --check that the atom types are valid

467− case lefts eAtomTypes of

461+ case eAtomTypes of

468− _:_ -> pure (Just (someErrors (lefts eAtomTypes)))

462+ Left err -> dbErr err

469− [] -> do

463+ Right atomTypes -> do

470− let atomTypes = rights eAtomTypes

464+ let mValidTypes = zipWith (\ expType actType

471− let mValidTypes = map (\(expType, actType) -> case atomTypeVerify expType actType of

465+ -> case atomTypeVerify expType actType of

472− Left err -> Just err

466+ Left err -> Just err

467+ Right _ -> Nothing)

473− Right _ -> Nothing) (zip (dbcFuncType func) atomTypes)

468+ (dbcFuncType func) atomTypes

474− typeErrors = catMaybes mValidTypes

469+ typeErrors = catMaybes mValidTypes

475− eAtomArgs = map (\arg -> runReader (evalAtomExpr emptyTuple arg) relExprState) atomArgExprs

470+ eAtomArgs = map (runGraphRefRelationalExprM gfEnv . evalGraphRefAtomExpr emptyTuple) atomArgExprs

476 if length (lefts eAtomArgs) > 1 then

471 if length (lefts eAtomArgs) > 1 then

477− pure (Just (someErrors (lefts eAtomArgs)))

472+ dbErr (someErrors (lefts eAtomArgs))

478 else if not (null typeErrors) then

473 else if not (null typeErrors) then

479− pure (Just (someErrors typeErrors))

474+ dbErr (someErrors typeErrors)

480 else

475 else

481 case evalDatabaseContextFunction func (rights eAtomArgs) context of

476 case evalDatabaseContextFunction func (rights eAtomArgs) context of

482− Left err -> pure (Just err)

477+ Left err -> dbErr err

483− Right newContext -> putStateContext newContext >> pure Nothing

478+ Right newContext -> putStateContext newContext

484−

479+data DatabaseContextIOEvalEnv = DatabaseContextIOEvalEnv

485−evalDatabaseContextIOExpr :: Maybe ScriptSession -> DatabaseContext -> DatabaseContextIOExpr -> IO (Either RelationalError DatabaseContext)

480+ { dbcio_transId :: TransactionId,

481+ dbcio_graph :: TransactionGraph,

482+ dbcio_mScriptSession :: Maybe ScriptSession

483+ }

484+

485+type DatabaseContextIOEvalMonad a = RWST DatabaseContextIOEvalEnv () DatabaseContextEvalState IO a

486+

487+runDatabaseContextIOEvalMonad :: DatabaseContextIOEvalEnv -> DatabaseContext -> DatabaseContextIOEvalMonad (Either RelationalError ()) -> IO (Either RelationalError DatabaseContextEvalState)

488+runDatabaseContextIOEvalMonad env ctx m = do

489+ res <- runRWST m env freshState

490+ case res of

491+ (Left err,_,_) -> pure (Left err)

492+ (Right (),s,_) -> pure (Right s)

493+ where

494+ freshState = mkDatabaseContextEvalState ctx

495+

496+requireScriptSession :: DatabaseContextIOEvalMonad (Either RelationalError ScriptSession)

497+requireScriptSession = do

498+ env <- RWS.ask

499+ case dbcio_mScriptSession env of

500+ Nothing -> pure $ Left $ ScriptError ScriptCompilationDisabledError

501+ Just ss -> pure (Right ss)

502+

503+putDBCIOContext :: DatabaseContext -> DatabaseContextIOEvalMonad (Either RelationalError ())

504+putDBCIOContext ctx = do

505+ RWS.modify (\dbstate -> dbstate { dbc_context = ctx})

506+ pure (Right ())

507+

508+getDBCIOContext :: DatabaseContextIOEvalMonad DatabaseContext

509+getDBCIOContext = dbc_context <$> RWS.get

510+

511+getDBCIORelationalExprEnv :: DatabaseContextIOEvalMonad RelationalExprEnv

512+getDBCIORelationalExprEnv = do

513+ context <- getDBCIOContext

514+ mkRelationalExprEnv context . dbcio_graph <$> RWS.ask

515+

516+evalGraphRefDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> DatabaseContextIOEvalMonad (Either RelationalError ())

517+#if !defined(PM36_HASKELL_SCRIPTING)

518+evalGraphRefDatabaseContextIOExpr AddAtomFunction{} = pure (Left (ScriptError ScriptCompilationDisabledError))

519+evalGraphRefDatabaseContextIOExpr AddDatabaseContextFunction{} = pure (Left (ScriptError ScriptCompilationDisabledError))

520+evalGraphRefDatabaseContextIOExpr LoadAtomFunctions{} = pure (Left (ScriptError ScriptCompilationDisabledError))

521+evalGraphRefDatabaseContextIOExpr LoadDatabaseContextFunctions{} = pure (Left (ScriptError ScriptCompilationDisabledError))

522+#else

486−evalDatabaseContextIOExpr mScriptSession currentContext (AddAtomFunction funcName funcType script) =

523+evalGraphRefDatabaseContextIOExpr (AddAtomFunction funcName funcType script) = do

487− case mScriptSession of

524+ eScriptSession <- requireScriptSession

488− Nothing -> pure (Left (ScriptError ScriptCompilationDisabledError))

525+ currentContext <- getDBCIOContext

526+ case eScriptSession of

527+ Left err -> pure (Left err)

489− Just scriptSession -> do

528+ Right scriptSession -> do

490− res <- try $ runGhc (Just libdir) $ do

529+ res <- liftIO $ try $ runGhc (Just libdir) $ do

491 setSession (hscEnv scriptSession)

530 setSession (hscEnv scriptSession)

492 let atomFuncs = atomFunctions currentContext

531 let atomFuncs = atomFunctions currentContext

493 case extractAtomFunctionType funcType of

532 case extractAtomFunctionType funcType of

@@ -498,7 +537,7 @@ evalDatabaseContextIOExpr mScriptSession currentContext (AddAtomFunction funcNam

498 pure $ case eCompiledFunc of

537 pure $ case eCompiledFunc of

499 Left err -> Left (ScriptError err)

538 Left err -> Left (ScriptError err)

500 Right compiledFunc -> do

539 Right compiledFunc -> do

501− funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructor funcTypeArg (typeConstructorMapping currentContext) M.empty) adjustedAtomTypeCons

540+ funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructorValidate False funcTypeArg (typeConstructorMapping currentContext) M.empty) adjustedAtomTypeCons

502 let updatedFuncs = HS.insert newAtomFunc atomFuncs

541 let updatedFuncs = HS.insert newAtomFunc atomFuncs

503 newContext = currentContext { atomFunctions = updatedFuncs }

542 newContext = currentContext { atomFunctions = updatedFuncs }

504 newAtomFunc = AtomFunction { atomFuncName = funcName,

543 newAtomFunc = AtomFunction { atomFuncName = funcName,

@@ -513,12 +552,13 @@ evalDatabaseContextIOExpr mScriptSession currentContext (AddAtomFunction funcNam

513 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))

552 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))

514 Right eContext -> case eContext of

553 Right eContext -> case eContext of

515 Left err -> pure (Left err)

554 Left err -> pure (Left err)

516− Right context' -> pure (Right context')

555+ Right context' -> putDBCIOContext context'

517−

518−evalDatabaseContextIOExpr mScriptSession currentContext (AddDatabaseContextFunction funcName funcType script) =

556+evalGraphRefDatabaseContextIOExpr (AddDatabaseContextFunction funcName funcType script) = do

519− case mScriptSession of

557+ eScriptSession <- requireScriptSession

520− Nothing -> pure (Left (ScriptError ScriptCompilationDisabledError))

558+ currentContext <- getDBCIOContext

559+ case eScriptSession of

560+ Left err -> pure (Left err)

521− Just scriptSession -> do

561+ Right scriptSession -> do

522 --validate that the function signature is of the form x -> y -> ... -> DatabaseContext -> DatabaseContext

562 --validate that the function signature is of the form x -> y -> ... -> DatabaseContext -> DatabaseContext

523 let last2Args = reverse (take 2 (reverse funcType))

563 let last2Args = reverse (take 2 (reverse funcType))

524 atomArgs = take (length funcType - 2) funcType

564 atomArgs = take (length funcType - 2) funcType

@@ -528,7 +568,7 @@ evalDatabaseContextIOExpr mScriptSession currentContext (AddDatabaseContextFunct

528 if last2Args /= [ADTypeConstructor "DatabaseContext" [], dbContextTypeCons] then

568 if last2Args /= [ADTypeConstructor "DatabaseContext" [], dbContextTypeCons] then

529 pure (Left (ScriptError (TypeCheckCompilationError expectedType actualType)))

569 pure (Left (ScriptError (TypeCheckCompilationError expectedType actualType)))

530 else do

570 else do

531− res <- try $ runGhc (Just libdir) $ do

571+ res <- liftIO $ try $ runGhc (Just libdir) $ do

532 setSession (hscEnv scriptSession)

572 setSession (hscEnv scriptSession)

533 eCompiledFunc <- compileScript (dbcFunctionBodyType scriptSession) script

573 eCompiledFunc <- compileScript (dbcFunctionBodyType scriptSession) script

534 pure $ case eCompiledFunc of

574 pure $ case eCompiledFunc of

@@ -553,123 +593,170 @@ evalDatabaseContextIOExpr mScriptSession currentContext (AddDatabaseContextFunct

553 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))

593 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))

554 Right eContext -> case eContext of

594 Right eContext -> case eContext of

555 Left err -> pure (Left err)

595 Left err -> pure (Left err)

556− Right context' -> pure (Right context')

596+ Right context' -> putDBCIOContext context'

557−

597+evalGraphRefDatabaseContextIOExpr (LoadAtomFunctions modName funcName modPath) = do

558−

598+ currentContext <- getDBCIOContext

559−updateTupleWithAtomExprs :: M.Map AttributeName AtomExpr -> DatabaseContext -> RelationTuple -> Either RelationalError RelationTuple

599+ eLoadFunc <- liftIO $ loadAtomFunctions (T.unpack modName) (T.unpack funcName) modPath

560−updateTupleWithAtomExprs exprMap context tupIn = do

600+ case eLoadFunc of

561− --resolve all atom exprs

601+ Left LoadSymbolError -> pure (Left LoadFunctionError)

562− atomsAssoc <- mapM (\(attrName, atomExpr) -> do

602+ Right atomFunctionListFunc -> let newContext = currentContext { atomFunctions = mergedFuncs }

563− atom <- runReader (evalAtomExpr tupIn atomExpr) (RelationalExprStateElems context)

603+ mergedFuncs = HS.union (atomFunctions currentContext) (HS.fromList atomFunctionListFunc)

564− pure (attrName, atom)

604+ in putDBCIOContext newContext

565− ) (M.toList exprMap)

605+evalGraphRefDatabaseContextIOExpr (LoadDatabaseContextFunctions modName funcName modPath) = do

566− pure (updateTupleWithAtoms (M.fromList atomsAssoc) tupIn)

606+ currentContext <- getDBCIOContext

607+ eLoadFunc <- liftIO $ loadDatabaseContextFunctions (T.unpack modName) (T.unpack funcName) modPath

608+ case eLoadFunc of

609+ Left LoadSymbolError -> pure (Left LoadFunctionError)

610+ Right dbcListFunc -> let newContext = currentContext { dbcFunctions = mergedFuncs }

611+ mergedFuncs = HS.union (dbcFunctions currentContext) (HS.fromList dbcListFunc)

612+ in putDBCIOContext newContext

613+#endif

614+evalGraphRefDatabaseContextIOExpr (CreateArbitraryRelation relVarName attrExprs range) = do

615+ --Define

616+ currentContext <- getDBCIOContext

617+ env <- RWS.ask

618+ --create graph ref expr

619+ let gfExpr = Define relVarName attrExprs

620+ evalEnv = mkDatabaseContextEvalEnv (dbcio_transId env) (dbcio_graph env)

621+ graph = dbcio_graph env

622+ case runDatabaseContextEvalMonad currentContext evalEnv (evalGraphRefDatabaseContextExpr gfExpr) of

623+ Left err -> pure (Left err)

624+ Right dbstate -> do

625+ --Assign

626+ let existingRelVar = M.lookup relVarName relVarTable

627+ relVarTable = relationVariables (dbc_context dbstate)

628+ case existingRelVar of

629+ Nothing -> pure $ Left (RelVarNotDefinedError relVarName)

630+ Just existingRel -> do

631+ let gfEnv = freshGraphRefRelationalExprEnv (Just currentContext) graph

632+ case runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr existingRel) of

633+ Left err -> pure (Left err)

634+ Right relType -> do

635+ let expectedAttributes = attributes relType

636+ tcMap = typeConstructorMapping (dbc_context dbstate)

637+ eitherRel <- liftIO $ generate $ runReaderT (arbitraryRelation expectedAttributes range) tcMap

638+ case eitherRel of

639+ Left err -> pure $ Left err

640+ Right rel ->

641+ case runDatabaseContextEvalMonad currentContext evalEnv (setRelVar relVarName (ExistingRelation rel)) of

642+ Left err -> pure (Left err)

643+ Right dbstate' -> putDBCIOContext (dbc_context dbstate')

567

644

568--run verification on all constraints

645--run verification on all constraints

569−checkConstraints :: DatabaseContext -> Maybe RelationalError

646+checkConstraints :: DatabaseContext -> TransactionId -> TransactionGraph -> Either RelationalError ()

570−checkConstraints context = case failures of

647+checkConstraints context transId graph@(TransactionGraph graphHeads transSet) = do

571− [] -> Nothing

648+ mapM_ (uncurry checkIncDep) (M.toList deps)

572− l:_ -> Just l

573 where

649 where

574− failures = M.elems $ M.mapMaybeWithKey checkIncDep deps

650+ potentialGraph = TransactionGraph graphHeads (S.insert tempTrans transSet)

651+ tempStamp = UTCTime { utctDay = fromGregorian 2000 1 1,

652+ utctDayTime = secondsToDiffTime 0 }

653+ tempSchemas = Schemas context M.empty

654+ tempTrans = Transaction U.nil tempTransInfo tempSchemas

655+ tempTransInfo = TransactionInfo { parents = transId NE.:| [],

656+ stamp = tempStamp,

657+ merkleHash = mempty

658+ }

659+

575 deps = inclusionDependencies context

660 deps = inclusionDependencies context

576− eval expr = runReader (evalRelationalExpr expr) (RelationalExprStateElems context)

661+ -- no optimization available here, really? perhaps the optimizer should be passed down to here or the eval function should be passed through the environment

577 checkIncDep depName (InclusionDependency subsetExpr supersetExpr) = do

662 checkIncDep depName (InclusionDependency subsetExpr supersetExpr) = do

578− let checkExpr = Equals supersetExpr (Union subsetExpr supersetExpr)

663+ let process = runProcessExprM UncommittedContextMarker

579− case eval checkExpr of

664+ gfSubsetExpr = process (processRelationalExpr subsetExpr)

665+ gfSupersetExpr = process (processRelationalExpr supersetExpr)

666+ --if both expressions are of a single-attribute (such as with a simple foreign key), the names of the attributes are irrelevant (they need not match) because the expression is unambiguous, but special-casing this to rename the attribute automatically would not be orthogonal behavior and probably cause confusion. Instead, special case the error to make it clear.

667+ let gfEnv = freshGraphRefRelationalExprEnv (Just context) graph

668+ runGfRel = runGraphRefRelationalExprM gfEnv

669+ typeSub <- runGfRel (typeForGraphRefRelationalExpr gfSubsetExpr)

670+ typeSuper <- runGfRel (typeForGraphRefRelationalExpr gfSupersetExpr)

671+ when (typeSub /= typeSuper) (Left (RelationTypeMismatchError (attributes typeSub) (attributes typeSuper)))

672+ let checkExpr = Equals gfSupersetExpr (Union gfSubsetExpr gfSupersetExpr)

673+ gfEvald = runGraphRefRelationalExprM gfEnv' (evalGraphRefRelationalExpr checkExpr)

674+ gfEnv' = freshGraphRefRelationalExprEnv (Just context) potentialGraph

675+ case gfEvald of

580− Left err -> Just err

676+ Left err -> Left err

581 Right resultRel -> if resultRel == relationTrue then

677 Right resultRel -> if resultRel == relationTrue then

582− Nothing

678+ pure ()

583 else

679 else

584− Just $ InclusionDependencyCheckError depName

680+ Left (InclusionDependencyCheckError depName)

585

681

586-- the type of a relational expression is equal to the relation attribute set returned from executing the relational expression; therefore, the type can be cheaply derived by evaluating a relational expression and ignoring and tuple processing

682-- the type of a relational expression is equal to the relation attribute set returned from executing the relational expression; therefore, the type can be cheaply derived by evaluating a relational expression and ignoring and tuple processing

587-- furthermore, the type of a relational expression is the resultant header of the evaluated empty-tupled relation

683-- furthermore, the type of a relational expression is the resultant header of the evaluated empty-tupled relation

588

684

589−typeForRelationalExpr :: RelationalExpr -> RelationalExprState (Either RelationalError Relation)

685+typeForRelationalExpr :: RelationalExpr -> RelationalExprM Relation

590typeForRelationalExpr expr = do

686typeForRelationalExpr expr = do

591− rstate <- ask

592− let context = stateElemsContext rstate

593 --replace the relationVariables context element with a cloned set of relation devoid of tuples

687 --replace the relationVariables context element with a cloned set of relation devoid of tuples

594− let context' = contextWithEmptyTupleSets context

688+ --evalRelationalExpr could still return an existing relation with tuples, so strip them

595− rstate' = setStateElemsContext rstate context'

689+ graph <- reGraph

596− pure (runReader (evalRelationalExpr expr) rstate')

690+ context <- reContext

597−

691+ let gfExpr = runProcessExprM UncommittedContextMarker (processRelationalExpr expr)

598−--returns a database context with all tuples removed

692+ gfEnv = freshGraphRefRelationalExprEnv (Just context) graph

599−--this is useful for type checking and optimization

693+ runGf = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr gfExpr)

600−contextWithEmptyTupleSets :: DatabaseContext -> DatabaseContext

694+ lift $ except runGf

601−contextWithEmptyTupleSets contextIn = contextIn { relationVariables = relVars }

602− where

603− relVars = M.map (\rel -> Relation (attributes rel) emptyTupleSet) (relationVariables contextIn)

604

695

605liftE :: (Monad m) => m (Either a b) -> ExceptT a m b

696liftE :: (Monad m) => m (Either a b) -> ExceptT a m b

606liftE v = do

697liftE v = do

607 y <- lift v

698 y <- lift v

608 case y of

699 case y of

609− Left err -> throwE err

700+ Left err -> throwError err

610 Right val -> pure val

701 Right val -> pure val

611

702

612{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}

703{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}

613−predicateRestrictionFilter :: Attributes -> RestrictionPredicateExpr -> RelationalExprState (Either RelationalError RestrictionFilter)

704+predicateRestrictionFilter :: Attributes -> GraphRefRestrictionPredicateExpr -> GraphRefRelationalExprM RestrictionFilter

614−predicateRestrictionFilter attrs (AndPredicate expr1 expr2) =

705+predicateRestrictionFilter attrs (AndPredicate expr1 expr2) = do

615− runExceptT $ do

616− expr1v <- liftE (predicateRestrictionFilter attrs expr1)

706+ expr1v <- predicateRestrictionFilter attrs expr1

617− expr2v <- liftE (predicateRestrictionFilter attrs expr2)

707+ expr2v <- predicateRestrictionFilter attrs expr2

618− pure (\x -> do

708+ pure (\x -> do

619− ev1 <- expr1v x

709+ ev1 <- expr1v x

620− ev2 <- expr2v x

710+ ev2 <- expr2v x

621− pure (ev1 && ev2))

711+ pure (ev1 && ev2))

622

712

623−predicateRestrictionFilter attrs (OrPredicate expr1 expr2) =

713+predicateRestrictionFilter attrs (OrPredicate expr1 expr2) = do

624− runExceptT $ do

625− expr1v <- liftE (predicateRestrictionFilter attrs expr1)

714+ expr1v <- predicateRestrictionFilter attrs expr1

626− expr2v <- liftE (predicateRestrictionFilter attrs expr2)

715+ expr2v <- predicateRestrictionFilter attrs expr2

627 pure (\x -> do

716 pure (\x -> do

628 ev1 <- expr1v x

717 ev1 <- expr1v x

629 ev2 <- expr2v x

718 ev2 <- expr2v x

630 pure (ev1 || ev2))

719 pure (ev1 || ev2))

631

720

632−predicateRestrictionFilter _ TruePredicate = pure (Right (\_ -> pure True))

721+predicateRestrictionFilter _ TruePredicate = pure (\_ -> pure True)

633

722

634−predicateRestrictionFilter attrs (NotPredicate expr) =

723+predicateRestrictionFilter attrs (NotPredicate expr) = do

635− runExceptT $ do

636− exprv <- liftE (predicateRestrictionFilter attrs expr)

724+ exprv <- predicateRestrictionFilter attrs expr

637− pure (\x -> do

725+ pure (fmap not . exprv)

638− ev <- exprv x

639− pure (not ev))

640

726

641--optimization opportunity: if the subexpression does not reference attributes in the top-level expression, then it need only be evaluated once, statically, outside the tuple filter- see historical implementation here

727--optimization opportunity: if the subexpression does not reference attributes in the top-level expression, then it need only be evaluated once, statically, outside the tuple filter- see historical implementation here

642predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = do

728predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = do

643− rstate <- ask

729+ renv <- askEnv

644− pure (Right (\tup -> case runReader (evalRelationalExpr relExpr) (mergeTuplesIntoRelationalExprState tup rstate) of

730+ let eval :: RelationTuple -> Either RelationalError Relation

731+ eval tup =

732+ let gfEnv = mergeTuplesIntoGraphRefRelationalExprEnv tup renv in

733+ runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr relExpr)

734+ pure (\tup -> case eval tup of

645 Left err -> Left err

735 Left err -> Left err

646 Right rel -> if arity rel /= 0 then

736 Right rel -> if arity rel /= 0 then

647 Left (PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'")

737 Left (PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'")

648 else

738 else

649− pure (rel == relationTrue)))

739+ pure (rel == relationTrue))

650

740

651predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do

741predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do

652− rstate <- ask

742+ env <- askEnv

653− let (attrs', ctxtup') = case rstate of

743+ let attrs' = A.union attrs (envAttributes env)

654− RelationalExprStateElems _ -> (attrs, emptyTuple)

744+ ctxtup' = envTuple env

655− RelationalExprStateAttrsElems _ _ -> (attrs, emptyTuple)

656− RelationalExprStateTupleElems _ ctxtup -> (A.union attrs (tupleAttributes ctxtup), ctxtup)

657− runExceptT $ do

658− atomExprType <- liftE (typeFromAtomExpr attrs' atomExpr)

745+ atomExprType <- typeForGraphRefAtomExpr attrs' atomExpr

659− attr <- either throwE pure $ case A.attributeForName attrName attrs of

746+ attr <- lift $ except $ case A.attributeForName attrName attrs of

660 Right attr -> Right attr

747 Right attr -> Right attr

661 Left (NoSuchAttributeNamesError _) -> case A.attributeForName attrName (tupleAttributes ctxtup') of

748 Left (NoSuchAttributeNamesError _) -> case A.attributeForName attrName (tupleAttributes ctxtup') of

662 Right ctxattr -> Right ctxattr

749 Right ctxattr -> Right ctxattr

663 Left err2@(NoSuchAttributeNamesError _) -> Left err2

750 Left err2@(NoSuchAttributeNamesError _) -> Left err2

664 Left err -> Left err

751 Left err -> Left err

665 Left err -> Left err

752 Left err -> Left err

666− if atomExprType /= A.atomType attr then

753+ if atomExprType /= A.atomType attr then

667− throwE (TupleAttributeTypeMismatchError (A.attributesFromList [attr]))

754+ throwError (TupleAttributeTypeMismatchError (A.attributesFromList [attr]))

668− else

755+ else

669 pure $ \tupleIn -> let evalAndCmp atomIn = case atomEvald of

756 pure $ \tupleIn -> let evalAndCmp atomIn = case atomEvald of

670 Right atomCmp -> atomCmp == atomIn

757 Right atomCmp -> atomCmp == atomIn

671 Left _ -> False

758 Left _ -> False

672− atomEvald = runReader (evalAtomExpr tupleIn atomExpr) rstate

759+ atomEvald = runGraphRefRelationalExprM env (evalGraphRefAtomExpr tupleIn atomExpr)

673 in

760 in

674 pure $ case atomForAttributeName attrName tupleIn of

761 pure $ case atomForAttributeName attrName tupleIn of

675 Left (NoSuchAttributeNamesError _) -> case atomForAttributeName attrName ctxtup' of

762 Left (NoSuchAttributeNamesError _) -> case atomForAttributeName attrName ctxtup' of

@@ -680,195 +767,626 @@ predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr)

680-- in the future, it would be useful to do typechecking on the attribute and atom expr filters in advance

767-- in the future, it would be useful to do typechecking on the attribute and atom expr filters in advance

681predicateRestrictionFilter attrs (AtomExprPredicate atomExpr) = do

768predicateRestrictionFilter attrs (AtomExprPredicate atomExpr) = do

682 --merge attrs into the state attributes

769 --merge attrs into the state attributes

683− rstate <- ask

770+ renv <- askEnv

684− runExceptT $ do

685− aType <- liftE (typeFromAtomExpr attrs atomExpr)

771+ aType <- typeForGraphRefAtomExpr attrs atomExpr

686− if aType /= BoolAtomType then

772+ if aType /= BoolAtomType then

687− throwE (AtomTypeMismatchError aType BoolAtomType)

773+ throwError (AtomTypeMismatchError aType BoolAtomType)

688− else

774+ else

689 pure (\tupleIn ->

775 pure (\tupleIn ->

690− pure $ case runReader (evalAtomExpr tupleIn atomExpr) rstate of

776+ case runGraphRefRelationalExprM renv (evalGraphRefAtomExpr tupleIn atomExpr) of

691− Left _ -> False

777+ Left err -> Left err

692− Right boolAtomValue -> boolAtomValue == BoolAtom True)

778+ Right boolAtomValue -> pure (boolAtomValue == BoolAtom True))

693

779

694tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation

780tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation

695tupleExprCheckNewAttrName attrName rel = if isRight (attributeForName attrName rel) then

781tupleExprCheckNewAttrName attrName rel = if isRight (attributeForName attrName rel) then

696− Left (error "SPAMMIT" $ AttributeNameInUseError attrName)

782+ Left (AttributeNameInUseError attrName)

697 else

783 else

698 Right rel

784 Right rel

699

785

700−extendTupleExpressionProcessor :: Relation -> ExtendTupleExpr -> RelationalExprState (Either RelationalError (Attributes, RelationTuple -> Either RelationalError RelationTuple))

786+extendGraphRefTupleExpressionProcessor :: Relation -> GraphRefExtendTupleExpr -> GraphRefRelationalExprM (Attributes, RelationTuple -> Either RelationalError RelationTuple)

701−extendTupleExpressionProcessor relIn (AttributeExtendTupleExpr newAttrName atomExpr) = do

787+extendGraphRefTupleExpressionProcessor relIn (AttributeExtendTupleExpr newAttrName atomExpr) =

702− rstate <- ask

788+-- renv <- askEnv

703 -- check that the attribute name is not in use

789 -- check that the attribute name is not in use

704 case tupleExprCheckNewAttrName newAttrName relIn of

790 case tupleExprCheckNewAttrName newAttrName relIn of

705− Left err -> pure (Left err)

791+ Left err -> throwError err

706− Right _ -> runExceptT $ do

792+ Right _ -> do

707− atomExprType <- liftE (typeFromAtomExpr (attributes relIn) atomExpr)

793+ atomExprType <- typeForGraphRefAtomExpr (attributes relIn) atomExpr

708− atomExprType' <- liftE (verifyAtomExprTypes relIn atomExpr atomExprType)

794+ atomExprType' <- verifyGraphRefAtomExprTypes relIn atomExpr atomExprType

709 let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType']

795 let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType']

710 newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

796 newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

711− pure (newAndOldAttrs, \tup -> let substate = mergeTuplesIntoRelationalExprState tup rstate in case runReader (evalAtomExpr tup atomExpr) substate of

797+ env <- ask

712− Left err -> Left err

798+ pure (newAndOldAttrs, \tup -> do

799+ let gfEnv = mergeTuplesIntoGraphRefRelationalExprEnv tup env

800+ atom <- runGraphRefRelationalExprM gfEnv (evalGraphRefAtomExpr tup atomExpr)

713− Right atom -> Right (tupleAtomExtend newAttrName atom tup)

801+ Right (tupleAtomExtend newAttrName atom tup)

714 )

802 )

715

803

716−evalAtomExpr :: RelationTuple -> AtomExpr -> RelationalExprState (Either RelationalError Atom)

804+evalGraphRefAtomExpr :: RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom

805+evalGraphRefAtomExpr tupIn (AttributeAtomExpr attrName) =

717−evalAtomExpr tupIn (AttributeAtomExpr attrName) = case atomForAttributeName attrName tupIn of

806+ case atomForAttributeName attrName tupIn of

718− Right atom -> pure (Right atom)

807+ Right atom -> pure atom

719− err@(Left (NoSuchAttributeNamesError _)) -> do

808+ Left err@(NoSuchAttributeNamesError _) -> do

720− rstate <- ask

809+ env <- askEnv

721− case rstate of

810+ case gre_extra env of

722− RelationalExprStateElems _ -> pure err

811+ Nothing -> throwError err

723− RelationalExprStateAttrsElems _ _ -> pure err

724− RelationalExprStateTupleElems _ ctxtup -> pure (atomForAttributeName attrName ctxtup)

812+ Just (Left ctxtup) -> lift $ except $ atomForAttributeName attrName ctxtup

813+ Just (Right _) -> throwError err

725− Left err -> pure (Left err)

814+ Left err -> throwError err

726−evalAtomExpr _ (NakedAtomExpr atom) = pure (Right atom)

815+evalGraphRefAtomExpr _ (NakedAtomExpr atom) = pure atom

727−evalAtomExpr tupIn (FunctionAtomExpr funcName arguments ()) = do

816+evalGraphRefAtomExpr tupIn (FunctionAtomExpr funcName arguments tid) = do

728− argTypes <- mapM (typeFromAtomExpr (tupleAttributes tupIn)) arguments

817+ argTypes <- mapM (typeForGraphRefAtomExpr (tupleAttributes tupIn)) arguments

729− context <- fmap stateElemsContext ask

818+ context <- gfDatabaseContextForMarker tid

730− runExceptT $ do

731− let functions = atomFunctions context

819+ let functions = atomFunctions context

732− func <- either throwE pure (atomFunctionForName funcName functions)

820+ func <- lift $ except (atomFunctionForName funcName functions)

733− let expectedArgCount = length (atomFuncType func) - 1

821+ let expectedArgCount = length (atomFuncType func) - 1

734− actualArgCount = length argTypes

822+ actualArgCount = length argTypes

735− safeInit [_] = []

736− safeInit [] = [] -- different behavior from normal init

823+ safeInit [] = [] -- different behavior from normal init

737− safeInit (_:xs) = safeInit xs

824+ safeInit xs = init xs

738− if expectedArgCount /= actualArgCount then

825+ if expectedArgCount /= actualArgCount then

739− throwE (FunctionArgumentCountMismatchError expectedArgCount actualArgCount)

826+ throwError (FunctionArgumentCountMismatchError expectedArgCount actualArgCount)

740− else do

827+ else do

741− _ <- mapM (\(expType, actType) -> either throwE pure (atomTypeVerify expType actType)) (safeInit (zip (atomFuncType func) argTypes))

828+ let zippedArgs = zip (safeInit (atomFuncType func)) argTypes

829+ mapM_ (\(expType, actType) ->

830+ lift $ except (atomTypeVerify expType actType)) zippedArgs

742− evaldArgs <- mapM (liftE . evalAtomExpr tupIn) arguments

831+ evaldArgs <- mapM (evalGraphRefAtomExpr tupIn) arguments

743 case evalAtomFunction func evaldArgs of

832 case evalAtomFunction func evaldArgs of

744− Left err -> throwE (AtomFunctionUserError err)

833+ Left err -> throwError (AtomFunctionUserError err)

745 Right result -> do

834 Right result -> do

746 --validate that the result matches the expected type

835 --validate that the result matches the expected type

747− _ <- either throwE pure (atomTypeVerify (last (atomFuncType func)) (atomTypeForAtom result))

836+ _ <- lift $ except (atomTypeVerify (last (atomFuncType func)) (atomTypeForAtom result))

748 pure result

837 pure result

749−evalAtomExpr tupIn (RelationAtomExpr relExpr) = do

838+evalGraphRefAtomExpr tupIn (RelationAtomExpr relExpr) = do

750 --merge existing state tuple context into new state tuple context to support an arbitrary number of levels, but new attributes trounce old attributes

839 --merge existing state tuple context into new state tuple context to support an arbitrary number of levels, but new attributes trounce old attributes

751− rstate <- ask

840+ env <- ask

752− runExceptT $ do

841+ let gfEnv = mergeTuplesIntoGraphRefRelationalExprEnv tupIn env

753− let newState = mergeTuplesIntoRelationalExprState tupIn rstate

842+ relAtom <- lift $ except $ runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr relExpr)

754− relAtom <- either throwE pure (runReader (evalRelationalExpr relExpr) newState)

755− pure (RelationAtom relAtom)

843+ pure (RelationAtom relAtom)

756−evalAtomExpr tupIn cons@(ConstructedAtomExpr dConsName dConsArgs ()) = runExceptT $ do

844+evalGraphRefAtomExpr tupIn cons@(ConstructedAtomExpr dConsName dConsArgs _) = do --why is the tid unused here? suspicious

757− rstate <- lift ask

845+ let mergeEnv = mergeTuplesIntoGraphRefRelationalExprEnv tupIn

758− let newState = mergeTuplesIntoRelationalExprState tupIn rstate

759− aType <- either throwE pure (runReader (typeFromAtomExpr (tupleAttributes tupIn) cons) newState)

846+ aType <- local mergeEnv (typeForGraphRefAtomExpr (tupleAttributes tupIn) cons)

760− argAtoms <- mapM (\arg -> either throwE pure (runReader (evalAtomExpr tupIn arg) newState)) dConsArgs

847+ argAtoms <- local mergeEnv $

848+ mapM (evalGraphRefAtomExpr tupIn) dConsArgs

761 pure (ConstructedAtom dConsName aType argAtoms)

849 pure (ConstructedAtom dConsName aType argAtoms)

762

850

763−typeFromAtomExpr :: Attributes -> AtomExpr -> RelationalExprState (Either RelationalError AtomType)

851+typeForGraphRefAtomExpr :: Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType

764−typeFromAtomExpr attrs (AttributeAtomExpr attrName) = do

852+typeForGraphRefAtomExpr attrs (AttributeAtomExpr attrName) = do

765− rstate <- ask

853+ renv <- askEnv

766 case A.atomTypeForAttributeName attrName attrs of

854 case A.atomTypeForAttributeName attrName attrs of

767− Right aType -> pure (Right aType)

855+ Right aType -> pure aType

768− Left err@(NoSuchAttributeNamesError _) -> case rstate of

856+ Left err@(NoSuchAttributeNamesError _) ->

857+ let envTup = envTuple renv

858+ envAttrs = envAttributes renv in

769− RelationalExprStateAttrsElems _ attrs' -> case A.attributeForName attrName attrs' of

859+ case A.attributeForName attrName envAttrs of

770− Left err' -> pure (Left err')

771− Right attr -> pure (Right (A.atomType attr))

860+ Right attr -> pure (A.atomType attr)

772− RelationalExprStateElems _ -> pure (Left err)

773− RelationalExprStateTupleElems _ tup -> case atomForAttributeName attrName tup of

861+ Left _ -> case atomForAttributeName attrName envTup of

774− Left err' -> pure (Left err')

862+ Right atom -> pure (atomTypeForAtom atom)

775− Right atom -> pure (Right (atomTypeForAtom atom))

863+ Left _ -> --throwError (traceStack (show ("typeForGRAtomExpr", attrs, envTup)) err)

864+ throwError err

776− Left err -> pure (Left err)

865+ Left err -> throwError err

866+

777−typeFromAtomExpr _ (NakedAtomExpr atom) = pure (Right (atomTypeForAtom atom))

867+typeForGraphRefAtomExpr _ (NakedAtomExpr atom) = pure (atomTypeForAtom atom)

778−typeFromAtomExpr attrs (FunctionAtomExpr funcName atomArgs _) = do

868+typeForGraphRefAtomExpr attrs (FunctionAtomExpr funcName atomArgs transId) = do

779− context <- fmap stateElemsContext ask

869+ funcs <- atomFunctions <$> gfDatabaseContextForMarker transId

780− let funcs = atomFunctions context

781 case atomFunctionForName funcName funcs of

870 case atomFunctionForName funcName funcs of

782− Left err -> pure (Left err)

871+ Left err -> throwError err

783 Right func -> do

872 Right func -> do

784 let funcRetType = last (atomFuncType func)

873 let funcRetType = last (atomFuncType func)

785 funcArgTypes = init (atomFuncType func)

874 funcArgTypes = init (atomFuncType func)

786− eArgTypes <- mapM (typeFromAtomExpr attrs) atomArgs

875+ argTypes <- mapM (typeForGraphRefAtomExpr attrs) atomArgs

787− case lefts eArgTypes of

788− errs@(_:_) -> pure (Left (someErrors errs))

789− [] -> do

790− let eTvMap = resolveTypeVariables funcArgTypes argTypes

876+ let eTvMap = resolveTypeVariables funcArgTypes argTypes

791− argTypes = rights eArgTypes

792− case eTvMap of

877+ case eTvMap of

793− Left err -> pure (Left err)

878+ Left err -> throwError err

794− Right tvMap -> pure (resolveFunctionReturnValue funcName tvMap funcRetType)

879+ Right tvMap -> lift $ except $ resolveFunctionReturnValue funcName tvMap funcRetType

795−typeFromAtomExpr attrs (RelationAtomExpr relExpr) = runExceptT $ do

880+typeForGraphRefAtomExpr attrs (RelationAtomExpr relExpr) = do

796− rstate <- lift ask

881+ relType <- R.local (mergeAttributesIntoGraphRefRelationalExprEnv attrs) (typeForGraphRefRelationalExpr relExpr)

797− relType <- either throwE pure (runReader (typeForRelationalExpr relExpr) (mergeAttributesIntoRelationalExprState attrs rstate))

798 pure (RelationAtomType (attributes relType))

882 pure (RelationAtomType (attributes relType))

799-- grab the type of the data constructor, then validate that the args match the expected types

883-- grab the type of the data constructor, then validate that the args match the expected types

800−typeFromAtomExpr attrs (ConstructedAtomExpr dConsName dConsArgs _) =

884+typeForGraphRefAtomExpr attrs (ConstructedAtomExpr dConsName dConsArgs tid) =

801− runExceptT $ do

885+ do

802− argsTypes <- mapM (liftE . typeFromAtomExpr attrs) dConsArgs

886+ argsTypes <- mapM (typeForGraphRefAtomExpr attrs) dConsArgs

803− context <- fmap stateElemsContext (lift ask)

887+ tConsMap <- typeConstructorMapping <$> gfDatabaseContextForMarker tid

804− aType <- either throwE pure (atomTypeForDataConstructor (typeConstructorMapping context) dConsName argsTypes)

888+ lift $ except $ atomTypeForDataConstructor tConsMap dConsName argsTypes

805− pure aType

806

889

807-- | Validate that the type of the AtomExpr matches the expected type.

890-- | Validate that the type of the AtomExpr matches the expected type.

808−verifyAtomExprTypes :: Relation -> AtomExpr -> AtomType -> RelationalExprState (Either RelationalError AtomType)

891+verifyGraphRefAtomExprTypes :: Relation -> GraphRefAtomExpr -> AtomType -> GraphRefRelationalExprM AtomType

809−verifyAtomExprTypes relIn (AttributeAtomExpr attrName) expectedType = runExceptT $ do

892+verifyGraphRefAtomExprTypes relIn (AttributeAtomExpr attrName) expectedType = do

810− rstate <- lift ask

893+ env <- askEnv

811 case A.atomTypeForAttributeName attrName (attributes relIn) of

894 case A.atomTypeForAttributeName attrName (attributes relIn) of

812− Right aType -> either throwE pure (atomTypeVerify expectedType aType)

895+ Right aType -> lift $ except $ atomTypeVerify expectedType aType

813− (Left err@(NoSuchAttributeNamesError _)) -> case rstate of

896+ (Left err@(NoSuchAttributeNamesError _)) ->

814− RelationalExprStateTupleElems _ _ -> throwE err

897+ let attrs' = envAttributes env in

815− RelationalExprStateElems _ -> throwE err

898+ if attrs' == emptyAttributes then

899+ throwError err

900+ else

816− RelationalExprStateAttrsElems _ attrs -> case A.attributeForName attrName attrs of

901+ case A.attributeForName attrName attrs' of

817− Left err' -> throwE err'

902+ Left err' -> throwError err'

818− Right attrType -> either throwE pure (atomTypeVerify expectedType (A.atomType attrType))

903+ Right attrType -> lift $ except $ atomTypeVerify expectedType (A.atomType attrType)

819− Left err -> throwE err

904+ Left err -> throwError err

905+

906+verifyGraphRefAtomExprTypes _ (NakedAtomExpr atom) expectedType =

820−verifyAtomExprTypes _ (NakedAtomExpr atom) expectedType = pure (atomTypeVerify expectedType (atomTypeForAtom atom))

907+ lift $ except $ atomTypeVerify expectedType (atomTypeForAtom atom)

821−verifyAtomExprTypes relIn (FunctionAtomExpr funcName funcArgExprs _) expectedType = do

908+verifyGraphRefAtomExprTypes relIn (FunctionAtomExpr funcName funcArgExprs tid) expectedType = do

822− rstate <- ask

909+ context <- gfDatabaseContextForMarker tid

823 let functions = atomFunctions context

910 let functions = atomFunctions context

824− context = stateElemsContext rstate

825− runExceptT $ do

826− func <- either throwE pure (atomFunctionForName funcName functions)

911+ func <- lift $ except $ atomFunctionForName funcName functions

827− let expectedArgTypes = atomFuncType func

912+ let expectedArgTypes = atomFuncType func

828− funcArgTypes <- mapM (\(atomExpr,expectedType2,argCount) -> case runReader (verifyAtomExprTypes relIn atomExpr expectedType2) rstate of

913+ funcArgVerifier (atomExpr, expectedType2, argCount) = do

914+ let handler :: RelationalError -> GraphRefRelationalExprM AtomType

829− Left (AtomTypeMismatchError expSubType actSubType) -> throwE (AtomFunctionTypeError funcName argCount expSubType actSubType)

915+ handler (AtomTypeMismatchError expSubType actSubType) = throwError (AtomFunctionTypeError funcName argCount expSubType actSubType)

830− Left err -> throwE err

916+ handler err = throwError err

831− Right x -> pure x

917+ verifyGraphRefAtomExprTypes relIn atomExpr expectedType2 `catchError` handler

832− ) $ zip3 funcArgExprs expectedArgTypes [1..]

918+ funcArgTypes <- mapM funcArgVerifier $ zip3 funcArgExprs expectedArgTypes [1..]

833− if length funcArgTypes /= length expectedArgTypes - 1 then

919+ if length funcArgTypes /= length expectedArgTypes - 1 then

834− throwE (AtomTypeCountError funcArgTypes expectedArgTypes)

920+ throwError (AtomTypeCountError funcArgTypes expectedArgTypes)

835 else

921 else

836− either throwE pure (atomTypeVerify expectedType (last expectedArgTypes))

922+ lift $ except $ atomTypeVerify expectedType (last expectedArgTypes)

837−verifyAtomExprTypes relIn (RelationAtomExpr relationExpr) expectedType = runExceptT $ do

923+verifyGraphRefAtomExprTypes relIn (RelationAtomExpr relationExpr) expectedType =

838− rstate <- lift ask

924+ do

839− relType <- either throwE pure (runReader (typeForRelationalExpr relationExpr) (mergeAttributesIntoRelationalExprState (attributes relIn) rstate))

925+ let mergedAttrsEnv e = mergeAttributesIntoGraphRefRelationalExprEnv (attributes relIn) e

926+ relType <- R.local mergedAttrsEnv (typeForGraphRefRelationalExpr relationExpr)

840− either throwE pure (atomTypeVerify expectedType (RelationAtomType (attributes relType)))

927+ lift $ except $ atomTypeVerify expectedType (RelationAtomType (attributes relType))

841−verifyAtomExprTypes rel cons@ConstructedAtomExpr{} expectedType = runExceptT $ do

928+verifyGraphRefAtomExprTypes rel cons@ConstructedAtomExpr{} expectedType = do

842− cType <- liftE (typeFromAtomExpr (attributes rel) cons)

929+ cType <- typeForGraphRefAtomExpr (attributes rel) cons

843− either throwE pure (atomTypeVerify expectedType cType)

930+ lift $ except $ atomTypeVerify expectedType cType

844

931

845-- | Look up the type's name and create a new attribute.

932-- | Look up the type's name and create a new attribute.

846−evalAttrExpr :: TypeConstructorMapping -> AttributeExpr -> Either RelationalError Attribute

933+evalGraphRefAttrExpr :: GraphRefAttributeExpr -> GraphRefRelationalExprM Attribute

847−evalAttrExpr aTypes (AttributeAndTypeNameExpr attrName tCons ()) = do

934+evalGraphRefAttrExpr (AttributeAndTypeNameExpr attrName tCons transId) = do

848− aType <- atomTypeForTypeConstructor tCons aTypes M.empty

935+ tConsMap <- typeConstructorMapping <$> gfDatabaseContextForMarker transId

849− Right (Attribute attrName aType)

936+ aType <- lift $ except $ atomTypeForTypeConstructorValidate True tCons tConsMap M.empty

850−

937+ lift $ except $ validateAtomType aType tConsMap

851−evalAttrExpr _ (NakedAttributeExpr attr) = Right attr

938+ pure $ Attribute attrName aType

852

939

853−evalTupleExpr :: Maybe Attributes -> TupleExpr -> RelationalExprState (Either RelationalError RelationTuple)

940+evalGraphRefAttrExpr (NakedAttributeExpr attr) = pure attr

941+

942+-- for tuple type concrete resolution (Nothing ==> Maybe Int) when the attributes hint is Nothing, we need to first process all the tuples, then extract the concrete types on a per-attribute basis, then reprocess the tuples to include the concrete types

943+evalGraphRefTupleExprs :: Maybe Attributes -> GraphRefTupleExprs -> GraphRefRelationalExprM [RelationTuple]

944+evalGraphRefTupleExprs _ (TupleExprs _ []) = pure []

945+evalGraphRefTupleExprs mAttrs (TupleExprs fixedMarker tupleExprL) = do

946+ tuples <- mapM (evalGraphRefTupleExpr mAttrs) tupleExprL

947+ finalAttrs <- case mAttrs of

948+ Just attrs -> pure attrs

949+ Nothing ->

950+ case tuples of

951+ [] -> pure emptyAttributes

952+ (headTuple:tailTuples) -> do

953+ --gather up resolved atom types or throw an error if an attribute cannot be made concrete from the inferred types- this could still fail if the type cannot be inferred (e.g. from [Nothing, Nothing])

954+ let

955+ processTupleAttrs (tupAttr, accAttr) =

956+ --if the attribute is a constructedatomtype, we can recurse into it to potentially resolve type variables

957+ if isResolvedAttribute accAttr && tupAttr == accAttr then

958+ pure accAttr

959+ else

960+ lift $ except $ resolveAttributes accAttr tupAttr

961+ mostResolvedTypes <-

962+ foldM (\acc tup -> do

963+ let zipped = zip (V.toList . attributesVec $ tupleAttributes tup) acc

964+ accNames = S.fromList $ map A.attributeName acc

965+ tupNames = A.attributeNameSet (tupleAttributes tup)

966+ attrNamesDiff = S.union (S.difference accNames tupNames) (S.difference tupNames accNames)

967+ unless (null attrNamesDiff) (throwError (AttributeNamesMismatchError attrNamesDiff))

968+ nextTupleAttrs <- mapM processTupleAttrs zipped

969+ let diff = A.attributesDifference (A.attributesFromList nextTupleAttrs) (A.attributesFromList acc)

970+ if diff == A.emptyAttributes then

971+ pure nextTupleAttrs

972+ else

973+ throwError (TupleAttributeTypeMismatchError diff)

974+ ) (V.toList . attributesVec $ tupleAttributes headTuple) tailTuples

975+ pure (A.attributesFromList mostResolvedTypes)

976+ --strategy: if all the tuple expr transaction markers refer to one location, then we can pass the type constructor mapping from that location, otherwise, we cannot assume that the types are the same

977+ tConsMap <- case singularTransactions tupleExprL of

978+ SingularTransactionRef commonTransId ->

979+ typeConstructorMapping <$> gfDatabaseContextForMarker commonTransId

980+ NoTransactionsRef ->

981+ typeConstructorMapping <$> gfDatabaseContextForMarker fixedMarker

982+ -- if there are multiple transaction markers in the TupleExprs, then we can't assume a single type constructor mapping- this could be improved in the future, but if all the tuples are fully resolved, then we don't need further resolution

983+ _ -> throwError TupleExprsReferenceMultipleMarkersError

984+ lift $ except $ validateAttributes tConsMap finalAttrs

985+ mapM (lift . except . resolveTypesInTuple finalAttrs tConsMap) tuples

986+

987+

988+--resolveAttributes (Attribute "gonk" (ConstructedAtomType "Either" (fromList [("a",IntegerAtomType),("b",TypeVariableType "b")]))) (Attribute "gonk" (ConstructedAtomType "Either" (fromList [("a",TypeVariableType "a"),("b",TextAtomType)])))

989+

990+evalGraphRefTupleExpr :: Maybe Attributes -> GraphRefTupleExpr -> GraphRefRelationalExprM RelationTuple

854−evalTupleExpr attrs (TupleExpr tupMap) = do

991+evalGraphRefTupleExpr mAttrs (TupleExpr tupMap) = do

855− context <- fmap stateElemsContext ask

856− runExceptT $ do

857 -- it's not possible for AtomExprs in tuple constructors to reference other Attributes' atoms due to the necessary order-of-operations (need a tuple to pass to evalAtomExpr)- it may be possible with some refactoring of type usage or delayed evaluation- needs more thought, but not a priority

992 -- it's not possible for AtomExprs in tuple constructors to reference other Attributes' atoms due to the necessary order-of-operations (need a tuple to pass to evalAtomExpr)- it may be possible with some refactoring of type usage or delayed evaluation- needs more thought, but not a priority

858 -- I could adjust this logic so that when the attributes are not specified (Nothing), then I can attempt to extract the attributes from the tuple- the type resolution will blow up if an ambiguous data constructor is used (Left 4) and this should allow simple cases to "relation{tuple{a 4}}" to be processed

993 -- I could adjust this logic so that when the attributes are not specified (Nothing), then I can attempt to extract the attributes from the tuple- the type resolution will blow up if an ambiguous data constructor is used (Left 4) and this should allow simple cases to "relation{tuple{a 4}}" to be processed

994+ let attrs = fromMaybe A.emptyAttributes mAttrs

859− attrAtoms <- mapM (\(attrName, aExpr) -> do

995+ resolveOneAtom (attrName, aExpr) =

860− newAtomType <- liftE (typeFromAtomExpr A.emptyAttributes aExpr)

996+ do

997+ --provided when the relation header is available

998+ let eExpectedAtomType = A.atomTypeForAttributeName attrName attrs

999+ unresolvedType <- typeForGraphRefAtomExpr attrs aExpr

1000+ resolvedType <- case eExpectedAtomType of

1001+ Left _ -> pure unresolvedType

1002+ Right typeHint -> lift $ except $ resolveAtomType typeHint unresolvedType

1003+ --resolve atom typevars based on resolvedType?

861− newAtom <- liftE (evalAtomExpr emptyTuple aExpr)

1004+ newAtom <- evalGraphRefAtomExpr emptyTuple aExpr

862− pure (attrName, newAtom, newAtomType)

1005+ pure (attrName, newAtom, resolvedType)

863− ) (M.toList tupMap)

1006+ attrAtoms <- mapM resolveOneAtom (M.toList tupMap)

864− let tupAttrs = A.attributesFromList $ map (\(attrName, _, aType) -> Attribute attrName aType) attrAtoms

1007+ let tupAttrs = A.attributesFromList $ map (\(attrName, _, aType) -> Attribute attrName aType) attrAtoms

865− atoms = V.fromList $ map (\(_, atom, _) -> atom) attrAtoms

1008+ atoms = V.fromList $ map (\(_, atom, _) -> atom) attrAtoms

866− tup = mkRelationTuple tupAttrs atoms

1009+ tup = mkRelationTuple tupAttrs atoms

867− tConss = typeConstructorMapping context

868− finalAttrs = fromMaybe tupAttrs attrs

1010+ finalAttrs = fromMaybe tupAttrs mAttrs

869 --verify that the attributes match

1011 --verify that the attributes match

870− when (A.attributeNameSet finalAttrs /= A.attributeNameSet tupAttrs) $ throwE (TupleAttributeTypeMismatchError tupAttrs)

1012+ when (A.attributeNameSet finalAttrs /= A.attributeNameSet tupAttrs) $ throwError (TupleAttributeTypeMismatchError tupAttrs)

1013+ --we can't resolve types here- they have to be resolved at the atom level where the graph ref is held

871− tup' <- either throwE pure (resolveTypesInTuple finalAttrs (reorderTuple finalAttrs tup))

1014+ --tup' <- lift $ except (resolveTypesInTuple finalAttrs tConss (reorderTuple finalAttrs tup))

1015+ let tup' = reorderTuple finalAttrs tup

1016+ --TODO: restore type resolution

872− _ <- either throwE pure (validateTuple tup' tConss)

1017+-- _ <- lift $ except (validateTuple tup' tConss)

873− pure tup'

1018+ pure tup'

1019+

1020+--temporary implementation until we have a proper planner+executor

1021+evalGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefRelationalExprM Relation

1022+evalGraphRefRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do

1023+ mAttrs <- case mAttrExprs of

1024+ Just _ ->

1025+ Just . A.attributesFromList <$> mapM evalGraphRefAttrExpr (fromMaybe [] mAttrExprs)

1026+ Nothing -> pure Nothing

1027+ tuples <- evalGraphRefTupleExprs mAttrs tupleExprs

1028+ let attrs = fromMaybe firstTupleAttrs mAttrs

1029+ firstTupleAttrs = if null tuples then A.emptyAttributes else tupleAttributes (head tuples)

1030+ lift $ except $ mkRelation attrs (RelationTupleSet tuples)

1031+evalGraphRefRelationalExpr (MakeStaticRelation attributeSet tupleSet) =

1032+ lift $ except $ mkRelation attributeSet tupleSet

1033+evalGraphRefRelationalExpr (ExistingRelation rel) = pure rel

1034+evalGraphRefRelationalExpr (RelationVariable name tid) = do

1035+ ctx <- gfDatabaseContextForMarker tid

1036+ case M.lookup name (relationVariables ctx) of

1037+ Nothing -> throwError (RelVarNotDefinedError name)

1038+ Just rv -> evalGraphRefRelationalExpr rv

1039+evalGraphRefRelationalExpr (Project attrNames expr) = do

1040+ attrNameSet <- evalGraphRefAttributeNames attrNames expr

1041+ rel <- evalGraphRefRelationalExpr expr

1042+ lift $ except $ project attrNameSet rel

1043+evalGraphRefRelationalExpr (Union exprA exprB) = do

1044+ relA <- evalGraphRefRelationalExpr exprA

1045+ relB <- evalGraphRefRelationalExpr exprB

1046+ lift $ except $ union relA relB

1047+evalGraphRefRelationalExpr (Join exprA exprB) = do

1048+ relA <- evalGraphRefRelationalExpr exprA

1049+ relB <- evalGraphRefRelationalExpr exprB

1050+ lift $ except $ join relA relB

1051+evalGraphRefRelationalExpr (Rename oldName newName expr) = do

1052+ rel <- evalGraphRefRelationalExpr expr

1053+ lift $ except $ rename oldName newName rel

1054+evalGraphRefRelationalExpr (Difference exprA exprB) = do

1055+ relA <- evalGraphRefRelationalExpr exprA

1056+ relB <- evalGraphRefRelationalExpr exprB

1057+ lift $ except $ difference relA relB

1058+evalGraphRefRelationalExpr (Group groupAttrNames newAttrName expr) = do

1059+ groupNames <- evalGraphRefAttributeNames groupAttrNames expr

1060+ rel <- evalGraphRefRelationalExpr expr

1061+ lift $ except $ group groupNames newAttrName rel

1062+evalGraphRefRelationalExpr (Ungroup groupAttrName expr) = do

1063+ rel <- evalGraphRefRelationalExpr expr

1064+ lift $ except $ ungroup groupAttrName rel

1065+evalGraphRefRelationalExpr (Restrict predExpr expr) = do

1066+ rel <- evalGraphRefRelationalExpr expr

1067+ filt <- predicateRestrictionFilter (attributes rel) predExpr

1068+ lift $ except $ restrict filt rel

1069+evalGraphRefRelationalExpr (Equals exprA exprB) = do

1070+ relA <- evalGraphRefRelationalExpr exprA

1071+ relB <- evalGraphRefRelationalExpr exprB

1072+ pure $ if relA == relB then relationTrue else relationFalse

1073+evalGraphRefRelationalExpr (NotEquals exprA exprB) = do

1074+ relA <- evalGraphRefRelationalExpr exprA

1075+ relB <- evalGraphRefRelationalExpr exprB

1076+ pure $ if relA == relB then relationFalse else relationTrue

1077+evalGraphRefRelationalExpr (Extend extendTupleExpr expr) = do

1078+ rel <- evalGraphRefRelationalExpr expr

1079+ (newAttrs, tupProc) <- extendGraphRefTupleExpressionProcessor rel extendTupleExpr

1080+ lift $ except $ relMogrify tupProc newAttrs rel

1081+evalGraphRefRelationalExpr expr@With{} =

1082+ --strategy A: add relation variables to the contexts in the graph

1083+ --strategy B: drop in macros in place (easier programmatically)

1084+ --strategy B implementation

1085+ evalGraphRefRelationalExpr (substituteWithNameMacros [] expr)

1086+

1087+dbContextForTransId :: TransactionId -> TransactionGraph -> Either RelationalError DatabaseContext

1088+dbContextForTransId tid graph = do

1089+ trans <- transactionForId tid graph

1090+ pure (concreteDatabaseContext trans)

1091+

1092+transactionForId :: TransactionId -> TransactionGraph -> Either RelationalError Transaction

1093+transactionForId tid graph

1094+ | tid == U.nil =

1095+ Left RootTransactionTraversalError

1096+ | S.null matchingTrans =

1097+ Left $ NoSuchTransactionError tid

1098+ | otherwise =

1099+ Right $ head (S.toList matchingTrans)

1100+ where

1101+ matchingTrans = S.filter (\(Transaction idMatch _ _) -> idMatch == tid) (transactionsForGraph graph)

1102+

1103+typeForGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefRelationalExprM Relation

1104+typeForGraphRefRelationalExpr (MakeStaticRelation attrs _) = lift $ except $ mkRelation attrs emptyTupleSet

1105+typeForGraphRefRelationalExpr (ExistingRelation rel) = pure (emptyRelationWithAttrs (attributes rel))

1106+typeForGraphRefRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do

1107+ mAttrs <- case mAttrExprs of

1108+ Just attrExprs -> do

1109+ attrs <- mapM evalGraphRefAttributeExpr attrExprs

1110+ pure (Just (attributesFromList attrs))

1111+ Nothing -> pure Nothing

1112+ tuples <- evalGraphRefTupleExprs mAttrs tupleExprs

1113+ let retAttrs = case tuples of

1114+ (tup:_) -> tupleAttributes tup

1115+ [] -> fromMaybe A.emptyAttributes mAttrs

1116+ pure $ emptyRelationWithAttrs retAttrs

1117+

1118+typeForGraphRefRelationalExpr (RelationVariable rvName tid) = do

1119+ relVars <- relationVariables <$> gfDatabaseContextForMarker tid

1120+ case M.lookup rvName relVars of

1121+ Nothing -> throwError (RelVarNotDefinedError rvName)

1122+ Just rvExpr ->

1123+ typeForGraphRefRelationalExpr rvExpr

1124+typeForGraphRefRelationalExpr (Project attrNames expr) = do

1125+ exprType' <- typeForGraphRefRelationalExpr expr

1126+ projectionAttrs <- evalGraphRefAttributeNames attrNames expr

1127+ lift $ except $ project projectionAttrs exprType'

1128+typeForGraphRefRelationalExpr (Union exprA exprB) = do

1129+ exprA' <- typeForGraphRefRelationalExpr exprA

1130+ exprB' <- typeForGraphRefRelationalExpr exprB

1131+ lift $ except $ union exprA' exprB'

1132+typeForGraphRefRelationalExpr (Join exprA exprB) = do

1133+ exprA' <- typeForGraphRefRelationalExpr exprA

1134+ exprB' <- typeForGraphRefRelationalExpr exprB

1135+ lift $ except $ join exprA' exprB'

1136+typeForGraphRefRelationalExpr (Rename oldAttr newAttr expr) = do

1137+ expr' <- typeForGraphRefRelationalExpr expr

1138+ lift $ except $ rename oldAttr newAttr expr'

1139+typeForGraphRefRelationalExpr (Difference exprA exprB) = do

1140+ exprA' <- typeForGraphRefRelationalExpr exprA

1141+ exprB' <- typeForGraphRefRelationalExpr exprB

1142+ lift $ except $ difference exprA' exprB'

1143+typeForGraphRefRelationalExpr (Group groupNames attrName expr) = do

1144+ expr' <- typeForGraphRefRelationalExpr expr

1145+ groupNames' <- evalGraphRefAttributeNames groupNames expr

1146+ lift $ except $ group groupNames' attrName expr'

1147+typeForGraphRefRelationalExpr (Ungroup groupAttrName expr) = do

1148+ expr' <- typeForGraphRefRelationalExpr expr

1149+ lift $ except $ ungroup groupAttrName expr'

1150+typeForGraphRefRelationalExpr (Restrict pred' expr) = do

1151+ expr' <- typeForGraphRefRelationalExpr expr

1152+ filt <- predicateRestrictionFilter (attributes expr') pred'

1153+ lift $ except $ restrict filt expr'

1154+typeForGraphRefRelationalExpr Equals{} =

1155+ pure relationFalse

1156+typeForGraphRefRelationalExpr NotEquals{} =

1157+ pure relationFalse

1158+typeForGraphRefRelationalExpr (Extend extendTupleExpr expr) = do

1159+ rel <- typeForGraphRefRelationalExpr expr

1160+ evalGraphRefRelationalExpr (Extend extendTupleExpr (ExistingRelation rel))

1161+typeForGraphRefRelationalExpr expr@(With withs _) = do

1162+ let expr' = substituteWithNameMacros [] expr

1163+ checkMacroName (WithNameExpr macroName tid) = do

1164+ rvs <- relationVariables <$> gfDatabaseContextForMarker tid

1165+ case M.lookup macroName rvs of

1166+ Just _ -> lift $ except $ Left (RelVarAlreadyDefinedError macroName) --this error does not include the transaction marker, but should be good enough to identify the cause

1167+ Nothing -> pure ()

1168+ mapM_ (checkMacroName . fst) withs

1169+ typeForGraphRefRelationalExpr expr'

1170+

1171+evalGraphRefAttributeNames :: GraphRefAttributeNames -> GraphRefRelationalExpr -> GraphRefRelationalExprM (S.Set AttributeName)

1172+evalGraphRefAttributeNames attrNames expr = do

1173+ exprType' <- typeForGraphRefRelationalExpr expr

1174+ let typeNameSet = S.fromList (V.toList (A.attributeNames (attributes exprType')))

1175+ case attrNames of

1176+ AttributeNames names ->

1177+ case A.projectionAttributesForNames names (attributes exprType') of

1178+ Left err -> throwError err

1179+ Right attrs -> pure (S.fromList (V.toList (A.attributeNames attrs)))

1180+

1181+ InvertedAttributeNames names -> do

1182+ let nonExistentAttributeNames = A.attributeNamesNotContained names typeNameSet

1183+ if not (S.null nonExistentAttributeNames) then

1184+ throwError $ AttributeNamesMismatchError nonExistentAttributeNames

1185+ else

1186+ pure (A.nonMatchingAttributeNameSet names typeNameSet)

1187+

1188+ UnionAttributeNames namesA namesB -> do

1189+ nameSetA <- evalGraphRefAttributeNames namesA expr

1190+ nameSetB <- evalGraphRefAttributeNames namesB expr

1191+ pure (S.union nameSetA nameSetB)

1192+

1193+ IntersectAttributeNames namesA namesB -> do

1194+ nameSetA <- evalGraphRefAttributeNames namesA expr

1195+ nameSetB <- evalGraphRefAttributeNames namesB expr

1196+ pure (S.intersection nameSetA nameSetB)

1197+

1198+ RelationalExprAttributeNames attrExpr -> do

1199+ attrExprType <- typeForGraphRefRelationalExpr attrExpr

1200+ pure (A.attributeNameSet (attributes attrExprType))

1201+

1202+evalGraphRefAttributeExpr :: GraphRefAttributeExpr -> GraphRefRelationalExprM Attribute

1203+evalGraphRefAttributeExpr (AttributeAndTypeNameExpr attrName tCons tid) = do

1204+ tConsMap <- typeConstructorMapping <$> gfDatabaseContextForMarker tid

1205+ case atomTypeForTypeConstructorValidate True tCons tConsMap M.empty of

1206+ Left err -> throwError err

1207+ Right aType -> do

1208+ case validateAtomType aType tConsMap of

1209+ Left err -> throwError err

1210+ Right _ -> pure (Attribute attrName aType)

1211+evalGraphRefAttributeExpr (NakedAttributeExpr attr) = pure attr

1212+

1213+mkEmptyRelVars :: RelationVariables -> RelationVariables

1214+mkEmptyRelVars = M.map mkEmptyRelVar

1215+ where

1216+ mkEmptyRelVar expr@MakeRelationFromExprs{} = expr --do not truncate here because we might lose essential type information in emptying the tuples

1217+ mkEmptyRelVar (MakeStaticRelation attrs _) = MakeStaticRelation attrs emptyTupleSet

1218+ mkEmptyRelVar (ExistingRelation rel) = ExistingRelation (emptyRelationWithAttrs (attributes rel))

1219+ mkEmptyRelVar rv@RelationVariable{} = Restrict (NotPredicate TruePredicate) rv

1220+ mkEmptyRelVar (Project attrNames expr) = Project attrNames (mkEmptyRelVar expr)

1221+ mkEmptyRelVar (Union exprA exprB) = Union (mkEmptyRelVar exprA) (mkEmptyRelVar exprB)

1222+ mkEmptyRelVar (Join exprA exprB) = Join (mkEmptyRelVar exprA) (mkEmptyRelVar exprB)

1223+ mkEmptyRelVar (Rename nameA nameB expr) = Rename nameA nameB (mkEmptyRelVar expr)

1224+ mkEmptyRelVar (Difference exprA exprB) = Difference (mkEmptyRelVar exprA) (mkEmptyRelVar exprB)

1225+ mkEmptyRelVar (Group attrNames attrName expr) = Group attrNames attrName (mkEmptyRelVar expr)

1226+ mkEmptyRelVar (Ungroup attrName expr) = Ungroup attrName (mkEmptyRelVar expr)

1227+ mkEmptyRelVar (Restrict pred' expr) = Restrict pred' (mkEmptyRelVar expr)

1228+ mkEmptyRelVar (Equals exprA exprB) = Equals (mkEmptyRelVar exprA) (mkEmptyRelVar exprB)

1229+ mkEmptyRelVar (NotEquals exprA exprB) = NotEquals (mkEmptyRelVar exprA) (mkEmptyRelVar exprB)

1230+ mkEmptyRelVar (Extend extTuple expr) = Extend extTuple (mkEmptyRelVar expr)

1231+ mkEmptyRelVar (With macros expr) = With (map (second mkEmptyRelVar) macros) (mkEmptyRelVar expr)

1232+

1233+

1234+dbErr :: RelationalError -> DatabaseContextEvalMonad ()

1235+dbErr err = lift (except (Left err))

1236+

1237+-- | Return a Relation describing the relation variables.

1238+relationVariablesAsRelation :: DatabaseContext -> TransactionGraph -> Either RelationalError Relation

1239+relationVariablesAsRelation ctx graph = do

1240+ let subrelAttrs = A.attributesFromList [Attribute "attribute" TextAtomType, Attribute "type" TextAtomType]

1241+ attrs = A.attributesFromList [Attribute "name" TextAtomType,

1242+ Attribute "attributes" (RelationAtomType subrelAttrs)]

1243+ relVars = relationVariables ctx

1244+ mkRvDesc (rvName, gfExpr) = do

1245+ let gfEnv = freshGraphRefRelationalExprEnv (Just ctx) graph

1246+ gfType <- runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr gfExpr)

1247+ pure (rvName, gfType)

1248+ relVarToAtomList (rvName, rel) = [TextAtom rvName, attributesToRel (attributesVec (attributes rel))]

1249+ attrAtoms a = [TextAtom (A.attributeName a), TextAtom (prettyAtomType (A.atomType a))]

1250+ attributesToRel attrl = case mkRelationFromList subrelAttrs (map attrAtoms (V.toList attrl)) of

1251+ Left err -> error ("relationVariablesAsRelation pooped " ++ show err)

1252+ Right rel -> RelationAtom rel

1253+ rvs <- mapM mkRvDesc (M.toList relVars)

1254+ let tups = map relVarToAtomList rvs

1255+ mkRelationFromList attrs tups

1256+

1257+-- | An unoptimized variant of evalGraphRefRelationalExpr for testing.

1258+evalRelationalExpr :: RelationalExpr -> RelationalExprM Relation

1259+evalRelationalExpr expr = do

1260+ graph <- reGraph

1261+ context <- reContext

1262+ let expr' = runProcessExprM UncommittedContextMarker (processRelationalExpr expr)

1263+ gfEnv = freshGraphRefRelationalExprEnv (Just context) graph

1264+ case runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr expr') of

1265+ Left err -> throwError err

1266+ Right rel -> pure rel

1267+

1268+class (MonadError RelationalError m, Monad m) => DatabaseContextM m where

1269+ getContext :: m DatabaseContext

1270+

1271+instance DatabaseContextM (ReaderT GraphRefRelationalExprEnv (ExceptT RelationalError Identity)) where

1272+ getContext = gfDatabaseContextForMarker UncommittedContextMarker

1273+

1274+instance DatabaseContextM (RWST DatabaseContextEvalEnv () DatabaseContextEvalState (ExceptT RelationalError Identity)) where

1275+ getContext = getStateContext

1276+

1277+relVarByName :: DatabaseContextM m => RelVarName -> m GraphRefRelationalExpr

1278+relVarByName rvName = do

1279+ relvars <- relationVariables <$> getContext

1280+ case M.lookup rvName relvars of

1281+ Nothing -> throwError (RelVarNotDefinedError rvName)

1282+ Just gfexpr -> pure gfexpr

1283+

1284+-- | resolve UncommittedTransactionMarker whenever possible- this is important in the DatabaseContext in order to mitigate self-referencing loops for updates

1285+class ResolveGraphRefTransactionMarker a where

1286+ resolve :: a -> DatabaseContextEvalMonad a

1287+

1288+-- s := s union t

1289+instance ResolveGraphRefTransactionMarker GraphRefRelationalExpr where

1290+ resolve (MakeRelationFromExprs mAttrs tupleExprs) =

1291+ MakeRelationFromExprs mAttrs <$> resolve tupleExprs

1292+ resolve orig@MakeStaticRelation{} = pure orig

1293+ resolve orig@ExistingRelation{} = pure orig

1294+ resolve orig@(RelationVariable rvName UncommittedContextMarker) = do

1295+ rvMap <- relationVariables <$> getStateContext

1296+ case M.lookup rvName rvMap of

1297+ Nothing -> pure orig

1298+ Just resolvedRv -> resolve resolvedRv

1299+ resolve orig@RelationVariable{} = pure orig

1300+ resolve (Project attrNames relExpr) = Project <$> resolve attrNames <*> resolve relExpr

1301+ resolve (Union exprA exprB) = Union <$> resolve exprA <*> resolve exprB

1302+ resolve (Join exprA exprB) = Join <$> resolve exprA <*> resolve exprB

1303+ resolve (Rename attrA attrB expr) = Rename attrA attrB <$> resolve expr

1304+ resolve (Difference exprA exprB) = Difference <$> resolve exprA <*> resolve exprB

1305+ resolve (Group namesA nameB expr) = Group <$> resolve namesA <*> pure nameB <*> resolve expr

1306+ resolve (Ungroup nameA expr) = Ungroup nameA <$> resolve expr

1307+ resolve (Restrict restrictExpr relExpr) = Restrict <$> resolve restrictExpr <*> resolve relExpr

1308+ resolve (Equals exprA exprB) = Equals <$> resolve exprA <*> resolve exprB

1309+ resolve (NotEquals exprA exprB) = NotEquals <$> resolve exprA <*> resolve exprB

1310+ resolve (Extend extendExpr relExpr) = Extend <$> resolve extendExpr <*> resolve relExpr

1311+ resolve (With withExprs relExpr) = With <$> mapM (\(nam, expr) -> (,) <$> resolve nam <*> resolve expr) withExprs <*> resolve relExpr

874

1312

1313+instance ResolveGraphRefTransactionMarker GraphRefTupleExprs where

1314+ resolve (TupleExprs marker tupleExprs) =

1315+ TupleExprs marker <$> mapM resolve tupleExprs

1316+

1317+instance ResolveGraphRefTransactionMarker GraphRefTupleExpr where

1318+ resolve (TupleExpr tupMap) = do

1319+ tupMap' <- mapM (\(attrName, expr) -> (,) attrName <$> resolve expr ) (M.toList tupMap)

1320+ pure (TupleExpr (M.fromList tupMap'))

1321+

1322+instance ResolveGraphRefTransactionMarker GraphRefAttributeNames where

1323+ resolve orig@AttributeNames{} = pure orig

1324+ resolve orig@InvertedAttributeNames{} = pure orig

1325+ resolve (UnionAttributeNames namesA namesB) = UnionAttributeNames <$> resolve namesA <*> resolve namesB

1326+ resolve (IntersectAttributeNames namesA namesB) = IntersectAttributeNames <$> resolve namesA <*> resolve namesB

1327+ resolve (RelationalExprAttributeNames expr) = RelationalExprAttributeNames <$> resolve expr

1328+

1329+instance ResolveGraphRefTransactionMarker GraphRefRestrictionPredicateExpr where

1330+ resolve TruePredicate = pure TruePredicate

1331+ resolve (AndPredicate exprA exprB) = AndPredicate <$> resolve exprA <*> resolve exprB

1332+ resolve (OrPredicate exprA exprB) = OrPredicate <$> resolve exprA <*> resolve exprB

1333+ resolve (NotPredicate expr) = NotPredicate <$> resolve expr

1334+ resolve (RelationalExprPredicate expr) = RelationalExprPredicate <$> resolve expr

1335+ resolve (AtomExprPredicate expr) = AtomExprPredicate <$> resolve expr

1336+ resolve (AttributeEqualityPredicate nam expr)= AttributeEqualityPredicate nam <$> resolve expr

1337+

1338+instance ResolveGraphRefTransactionMarker GraphRefExtendTupleExpr where

1339+ resolve (AttributeExtendTupleExpr nam atomExpr) = AttributeExtendTupleExpr nam <$> resolve atomExpr

1340+

1341+instance ResolveGraphRefTransactionMarker GraphRefWithNameExpr where

1342+ resolve orig@WithNameExpr{} = pure orig -- match uncommitted marker?

1343+

1344+instance ResolveGraphRefTransactionMarker GraphRefAtomExpr where

1345+ resolve orig@AttributeAtomExpr{} = pure orig

1346+ resolve orig@NakedAtomExpr{} = pure orig

1347+ resolve (FunctionAtomExpr nam atomExprs marker) =

1348+ FunctionAtomExpr nam <$> mapM resolve atomExprs <*> pure marker

1349+ resolve (RelationAtomExpr expr) = RelationAtomExpr <$> resolve expr

1350+ resolve (ConstructedAtomExpr dConsName atomExprs marker) =

1351+ ConstructedAtomExpr dConsName <$> mapM resolve atomExprs <*> pure marker

1352+

1353+--convert series of simple Union queries into MakeStaticRelation

1354+-- this is especially useful for long, nested applications of Union with simple tuples

1355+-- Union (MakeRelation x y) (MakeRelation x y') -> MakeRelation x (y + y')

1356+

1357+--MakeRelationFromExprs Nothing (TupleExprs UncommittedContextMarker [TupleExpr (fromList [("name", NakedAtomExpr (TextAtom "steve"))])])

1358+

1359+applyUnionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr

1360+applyUnionCollapse = Fold.cata opt

1361+ where

1362+ opt :: RelationalExprBaseF GraphRefTransactionMarker GraphRefRelationalExpr -> GraphRefRelationalExpr

1363+ opt (UnionF exprA exprB) | exprA == exprB = exprA

1364+ opt (UnionF

1365+ exprA@(MakeRelationFromExprs mAttrs1 tupExprs1)

1366+ exprB@(MakeRelationFromExprs mAttrs2 tupExprs2)) | tupExprs1 == tupExprs2 = MakeRelationFromExprs (mAttrs1 <|> mAttrs2) tupExprs1

1367+ | tupExprsNull tupExprs1 = exprB

1368+ | tupExprsNull tupExprs2 = exprA

1369+ opt x = Fold.embed x

1370+ tupExprsNull (TupleExprs _ []) = True

1371+ tupExprsNull _ = False

1372+

1373+

1374+--UPDATE optimization- find matching where clause in "lower" levels of renaming

1375+--update x where y=1 set (x:=5,z:=10); update x where y=1 set(x:=6,z:=11)

1376+-- =>

1377+-- update x where y=1 set (x:=6,z:=11)

1378+-- future opt: match individual attributes update x where y=1 set (x:=5); update x where y=1 set (z:=11) => update x where y=1 set (x:=5,z:=11)

1379+

1380+--strategy: try to collapse the top-level update (union (restrict pred MakeRelationFromExpr) expr) if it contains the same predicate and resultant relation

1381+

1382+--DELETE optimization

1383+-- if a restriction matches a previous restriction, combine them

1384+-- O(1) since it only scans at the top level, critical in benchmarks generating redundant deletions

1385+applyRestrictionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr

1386+applyRestrictionCollapse orig@(Restrict npred@(NotPredicate _) expr) =

1387+ case expr of

1388+ orig'@(Restrict npred'@(NotPredicate _) _) | npred == npred' -> orig'

1389+ _ -> orig

1390+applyRestrictionCollapse expr = expr

1391+

1392+

src/lib/ProjectM36/ScriptSession.hs+133−32

@@ -1,7 +1,12 @@

1+{-# LANGUAGE UnboxedTuples, KindSignatures, DataKinds #-}

2+#ifdef PM36_HASKELL_SCRIPTING

3+{-# LANGUAGE MagicHash #-}

4+#endif

1module ProjectM36.ScriptSession where

5module ProjectM36.ScriptSession where

7+#ifdef PM36_HASKELL_SCRIPTING

3import ProjectM36.Error

8import ProjectM36.Error

4−

9+import GHC

5import Control.Exception

10import Control.Exception

6import Control.Monad

11import Control.Monad

7import System.IO.Error

12import System.IO.Error

@@ -9,32 +14,63 @@ import System.Directory

9import Control.Monad.IO.Class

14import Control.Monad.IO.Class

10import System.FilePath.Glob

15import System.FilePath.Glob

11import System.FilePath

16import System.FilePath

17+import System.Info (os, arch)

12import Data.Text (Text, unpack)

18import Data.Text (Text, unpack)

13import Data.Maybe

19import Data.Maybe

14−

15−import GHC

16import GHC.Paths (libdir)

20import GHC.Paths (libdir)

21+import System.Environment

17#if __GLASGOW_HASKELL__ >= 800

22#if __GLASGOW_HASKELL__ >= 800

18import GHC.LanguageExtensions

23import GHC.LanguageExtensions

24+import GHCi.ObjLink

25+#else

26+import ObjLink

27+#endif

28+#if __GLASGOW_HASKELL__ >= 802

29+import BasicTypes

19#endif

30#endif

20import DynFlags

31import DynFlags

21import Panic

32import Panic

22import Outputable --hiding ((<>))

33import Outputable --hiding ((<>))

23import PprTyThing

34import PprTyThing

24import Unsafe.Coerce

35import Unsafe.Coerce

36+#if __GLASGOW_HASKELL__ >= 802

37+import Type

38+#elif __GLASGOW_HASKELL__ >= 710

25−import Type hiding (pprTyThing)

39+import Type hiding (pprTyThing)

40+#else

41+#endif

42+import GHC.Exts (addrToAny#)

43+import GHC.Ptr (Ptr(..))

44+import Encoding

45+#endif

46+

27data ScriptSession = ScriptSession {

48data ScriptSession = ScriptSession {

49+#ifdef PM36_HASKELL_SCRIPTING

28− hscEnv :: HscEnv,

50+ hscEnv :: HscEnv,

29 atomFunctionBodyType :: Type,

51 atomFunctionBodyType :: Type,

30 dbcFunctionBodyType :: Type

52 dbcFunctionBodyType :: Type

53+#endif

31 }

54 }

32−

55+

56+#ifdef PM36_HASKELL_SCRIPTING

33−newtype ScriptSessionError = ScriptSessionLoadError GhcException

57+data ScriptSessionError = ScriptSessionLoadError GhcException

58+ | ScriptingDisabled

34 deriving (Show)

59 deriving (Show)

60+#else

61+data ScriptSessionError = ScriptingDisabled

62+ deriving (Show)

63+#endif

64+

65+data LoadSymbolError = LoadSymbolError

66+type ModName = String

67+type FuncName = String

36-- | Configure a GHC environment/session which we will use for all script compilation.

69-- | Configure a GHC environment/session which we will use for all script compilation.

37initScriptSession :: [String] -> IO (Either ScriptSessionError ScriptSession)

70initScriptSession :: [String] -> IO (Either ScriptSessionError ScriptSession)

71+#if !defined(PM36_HASKELL_SCRIPTING)

72+initScriptSession _ = pure (Left ScriptingDisabled)

73+#else

38initScriptSession ghcPkgPaths = do

74initScriptSession ghcPkgPaths = do

39 --for the sake of convenience, for developers' builds, include the local cabal sandbox package database and the cabal new-build package database

75 --for the sake of convenience, for developers' builds, include the local cabal sandbox package database and the cabal new-build package database

40 eHomeDir <- tryJust (guard . isDoesNotExistError) getHomeDirectory

76 eHomeDir <- tryJust (guard . isDoesNotExistError) getHomeDirectory

@@ -43,36 +79,47 @@ initScriptSession ghcPkgPaths = do

43 handleGhcException excHandler $ runGhc (Just libdir) $ do

79 handleGhcException excHandler $ runGhc (Just libdir) $ do

44 dflags <- getSessionDynFlags

80 dflags <- getSessionDynFlags

45 let ghcVersion = projectVersion dflags

81 let ghcVersion = projectVersion dflags

82+ -- get nix packages dir, if available

83+ mNixLibDir <- liftIO $ lookupEnv "NIX_GHC_LIBDIR"

47 sandboxPkgPaths <- liftIO $ concat <$> mapM glob [

85 sandboxPkgPaths <- liftIO $ concat <$> mapM glob [

48− "./dist-newstyle/packagedb/ghc-" ++ ghcVersion,

86+ --"./dist-newstyle/packagedb/ghc-" ++ ghcVersion, --rely on cabal 3's ghc.environment install: "cabal install --lib project-m36"

49− ".cabal-sandbox/*ghc-" ++ ghcVersion ++ "-packages.conf.d",

87+ ".cabal-sandbox/*ghc-" ++ ghcVersion ++ "-packages.conf.d",

88+ ".stack-work/install/*/*/" ++ ghcVersion ++ "/pkgdb",

89+ ".stack-work/install/*/pkgdb/", --windows stack build

90+ "C:/sr/snapshots/b201cfe6/pkgdb", --windows stack build- ideally, we could run `stack path --snapshot-pkg-db, but this is sufficient to pass CI

91+ homeDir </> ".stack/snapshots/*/*/" ++ ghcVersion ++ "/pkgdb"

50− homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"

92+ --homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"

51 ]

93 ]

52−

94+

53− let localPkgPaths = map PkgConfFile (ghcPkgPaths ++ sandboxPkgPaths)

95+ let localPkgPaths = map PkgConfFile (ghcPkgPaths ++ sandboxPkgPaths ++ maybeToList mNixLibDir)

54−

96+

55− let dflags' = applyGopts . applyXopts $ dflags { hscTarget = HscInterpreted ,

97+ let dflags' = applyGopts . applyXopts $ dflags { hscTarget = HscInterpreted ,

56− ghcLink = LinkInMemory,

98+ ghcLink = LinkInMemory,

57 safeHaskell = Sf_Trustworthy,

99 safeHaskell = Sf_Trustworthy,

58 safeInfer = True,

100 safeInfer = True,

59 safeInferred = True,

101 safeInferred = True,

60 --verbosity = 3,

102 --verbosity = 3,

61−#if __GLASGOW_HASKELL__ >= 800

103+#if __GLASGOW_HASKELL__ >= 800

62 trustFlags = map TrustPackage required_packages,

104 trustFlags = map TrustPackage required_packages,

63−#endif

105+#endif

64 packageFlags = packageFlags dflags ++ packages,

106 packageFlags = packageFlags dflags ++ packages,

107+#if __GLASGOW_HASKELL__ >= 802

108+ packageDBFlags = map PackageDB localPkgPaths

109+#else

65 extraPkgConfs = const (localPkgPaths ++ [UserPkgConf, GlobalPkgConf])

110 extraPkgConfs = const (localPkgPaths ++ [UserPkgConf, GlobalPkgConf])

111+#endif

112+

66 }

113 }

67 applyGopts flags = foldl gopt_set flags gopts

114 applyGopts flags = foldl gopt_set flags gopts

68 applyXopts flags = foldl xopt_set flags xopts

115 applyXopts flags = foldl xopt_set flags xopts

69#if __GLASGOW_HASKELL__ >= 800

116#if __GLASGOW_HASKELL__ >= 800

70 xopts = [OverloadedStrings, ExtendedDefaultRules, ImplicitPrelude, ScopedTypeVariables]

117 xopts = [OverloadedStrings, ExtendedDefaultRules, ImplicitPrelude, ScopedTypeVariables]

71−#else

118+#else

72 xopts = [Opt_OverloadedStrings, Opt_ExtendedDefaultRules, Opt_ImplicitPrelude, Opt_ScopedTypeVariables]

119 xopts = [Opt_OverloadedStrings, Opt_ExtendedDefaultRules, Opt_ImplicitPrelude, Opt_ScopedTypeVariables]

73#endif

120#endif

74 gopts = [] --[Opt_DistrustAllPackages, Opt_PackageTrust]

121 gopts = [] --[Opt_DistrustAllPackages, Opt_PackageTrust]

75− required_packages = ["base",

122+ required_packages = ["base",

76 "containers",

123 "containers",

77 "Glob",

124 "Glob",

78 "directory",

125 "directory",

@@ -81,8 +128,6 @@ initScriptSession ghcPkgPaths = do

81 "uuid",

128 "uuid",

82 "vector",

129 "vector",

83 "text",

130 "text",

84− "binary",

85− "vector-binary-instances",

86 "time",

131 "time",

87 "project-m36",

132 "project-m36",

88 "bytestring"]

133 "bytestring"]

@@ -94,16 +139,33 @@ initScriptSession ghcPkgPaths = do

94 --liftIO $ traceShowM (showSDoc dflags' (ppr packages))

139 --liftIO $ traceShowM (showSDoc dflags' (ppr packages))

95 _ <- setSessionDynFlags dflags'

140 _ <- setSessionDynFlags dflags'

96 let safeImportDecl mn mQual = ImportDecl {

141 let safeImportDecl mn mQual = ImportDecl {

142+#if __GLASGOW_HASKELL__ >= 802

143+ ideclSourceSrc = NoSourceText,

144+#else

97 ideclSourceSrc = Nothing,

145 ideclSourceSrc = Nothing,

146+#endif

147+

148+#if __GLASGOW_HASKELL__ >= 810

149+ ideclExt = noExtField,

150+#elif __GLASGOW_HASKELL__ >= 806

151+ ideclExt = NoExt,

152+#endif

98 ideclName = noLoc mn,

153 ideclName = noLoc mn,

99 ideclPkgQual = Nothing,

154 ideclPkgQual = Nothing,

100 ideclSource = False,

155 ideclSource = False,

101 ideclSafe = True,

156 ideclSafe = True,

102 ideclImplicit = False,

157 ideclImplicit = False,

158+#if __GLASGOW_HASKELL__ >= 810

159+ ideclQualified = if isJust mQual then QualifiedPre else NotQualified,

160+#else

103 ideclQualified = isJust mQual,

161 ideclQualified = isJust mQual,

162+#endif

104 ideclAs = mQual,

163 ideclAs = mQual,

105 ideclHiding = Nothing

164 ideclHiding = Nothing

106 }

165 }

166+#if __GLASGOW_HASKELL__ >= 806

167+ :: ImportDecl (GhcPass (c :: Pass))

168+#endif

107 unqualifiedModules = map (\modn -> IIDecl $ safeImportDecl (mkModuleName modn) Nothing) [

169 unqualifiedModules = map (\modn -> IIDecl $ safeImportDecl (mkModuleName modn) Nothing) [

108 "Prelude",

170 "Prelude",

109 "Data.Map",

171 "Data.Map",

@@ -116,7 +178,12 @@ initScriptSession ghcPkgPaths = do

116 "ProjectM36.DatabaseContextFunctionError",

178 "ProjectM36.DatabaseContextFunctionError",

117 "ProjectM36.DatabaseContextFunctionUtils",

179 "ProjectM36.DatabaseContextFunctionUtils",

118 "ProjectM36.RelationalExpression"]

180 "ProjectM36.RelationalExpression"]

181+#if __GLASGOW_HASKELL__ >= 802

182+ mkModName = noLoc . mkModuleName

183+#else

184+ mkModName = mkModuleName

185+#endif

119− qualifiedModules = map (\(modn, qualNam) -> IIDecl $ safeImportDecl (mkModuleName modn) (Just (mkModuleName qualNam))) [

186+ qualifiedModules = map (\(modn, qualNam) -> IIDecl $ safeImportDecl (mkModuleName modn) (Just (mkModName qualNam))) [

120 ("Data.Text", "T")

187 ("Data.Text", "T")

121 ]

188 ]

122 setContext (unqualifiedModules ++ qualifiedModules)

189 setContext (unqualifiedModules ++ qualifiedModules)

@@ -128,8 +195,8 @@ initScriptSession ghcPkgPaths = do

128addImport :: String -> Ghc ()

195addImport :: String -> Ghc ()

129addImport moduleNam = do

196addImport moduleNam = do

130 ctx <- getContext

197 ctx <- getContext

131− setContext ( (IIDecl $ simpleImportDecl (mkModuleName moduleNam)) : ctx )

198+ setContext (IIDecl (simpleImportDecl (mkModuleName moduleNam)) : ctx)

132−

199+

133showType :: DynFlags -> Type -> String

200showType :: DynFlags -> Type -> String

134showType dflags ty = showSDocForUser dflags alwaysQualify (pprTypeForUser ty)

201showType dflags ty = showSDocForUser dflags alwaysQualify (pprTypeForUser ty)

135

202

@@ -154,21 +221,55 @@ compileScript funcType script = do

154 mErr <- typeCheckScript funcType script

221 mErr <- typeCheckScript funcType script

155 case mErr of

222 case mErr of

156 Just err -> pure (Left err)

223 Just err -> pure (Left err)

157− Nothing -> do

224+ Nothing ->

158 --catch exception here

225 --catch exception here

159 --we could potentially wrap the script with Atom pattern matching so that the script doesn't have to do it, but the change to an Atom ADT should make it easier. Still, it would be nice if the script didn't have to handle a list of arguments, for example.

226 --we could potentially wrap the script with Atom pattern matching so that the script doesn't have to do it, but the change to an Atom ADT should make it easier. Still, it would be nice if the script didn't have to handle a list of arguments, for example.

160 -- we can't use dynCompileExpr here because

227 -- we can't use dynCompileExpr here because

161− func <- compileExpr sScript

162− pure $ Right (unsafeCoerce func)

228+ Right . unsafeCoerce <$> compileExpr sScript

163−

229+

164−typeCheckScript :: Type -> Text -> Ghc (Maybe ScriptCompilationError)

230+typeCheckScript :: Type -> Text -> Ghc (Maybe ScriptCompilationError)

165typeCheckScript expectedType inp = do

231typeCheckScript expectedType inp = do

166− dflags <- getSessionDynFlags

232+ dflags <- getSessionDynFlags

167 --catch exception for SyntaxError

233 --catch exception for SyntaxError

234+#if __GLASGOW_HASKELL__ >= 802

235+ funcType <- GHC.exprType TM_Inst (unpack inp)

236+#else

168 funcType <- GHC.exprType (unpack inp)

237 funcType <- GHC.exprType (unpack inp)

238+#endif

169− --liftIO $ putStrLn $ showType dflags expectedType ++ ":::" ++ showType dflags funcType

239+ --liftIO $ putStrLn $ showType dflags expectedType ++ ":::" ++ showType dflags funcType

170 if eqType funcType expectedType then

240 if eqType funcType expectedType then

171 pure Nothing

241 pure Nothing

172 else

242 else

173 pure (Just (TypeCheckCompilationError (showType dflags expectedType) (showType dflags funcType)))

243 pure (Just (TypeCheckCompilationError (showType dflags expectedType) (showType dflags funcType)))

174−

244+

245+mangleSymbol :: Maybe String -> String -> String -> String

246+mangleSymbol pkg module' valsym =

247+ prefixUnderscore ++

248+ maybe "" (\p -> zEncodeString p ++ "_") pkg ++

249+ zEncodeString module' ++ "_" ++ zEncodeString valsym ++ "_closure"

250+

251+loadFunction :: ModName -> FuncName -> FilePath -> IO (Either LoadSymbolError a)

252+loadFunction modName funcName objPath = do

253+#if __GLASGOW_HASKELL__ >= 802

254+ initObjLinker RetainCAFs

255+#else

256+ initObjLinker

257+#endif

258+ loadObj objPath

259+ _ <- resolveObjs

260+ ptr <- lookupSymbol (mangleSymbol Nothing modName funcName)

261+ case ptr of

262+ Nothing -> pure (Left LoadSymbolError)

263+ Just (Ptr addr) -> case addrToAny# addr of

264+ (# hval #) -> pure (Right hval)

265+

266+prefixUnderscore :: String

267+prefixUnderscore =

268+ case (os,arch) of

269+ ("mingw32","x86_64") -> ""

270+ ("cygwin","x86_64") -> ""

271+ ("mingw32",_) -> "_"

272+ ("darwin",_) -> "_"

273+ ("cygwin",_) -> "_"

274+ _ -> ""

275+#endif

src/lib/ProjectM36/Serialise/AtomFunctionError.hsnew file+7

@@ -0,0 +1,7 @@

1+{-# LANGUAGE DerivingVia, StandaloneDeriving #-}

2+{-# OPTIONS_GHC -fno-warn-orphans #-}

3+module ProjectM36.Serialise.AtomFunctionError where

4+import Codec.Winery

5+import ProjectM36.AtomFunctionError

7+deriving via WineryVariant AtomFunctionError instance Serialise AtomFunctionError

src/lib/ProjectM36/Serialise/Base.hsnew file+85

@@ -0,0 +1,85 @@

1+{-# LANGUAGE StandaloneDeriving, DerivingVia, TypeApplications, TypeSynonymInstances, ScopedTypeVariables #-}

2+{-# OPTIONS_GHC -fno-warn-orphans #-}

3+--Serialise instances for ProjectM36.Base data types- orphan instance city

4+module ProjectM36.Serialise.Base where

5+import Codec.Winery hiding (Schema)

6+import Codec.Winery.Internal

7+import Control.Monad

8+import ProjectM36.Base

9+import ProjectM36.MerkleHash

10+import Data.UUID

11+import Data.Proxy

12+import Data.Word

13+import ProjectM36.Attribute as A

14+import qualified Data.List.NonEmpty as NE

15+import qualified Data.Vector as V

16+import Data.Time.Calendar (Day,toGregorian,fromGregorian)

17+

18+deriving via WineryVariant Atom instance Serialise Atom

19+deriving via WineryVariant AtomType instance Serialise AtomType

20+deriving via WineryVariant Attribute instance Serialise Attribute

21+deriving via WineryVariant RelationTupleSet instance Serialise RelationTupleSet

22+deriving via WineryVariant RelationTuple instance Serialise RelationTuple

23+deriving via WineryVariant Relation instance Serialise Relation

24+deriving via WineryVariant RelationCardinality instance Serialise RelationCardinality

25+deriving via WineryVariant (RelationalExprBase a) instance Serialise a => Serialise (RelationalExprBase a)

26+deriving via WineryVariant (WithNameExprBase a) instance Serialise a => Serialise (WithNameExprBase a)

27+deriving via WineryVariant Notification instance Serialise Notification

28+deriving via WineryVariant TypeConstructorDef instance Serialise TypeConstructorDef

29+deriving via WineryVariant (TypeConstructorBase a) instance Serialise a => Serialise (TypeConstructorBase a)

30+deriving via WineryVariant DataConstructorDef instance Serialise DataConstructorDef

31+deriving via WineryVariant DataConstructorDefArg instance Serialise DataConstructorDefArg

32+deriving via WineryVariant GraphRefTransactionMarker instance Serialise GraphRefTransactionMarker

33+deriving via WineryVariant SchemaIsomorph instance Serialise SchemaIsomorph

34+deriving via WineryVariant InclusionDependency instance Serialise InclusionDependency

35+deriving via WineryVariant (DatabaseContextExprBase a) instance Serialise a => Serialise (DatabaseContextExprBase a)

36+deriving via WineryVariant (DatabaseContextIOExprBase a) instance Serialise a => Serialise (DatabaseContextIOExprBase a)

37+deriving via WineryVariant (RestrictionPredicateExprBase a) instance Serialise a => Serialise (RestrictionPredicateExprBase a)

38+deriving via WineryVariant TransactionInfo instance Serialise TransactionInfo

39+deriving via WineryVariant (AtomExprBase a) instance Serialise a => Serialise (AtomExprBase a)

40+deriving via WineryVariant MerkleHash instance Serialise MerkleHash

41+deriving via WineryVariant (AttributeExprBase a) instance Serialise a => Serialise (AttributeExprBase a)

42+deriving via WineryVariant (TupleExprsBase a) instance Serialise a => Serialise (TupleExprsBase a)

43+deriving via WineryVariant (TupleExprBase a) instance Serialise a => Serialise (TupleExprBase a)

44+deriving via WineryVariant (AttributeNamesBase a) instance Serialise a => Serialise (AttributeNamesBase a)

45+deriving via WineryVariant (ExtendTupleExprBase a) instance Serialise a => Serialise (ExtendTupleExprBase a)

46+deriving via WineryVariant Schema instance Serialise Schema

47+deriving via WineryVariant MergeStrategy instance Serialise MergeStrategy

48+

49+fromWordsTup :: (Word32, Word32, Word32, Word32) -> TransactionId

50+fromWordsTup (a,b,c,d) = fromWords a b c d

51+

52+instance Serialise TransactionId where

53+ schemaGen _ = getSchema (Proxy @(Word32, Word32, Word32, Word32))

54+ toBuilder uuid = toBuilder (toWords uuid)

55+ extractor = fromWordsTup <$> extractor

56+ decodeCurrent = fromWordsTup <$> decodeCurrent

57+

58+instance Serialise a => Serialise (NE.NonEmpty a) where

59+ schemaGen _ = SVector <$> getSchema (Proxy @a)

60+ toBuilder xs = varInt (length xs) <> foldMap toBuilder xs

61+ extractor = NE.fromList . V.toList <$> extractListBy extractor --use nonempty instead to replace error with winery error

62+ decodeCurrent = do

63+ n <- decodeVarInt

64+ l <- replicateM n decodeCurrent

65+ pure (NE.fromList l)

66+

67+fromGregorianTup :: (Integer, Int, Int) -> Day

68+fromGregorianTup (a, b, c) = fromGregorian a b c

69+

70+instance Serialise Day where

71+ schemaGen _ = getSchema (Proxy @(Integer, Int, Int))

72+ toBuilder day = toBuilder (toGregorian day)

73+ extractor = fromGregorianTup <$> extractor

74+ decodeCurrent = fromGregorianTup <$> decodeCurrent

75+

76+instance Serialise Attributes where

77+ schemaGen _ = SVector <$> getSchema (Proxy @Attribute)

78+ toBuilder attrs = varInt (V.length (attributesVec attrs)) <> foldMap toBuilder (V.toList (attributesVec attrs))

79+ extractor =

80+ attributesFromList . V.toList <$> extractListBy extractor

81+

82+ decodeCurrent = do

83+ n <- decodeVarInt

84+ l <- replicateM n decodeCurrent

85+ pure (A.attributesFromList l)

src/lib/ProjectM36/Serialise/DataFrame.hsnew file+13

@@ -0,0 +1,13 @@

1+{-# LANGUAGE DerivingVia, StandaloneDeriving #-}

2+{-# OPTIONS_GHC -fno-warn-orphans #-}

3+module ProjectM36.Serialise.DataFrame where

4+import Codec.Winery

5+import ProjectM36.DataFrame

6+import ProjectM36.Serialise.Base ()

8+deriving via WineryVariant AttributeOrderExpr instance Serialise AttributeOrderExpr

9+deriving via WineryVariant AttributeOrder instance Serialise AttributeOrder

10+deriving via WineryVariant Order instance Serialise Order

11+deriving via WineryRecord DataFrame instance Serialise DataFrame

12+deriving via WineryVariant DataFrameTuple instance Serialise DataFrameTuple

13+deriving via WineryRecord DataFrameExpr instance Serialise DataFrameExpr

src/lib/ProjectM36/Serialise/DatabaseContextFunctionError.hsnew file+7

@@ -0,0 +1,7 @@

1+{-# LANGUAGE DerivingVia, StandaloneDeriving #-}

2+{-# OPTIONS_GHC -fno-warn-orphans #-}

3+module ProjectM36.Serialise.DatabaseContextFunctionError where

4+import Codec.Winery

5+import ProjectM36.DatabaseContextFunctionError

7+deriving via WineryVariant DatabaseContextFunctionError instance Serialise DatabaseContextFunctionError

src/lib/ProjectM36/Serialise/Error.hsnew file+15

@@ -0,0 +1,15 @@

1+{-# LANGUAGE DerivingVia, StandaloneDeriving #-}

2+{-# OPTIONS_GHC -fno-warn-orphans #-}

3+module ProjectM36.Serialise.Error where

4+import ProjectM36.Error

5+import Codec.Winery

6+import ProjectM36.Serialise.Base ()

7+import ProjectM36.Serialise.AtomFunctionError ()

8+import ProjectM36.Serialise.DatabaseContextFunctionError ()

10+deriving via WineryVariant RelationalError instance Serialise RelationalError

11+deriving via WineryVariant MergeError instance Serialise MergeError

12+deriving via WineryVariant ScriptCompilationError instance Serialise ScriptCompilationError

13+deriving via WineryVariant PersistenceError instance Serialise PersistenceError

14+deriving via WineryVariant SchemaError instance Serialise SchemaError

15+deriving via WineryVariant ImportError' instance Serialise ImportError'

src/lib/ProjectM36/Serialise/IsomorphicSchema.hsnew file+7

@@ -0,0 +1,7 @@

1+{-# LANGUAGE StandaloneDeriving, DerivingVia, TypeSynonymInstances, ScopedTypeVariables #-}

2+{-# OPTIONS_GHC -fno-warn-orphans #-}

3+module ProjectM36.Serialise.IsomorphicSchema where

4+import Codec.Winery

5+import ProjectM36.IsomorphicSchema

7+deriving via WineryVariant SchemaExpr instance Serialise SchemaExpr

src/lib/ProjectM36/Serialise/MergeError.hsnew file+1

@@ -0,0 +1 @@

src/lib/ProjectM36/Server.hs+166−82

@@ -7,73 +7,119 @@ import ProjectM36.Server.RemoteCallTypes

7import ProjectM36.Server.Config (ServerConfig(..))

8import ProjectM36.FSType

10−import Control.Monad.IO.Class (liftIO)

11−import Network.Transport.TCP (createTransport, defaultTCPParameters)

12−import Network.Transport (EndPointAddress(..), newEndPoint, address)

13−import Control.Distributed.Process.Node (initRemoteTable, runProcess, newLocalNode, initRemoteTable)

14−import Control.Distributed.Process.Extras.Time (Delay(..))

15−import Control.Distributed.Process (Process, register, getSelfPid)

16−import Control.Distributed.Process.ManagedProcess (defaultProcess, UnhandledMessagePolicy(..), ProcessDefinition(..), handleCall, serve, InitHandler, InitResult(..))

17−import Control.Concurrent.MVar (putMVar, MVar)

10+import Control.Concurrent.MVar (MVar)

18import System.IO (stderr, hPutStrLn)

11import System.IO (stderr, hPutStrLn)

19import System.FilePath (takeDirectory)

12import System.FilePath (takeDirectory)

20import System.Directory (doesDirectoryExist)

13import System.Directory (doesDirectoryExist)

14+import Network.RPC.Curryer.Server

15+import Network.Socket

16+import qualified StmContainers.Map as StmMap

17+import Control.Concurrent.STM

22−-- the state should be a mapping of remote connection to the disconnected transaction- the graph should be the same, so discon must be removed from the stm tuple

19+type TestMode = Bool

23−--trying to refactor this for less repetition is very challenging because the return type cannot be polymorphic or the distributed-process call gets confused and drops messages

24−serverDefinition :: Bool -> Timeout -> ProcessDefinition Connection

25−serverDefinition testBool ti = defaultProcess {

26− apiHandlers = [

27− handleCall (\conn (ExecuteHeadName sessionId) -> handleExecuteHeadName ti sessionId conn),

28− handleCall (\conn (ExecuteRelationalExpr sessionId expr) -> handleExecuteRelationalExpr ti sessionId conn expr),

29− handleCall (\conn (ExecuteDatabaseContextExpr sessionId expr) -> handleExecuteDatabaseContextExpr ti sessionId conn expr),

30− handleCall (\conn (ExecuteDatabaseContextIOExpr sessionId expr) -> handleExecuteDatabaseContextIOExpr ti sessionId conn expr),

31− handleCall (\conn (ExecuteGraphExpr sessionId expr) -> handleExecuteGraphExpr ti sessionId conn expr),

32− handleCall (\conn (ExecuteTransGraphRelationalExpr sessionId expr) -> handleExecuteTransGraphRelationalExpr ti sessionId conn expr),

33− handleCall (\conn (ExecuteTypeForRelationalExpr sessionId expr) -> handleExecuteTypeForRelationalExpr ti sessionId conn expr),

34− handleCall (\conn (RetrieveInclusionDependencies sessionId) -> handleRetrieveInclusionDependencies ti sessionId conn),

35− handleCall (\conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr) -> handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr),

36− handleCall (\conn (RetrieveHeadTransactionId sessionId) -> handleRetrieveHeadTransactionId ti sessionId conn),

37− handleCall (\conn (RetrieveTransactionGraph sessionId) -> handleRetrieveTransactionGraph ti sessionId conn),

38− handleCall (\conn (Login procId) -> handleLogin ti conn procId),

39− handleCall (\conn (CreateSessionAtHead headn) -> handleCreateSessionAtHead ti conn headn),

40− handleCall (\conn (CreateSessionAtCommit commitId) -> handleCreateSessionAtCommit ti conn commitId),

41− handleCall (\conn (CloseSession sessionId) -> handleCloseSession ti sessionId conn),

42− handleCall (\conn (RetrieveAtomTypesAsRelation sessionId) -> handleRetrieveAtomTypesAsRelation ti sessionId conn),

43− handleCall (\conn (RetrieveRelationVariableSummary sessionId) -> handleRetrieveRelationVariableSummary ti sessionId conn),

44− handleCall (\conn (RetrieveCurrentSchemaName sessionId) -> handleRetrieveCurrentSchemaName ti sessionId conn),

45− handleCall (\conn (ExecuteSchemaExpr sessionId schemaExpr) -> handleExecuteSchemaExpr ti sessionId conn schemaExpr),

46− handleCall (\conn (RetrieveSessionIsDirty sessionId) -> handleRetrieveSessionIsDirty ti sessionId conn),

47− handleCall (\conn (ExecuteAutoMergeToHead sessionId strat headName') -> handleExecuteAutoMergeToHead ti sessionId conn strat headName'),

48− handleCall (\conn (RetrieveTypeConstructorMapping sessionId) -> handleRetrieveTypeConstructorMapping ti sessionId conn),

49− handleCall (\conn Logout -> handleLogout ti conn)

50− ] ++ testModeHandlers,

51− unhandledMessagePolicy = Terminate

52− --unhandledMessagePolicy = Log

53− }

54− where

55− testModeHandlers = if not testBool then

56− []

57− else

58− [handleCall (\conn (TestTimeout sessionId) -> handleTestTimeout ti sessionId conn)]

59−

60−

61−initServer :: InitHandler (Connection, DatabaseName, Maybe (MVar EndPointAddress), EndPointAddress) Connection

62−initServer (conn, dbname, mAddressMVar, saddress) = do

63− registerDB dbname

64− case mAddressMVar of

65− Nothing -> pure ()

66− Just addressMVar -> liftIO $ putMVar addressMVar saddress

67− --traceShowM ("server started on " ++ show saddress)

68− pure $ InitOk conn Infinity

70−registerDB :: DatabaseName -> Process ()

21+requestHandlers :: TestMode -> Maybe Timeout -> RequestHandlers ServerState

71−registerDB dbname = do

22+requestHandlers testFlag ti =

72− self <- getSelfPid

23+ [

73− let dbname' = remoteDBLookupName dbname

24+ RequestHandler (\sState (Login dbName) -> do

74− register dbname' self

25+ addClientLogin dbName sState

75− --liftIO $ putStrLn $ "registered " ++ (show self) ++ " " ++ dbname'

26+ conn <- getConn sState

76−

27+ handleLogin conn (connectionSocket sState)),

28+ RequestHandler (\sState Logout -> do

29+ conn <- getConn sState

30+ handleLogout ti conn),

31+ RequestHandler $ \sState (ExecuteHeadName sessionId) -> do

32+ --socket -> dbname --maybe create a socket->client state mapping in the server state, too

33+ conn <- getConn sState

34+ handleExecuteHeadName ti sessionId conn,

35+ RequestHandler (\sState (ExecuteRelationalExpr sessionId expr) -> do

36+ conn <- getConn sState

37+ handleExecuteRelationalExpr ti sessionId conn expr),

38+ RequestHandler (\sState (ExecuteDataFrameExpr sessionId expr) -> do

39+ conn <- getConn sState

40+ handleExecuteDataFrameExpr ti sessionId conn expr),

41+ RequestHandler (\sState (ExecuteDatabaseContextExpr sessionId expr) -> do

42+ conn <- getConn sState

43+ handleExecuteDatabaseContextExpr ti sessionId conn expr),

44+ RequestHandler (\sState (ExecuteDatabaseContextIOExpr sessionId expr) -> do

45+ conn <- getConn sState

46+ handleExecuteDatabaseContextIOExpr ti sessionId conn expr),

47+ RequestHandler (\sState (ExecuteGraphExpr sessionId expr) -> do

48+ conn <- getConn sState

49+ handleExecuteGraphExpr ti sessionId conn expr),

50+ RequestHandler (\sState (ExecuteTransGraphRelationalExpr sessionId expr) -> do

51+ conn <- getConn sState

52+ handleExecuteTransGraphRelationalExpr ti sessionId conn expr),

53+ RequestHandler (\sState (ExecuteTypeForRelationalExpr sessionId expr) -> do

54+ conn <- getConn sState

55+ handleExecuteTypeForRelationalExpr ti sessionId conn expr),

56+ RequestHandler (\sState (RetrieveInclusionDependencies sessionId) -> do

57+ conn <- getConn sState

58+ handleRetrieveInclusionDependencies ti sessionId conn),

59+ RequestHandler (\sState (RetrievePlanForDatabaseContextExpr sessionId dbExpr) -> do

60+ conn <- getConn sState

61+ handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr),

62+ RequestHandler (\sState (RetrieveHeadTransactionId sessionId) -> do

63+ conn <- getConn sState

64+ handleRetrieveHeadTransactionId ti sessionId conn),

65+ RequestHandler (\sState (RetrieveTransactionGraph sessionId) -> do

66+ conn <- getConn sState

67+ handleRetrieveTransactionGraph ti sessionId conn),

68+ RequestHandler (\sState (CreateSessionAtHead headn) -> do

69+ conn <- getConn sState

70+ handleCreateSessionAtHead ti conn headn),

71+ RequestHandler (\sState (CreateSessionAtCommit commitId) -> do

72+ conn <- getConn sState

73+ handleCreateSessionAtCommit ti conn commitId),

74+ RequestHandler (\sState (CloseSession sessionId) -> do

75+ conn <- getConn sState

76+ handleCloseSession sessionId conn),

77+ RequestHandler (\sState (RetrieveAtomTypesAsRelation sessionId) -> do

78+ conn <- getConn sState

79+ handleRetrieveAtomTypesAsRelation ti sessionId conn),

80+ RequestHandler (\sState (RetrieveRelationVariableSummary sessionId) -> do

81+ conn <- getConn sState

82+ handleRetrieveRelationVariableSummary ti sessionId conn),

83+ RequestHandler (\sState (RetrieveAtomFunctionSummary sessionId) -> do

84+ conn <- getConn sState

85+ handleRetrieveAtomFunctionSummary ti sessionId conn),

86+ RequestHandler (\sState (RetrieveDatabaseContextFunctionSummary sessionId) -> do

87+ conn <- getConn sState

88+ handleRetrieveDatabaseContextFunctionSummary ti sessionId conn), RequestHandler (\sState (RetrieveCurrentSchemaName sessionId) -> do

89+ conn <- getConn sState

90+ handleRetrieveCurrentSchemaName ti sessionId conn),

91+ RequestHandler (\sState (ExecuteSchemaExpr sessionId schemaExpr) -> do

92+ conn <- getConn sState

93+ handleExecuteSchemaExpr ti sessionId conn schemaExpr),

94+ RequestHandler (\sState (RetrieveSessionIsDirty sessionId) -> do

95+ conn <- getConn sState

96+ handleRetrieveSessionIsDirty ti sessionId conn),

97+ RequestHandler (\sState (ExecuteAutoMergeToHead sessionId strat headName') -> do

98+ conn <- getConn sState

99+ handleExecuteAutoMergeToHead ti sessionId conn strat headName'),

100+ RequestHandler (\sState (RetrieveTypeConstructorMapping sessionId) -> do

101+ conn <- getConn sState

102+ handleRetrieveTypeConstructorMapping ti sessionId conn),

103+ RequestHandler (\sState (ExecuteValidateMerkleHashes sessionId) -> do

104+ conn <- getConn sState

105+ handleValidateMerkleHashes ti sessionId conn)

106+ ] ++ if testFlag then testModeHandlers ti else []

107+

108+getConn :: ConnectionState ServerState -> IO Connection

109+getConn connState = do

110+ let sock = lockless (connectionSocket connState)

111+ sState = connectionServerState connState

112+ mConn <- connectionForClient sock sState

113+ case mConn of

114+ Nothing -> error "failed to find socket in client map"

115+ Just conn -> pure conn

116+

117+testModeHandlers :: Maybe Timeout -> RequestHandlers ServerState

118+testModeHandlers ti = [RequestHandler (\sState (TestTimeout sessionId) -> do

119+ conn <- getConn sState

120+ handleTestTimeout ti sessionId conn)]

121+

122+

77-- | A notification callback which logs the notification to stderr and does nothing else.

123-- | A notification callback which logs the notification to stderr and does nothing else.

78loggingNotificationCallback :: NotificationCallback

124loggingNotificationCallback :: NotificationCallback

79loggingNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received \"" ++ show notName ++ "\": " ++ show evaldNot

125loggingNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received \"" ++ show notName ++ "\": " ++ show evaldNot

@@ -98,9 +144,47 @@ checkFSType performCheck strat =

98checkFSErrorMsg :: String

144checkFSErrorMsg :: String

99checkFSErrorMsg = "The filesystem does not support journaling so writes may not be crash-safe. Use --disable-fscheck to disable this fatal error."

145checkFSErrorMsg = "The filesystem does not support journaling so writes may not be crash-safe. Use --disable-fscheck to disable this fatal error."

100

146

147+-- Sockets do not implement hashable, so we just use their string values as keys

148+type SocketString = String

149+

150+data ServerState =

151+ ServerState {

152+ --map available databases to local database configurations

153+ stateDBMap :: StmMap.Map DatabaseName Connection,

154+ --map clients to database names- after logging in, clients are afixed to specific database names

155+ stateClientMap :: StmMap.Map SocketString DatabaseName

156+ }

157+

158+-- add a client socket to the database mapping

159+addClientLogin :: DatabaseName -> ConnectionState ServerState -> IO ()

160+addClientLogin dbName cState = do

161+ let clientMap = stateClientMap (connectionServerState cState)

162+ sock = lockless (connectionSocket cState)

163+ atomically $ do

164+ mVal <- StmMap.lookup (show sock) clientMap

165+ case mVal of

166+ Nothing -> StmMap.insert dbName (show sock) clientMap

167+ Just _ -> pure () --TODO: throw exception- user already logged in

168+

169+connectionForClient :: Socket -> ServerState -> IO (Maybe Connection)

170+connectionForClient sock sState =

171+ atomically $ do

172+ mdbname <- StmMap.lookup (show sock) (stateClientMap sState)

173+ case mdbname of

174+ Nothing -> pure Nothing

175+ Just dbname ->

176+ StmMap.lookup dbname (stateDBMap sState)

177+

178+initialServerState :: DatabaseName -> Connection -> IO ServerState

179+initialServerState dbName conn =

180+ atomically $ do

181+ dbmap <- StmMap.new

182+ clientMap <- StmMap.new

183+ StmMap.insert conn dbName dbmap

184+ pure (ServerState { stateDBMap = dbmap, stateClientMap = clientMap })

101-- | A synchronous function to start the project-m36 daemon given an appropriate 'ServerConfig'. Note that this function only returns if the server exits. Returns False if the daemon exited due to an error. If the second argument is not Nothing, the port is put after the server is ready to service the port.

185-- | A synchronous function to start the project-m36 daemon given an appropriate 'ServerConfig'. Note that this function only returns if the server exits. Returns False if the daemon exited due to an error. If the second argument is not Nothing, the port is put after the server is ready to service the port.

102−launchServer :: ServerConfig -> Maybe (MVar EndPointAddress) -> IO Bool

186+launchServer :: ServerConfig -> Maybe (MVar SockAddr) -> IO Bool

103−launchServer daemonConfig mAddressMVar = do

187+launchServer daemonConfig mAddr = do

104 checkFSResult <- checkFSType (checkFS daemonConfig) (persistenceStrategy daemonConfig)

188 checkFSResult <- checkFSType (checkFS daemonConfig) (persistenceStrategy daemonConfig)

105 if not checkFSResult then do

189 if not checkFSResult then do

106 hPutStrLn stderr checkFSErrorMsg

190 hPutStrLn stderr checkFSErrorMsg

@@ -113,21 +197,21 @@ launchServer daemonConfig mAddressMVar = do

113 pure False

197 pure False

114 Right conn -> do

198 Right conn -> do

115 let hostname = bindHost daemonConfig

199 let hostname = bindHost daemonConfig

116− port = bindPort daemonConfig

200+ port = fromIntegral (bindPort daemonConfig)

117− etransport <- createTransport hostname (show port) defaultTCPParameters

201+

118− case etransport of

202+

119− Left err -> error ("failed to create transport: " ++ show err)

203+ --curryer only supports IPv4 for now

120− Right transport -> do

204+ let addrHints = defaultHints { addrSocketType = Stream, addrFamily = AF_INET }

121− eEndpoint <- newEndPoint transport

205+ hostAddrs <- getAddrInfo (Just addrHints) (Just hostname) Nothing

122− case eEndpoint of

206+ case hostAddrs of

123− Left err -> hPutStrLn stderr ("Failed to create transport: " ++ show err) >> pure False

207+ [] -> hPutStrLn stderr ("Failed to resolve: " <> hostname) >> pure False

124− Right endpoint -> do

208+ (AddrInfo _ _ _ _ (SockAddrInet _ addr32) _):_ -> do

125− localTCPNode <- newLocalNode transport initRemoteTable

209+ let hostAddr = hostAddressToTuple addr32

126− --traceShowM ("newLocalNode in Server " ++ show (localNodeId localTCPNode))

127− runProcess localTCPNode $ do

128− let testBool = testMode daemonConfig

129− reqTimeout = perRequestTimeout daemonConfig

210+ mTimeout = fromIntegral <$> case perRequestTimeout daemonConfig of

130− serve (conn, databaseName daemonConfig, mAddressMVar, address endpoint) initServer (serverDefinition testBool reqTimeout)

211+ 0 -> Nothing

131− liftIO $ putStrLn "serve returned"

212+ v -> Just v

132− pure True

213+

133−

214+ sState <- initialServerState (databaseName daemonConfig) conn

215+ serve (requestHandlers (testMode daemonConfig) mTimeout) sState hostAddr port mAddr

216+ _ -> error "unsupported socket addressing mode (IPv4 only currently)"

217+

src/lib/ProjectM36/Server/Config.hs+6

@@ -12,6 +12,12 @@ data ServerConfig = ServerConfig { persistenceStrategy :: PersistenceStrategy,

12 }

13 deriving (Show)

15+data WebsocketServerConfig = WebsocketServerConfig { wsServerConfig :: ServerConfig,

16+ tlsCertificatePath :: Maybe String,

17+ tlsKeyPath :: Maybe String

18+ }

19+ deriving (Show)

20+

15defaultServerConfig :: ServerConfig

21defaultServerConfig :: ServerConfig

16defaultServerConfig = ServerConfig { persistenceStrategy = NoPersistence,

22defaultServerConfig = ServerConfig { persistenceStrategy = NoPersistence,

17 checkFS = True,

23 checkFS = True,

src/lib/ProjectM36/Server/EntryPoints.hs+127−138

@@ -1,157 +1,146 @@

1+{-# LANGUAGE MonoLocalBinds #-}

1module ProjectM36.Server.EntryPoints where

2module ProjectM36.Server.EntryPoints where

2import ProjectM36.Base hiding (inclusionDependencies)

3import ProjectM36.Base hiding (inclusionDependencies)

3import ProjectM36.IsomorphicSchema

4import ProjectM36.IsomorphicSchema

4import ProjectM36.Client as C

5import ProjectM36.Client as C

5−import ProjectM36.Error

6−import Control.Distributed.Process (Process, ProcessId)

7−import Control.Distributed.Process.ManagedProcess (ProcessReply)

8−import Control.Distributed.Process.ManagedProcess.Server (reply)

9−import Control.Distributed.Process.Async (async, task, waitCancelTimeout, AsyncResult(..))

10−import Control.Distributed.Process.Serializable (Serializable)

11−import Control.Monad.IO.Class (liftIO)

12import Data.Map

6import Data.Map

13import Control.Concurrent (threadDelay)

7import Control.Concurrent (threadDelay)

8+import Network.RPC.Curryer.Server

9+import System.Timeout hiding (Timeout)

10+import Network.Socket

11+import Control.Exception

15−timeoutOrDie :: Serializable a => Timeout -> IO a -> Process (Either ServerError a)

13+timeoutOrDie :: Maybe Timeout -> IO a -> IO (Maybe a)

16−timeoutOrDie micros act =

14+timeoutOrDie mMicros act =

17− if micros == 0 then

18− liftIO act >>= \x -> pure (Right x)

19− else do

20− asyncUnit <- async (task (liftIO act))

21− asyncRes <- waitCancelTimeout micros asyncUnit

22− case asyncRes of

15+ case mMicros of

23− AsyncDone x -> pure (Right x)

16+ Nothing -> Just <$> act

24− AsyncCancelled -> pure (Left RequestTimeoutError)

17+ Just micros ->

25− AsyncFailed reason -> pure (Left (ProcessDiedError (show reason)))

18+ timeout (fromIntegral micros) act

26− AsyncLinkFailed reason -> pure (Left (ProcessDiedError (show reason)))

27− AsyncPending -> pure (Left (ProcessDiedError "process pending"))

28−

29−type Timeout = Int

31−type Reply a = Process (ProcessReply (Either ServerError a) Connection)

20+timeoutRelErr :: Maybe Timeout -> IO (Either RelationalError a) -> IO (Either RelationalError a)

32−

21+timeoutRelErr mMicros act = do

33−handleExecuteRelationalExpr :: Timeout -> SessionId -> Connection -> RelationalExpr -> Reply (Either RelationalError Relation)

22+ ret <- timeoutOrDie mMicros act

34−handleExecuteRelationalExpr ti sessionId conn expr = do

35− ret <- timeoutOrDie ti (executeRelationalExpr sessionId conn expr)

36− reply ret conn

37−

38−handleExecuteDatabaseContextExpr :: Timeout -> SessionId -> Connection -> DatabaseContextExpr -> Reply (Either RelationalError ())

39−handleExecuteDatabaseContextExpr ti sessionId conn dbexpr = do

40− ret <- timeoutOrDie ti (executeDatabaseContextExpr sessionId conn dbexpr)

41− reply ret conn

42−

43−handleExecuteDatabaseContextIOExpr :: Timeout -> SessionId -> Connection -> DatabaseContextIOExpr -> Reply (Either RelationalError ())

44−handleExecuteDatabaseContextIOExpr ti sessionId conn dbexpr = do

45− ret <- timeoutOrDie ti (executeDatabaseContextIOExpr sessionId conn dbexpr)

46− reply ret conn

47−

48−handleExecuteHeadName :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError HeadName)

49−handleExecuteHeadName ti sessionId conn = do

50− ret <- timeoutOrDie ti (headName sessionId conn)

51− reply ret conn

52−

53−handleLogin :: Timeout -> Connection -> ProcessId -> Reply Bool

54−handleLogin ti conn newClientProcessId = do

55− ret <- timeoutOrDie ti (addClientNode conn newClientProcessId)

56 case ret of

23 case ret of

57− Right () -> reply (Right True) conn

24+ Nothing -> throw TimeoutException

58− Left err -> reply (Left err) conn

25+ Just v -> pure v

59−

26+

60−handleExecuteGraphExpr :: Timeout -> SessionId -> Connection -> TransactionGraphOperator -> Reply (Either RelationalError ())

61−handleExecuteGraphExpr ti sessionId conn graphExpr = do

62− ret <- timeoutOrDie ti (executeGraphExpr sessionId conn graphExpr)

63− reply ret conn

64−

65−handleExecuteTransGraphRelationalExpr :: Timeout -> SessionId -> Connection -> TransGraphRelationalExpr -> Reply (Either RelationalError Relation)

66−handleExecuteTransGraphRelationalExpr ti sessionId conn graphExpr = do

67− ret <- timeoutOrDie ti (executeTransGraphRelationalExpr sessionId conn graphExpr)

68− reply ret conn

70−handleExecuteTypeForRelationalExpr :: Timeout -> SessionId -> Connection -> RelationalExpr -> Reply (Either RelationalError Relation)

28+handleExecuteRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

71−handleExecuteTypeForRelationalExpr ti sessionId conn relExpr = do

29+handleExecuteRelationalExpr ti sessionId conn expr =

30+ timeoutRelErr ti (executeRelationalExpr sessionId conn expr)

31+

32+handleExecuteDataFrameExpr :: Maybe Timeout -> SessionId -> Connection -> DataFrameExpr -> IO (Either RelationalError DataFrame)

33+handleExecuteDataFrameExpr ti sessionId conn expr =

34+ timeoutRelErr ti (executeDataFrameExpr sessionId conn expr)

35+

36+handleExecuteDatabaseContextExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ())

37+handleExecuteDatabaseContextExpr ti sessionId conn dbexpr =

38+ timeoutRelErr ti (executeDatabaseContextExpr sessionId conn dbexpr)

39+

40+handleExecuteDatabaseContextIOExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextIOExpr -> IO (Either RelationalError ())

41+handleExecuteDatabaseContextIOExpr ti sessionId conn dbexpr =

42+ timeoutRelErr ti (executeDatabaseContextIOExpr sessionId conn dbexpr)

43+

44+handleExecuteHeadName :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError HeadName)

45+handleExecuteHeadName ti sessionId conn =

46+ timeoutRelErr ti (headName sessionId conn)

47+

48+handleLogin :: Connection -> Locking Socket -> IO Bool

49+handleLogin conn lockSock = do

50+ addClientNode conn lockSock

51+ pure True

52+

53+handleExecuteGraphExpr :: Maybe Timeout -> SessionId -> Connection -> TransactionGraphOperator -> IO (Either RelationalError ())

54+handleExecuteGraphExpr ti sessionId conn graphExpr =

55+ timeoutRelErr ti (executeGraphExpr sessionId conn graphExpr)

56+

57+handleExecuteTransGraphRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)

58+handleExecuteTransGraphRelationalExpr ti sessionId conn graphExpr =

59+ timeoutRelErr ti (executeTransGraphRelationalExpr sessionId conn graphExpr)

60+

61+handleExecuteTypeForRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

62+handleExecuteTypeForRelationalExpr ti sessionId conn relExpr =

72− ret <- timeoutOrDie ti (typeForRelationalExpr sessionId conn relExpr)

63+ timeoutRelErr ti (typeForRelationalExpr sessionId conn relExpr)

73− reply ret conn

64+

74−

75−handleRetrieveInclusionDependencies :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError (Map IncDepName InclusionDependency))

65+handleRetrieveInclusionDependencies :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError (Map IncDepName InclusionDependency))

76−handleRetrieveInclusionDependencies ti sessionId conn = do

66+handleRetrieveInclusionDependencies ti sessionId conn =

77− ret <- timeoutOrDie ti (inclusionDependencies sessionId conn)

67+ timeoutRelErr ti (inclusionDependencies sessionId conn)

78− reply ret conn

68+

79−

80−handleRetrievePlanForDatabaseContextExpr :: Timeout -> SessionId -> Connection -> DatabaseContextExpr -> Reply (Either RelationalError DatabaseContextExpr)

69+handleRetrievePlanForDatabaseContextExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr)

81−handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr = do

70+handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr =

82− ret <- timeoutOrDie ti (planForDatabaseContextExpr sessionId conn dbExpr)

71+ timeoutRelErr ti (planForDatabaseContextExpr sessionId conn dbExpr)

83− reply ret conn

72+

84−

85−handleRetrieveTransactionGraph :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)

73+handleRetrieveTransactionGraph :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)

86−handleRetrieveTransactionGraph ti sessionId conn = do

74+handleRetrieveTransactionGraph ti sessionId conn =

87− ret <- timeoutOrDie ti (transactionGraphAsRelation sessionId conn)

75+ timeoutRelErr ti (transactionGraphAsRelation sessionId conn)

88− reply ret conn

76+

89−

90−handleRetrieveHeadTransactionId :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError TransactionId)

77+handleRetrieveHeadTransactionId :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError TransactionId)

91−handleRetrieveHeadTransactionId ti sessionId conn = do

78+handleRetrieveHeadTransactionId ti sessionId conn =

92− ret <- timeoutOrDie ti (headTransactionId sessionId conn)

79+ timeoutRelErr ti (headTransactionId sessionId conn)

93− reply ret conn

94−

95−handleCreateSessionAtCommit :: Timeout -> Connection -> TransactionId -> Reply (Either RelationalError SessionId)

96−handleCreateSessionAtCommit ti conn commitId = do

97− ret <- timeoutOrDie ti (createSessionAtCommit conn commitId)

98− reply ret conn

99−

100−handleCreateSessionAtHead :: Timeout -> Connection -> HeadName -> Reply (Either RelationalError SessionId)

101−handleCreateSessionAtHead ti conn headn = do

102− ret <- timeoutOrDie ti (createSessionAtHead conn headn)

103− reply ret conn

104−

105−handleCloseSession :: Timeout -> SessionId -> Connection -> Reply ()

106−handleCloseSession ti sessionId conn = do

107− ret <- timeoutOrDie ti (closeSession sessionId conn)

108− case ret of

109− Right () -> reply (Right ()) conn

110− Left err -> reply (Left err) conn

111

81+handleCreateSessionAtCommit :: Maybe Timeout -> Connection -> TransactionId -> IO (Either RelationalError SessionId)

82+handleCreateSessionAtCommit ti conn commitId =

83+ timeoutRelErr ti (createSessionAtCommit conn commitId)

84+

85+handleCreateSessionAtHead :: Maybe Timeout -> Connection -> HeadName -> IO (Either RelationalError SessionId)

86+handleCreateSessionAtHead ti conn headn =

87+ timeoutRelErr ti (createSessionAtHead conn headn)

88+

89+handleCloseSession :: SessionId -> Connection -> IO ()

90+handleCloseSession =

91+ closeSession

92+

112−handleRetrieveAtomTypesAsRelation :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)

93+handleRetrieveAtomTypesAsRelation :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)

113−handleRetrieveAtomTypesAsRelation ti sessionId conn = do

94+handleRetrieveAtomTypesAsRelation ti sessionId conn =

114− ret <- timeoutOrDie ti (atomTypesAsRelation sessionId conn)

95+ timeoutRelErr ti (atomTypesAsRelation sessionId conn)

115− reply ret conn

116

117-- | Returns a relation which lists the names of relvars in the current session as well as its types.

97-- | Returns a relation which lists the names of relvars in the current session as well as its types.

118−handleRetrieveRelationVariableSummary :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)

98+handleRetrieveRelationVariableSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)

119−handleRetrieveRelationVariableSummary ti sessionId conn = do

99+handleRetrieveRelationVariableSummary ti sessionId conn =

120− ret <- timeoutOrDie ti (relationVariablesAsRelation sessionId conn)

100+ timeoutRelErr ti (relationVariablesAsRelation sessionId conn)

121− reply ret conn

101+

122−

102+handleRetrieveAtomFunctionSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)

103+handleRetrieveAtomFunctionSummary ti sessionId conn =

104+ timeoutRelErr ti (atomFunctionsAsRelation sessionId conn)

105+

106+handleRetrieveDatabaseContextFunctionSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)

107+handleRetrieveDatabaseContextFunctionSummary ti sessionId conn =

108+ timeoutRelErr ti (databaseContextFunctionsAsRelation sessionId conn)

109+

123−handleRetrieveCurrentSchemaName :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError SchemaName)

110+handleRetrieveCurrentSchemaName :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError SchemaName)

124−handleRetrieveCurrentSchemaName ti sessionId conn = do

111+handleRetrieveCurrentSchemaName ti sessionId conn =

125− ret <- timeoutOrDie ti (currentSchemaName sessionId conn)

112+ timeoutRelErr ti (currentSchemaName sessionId conn)

126− reply ret conn

127

113

128−handleExecuteSchemaExpr :: Timeout -> SessionId -> Connection -> SchemaExpr -> Reply (Either RelationalError ())

114+handleExecuteSchemaExpr :: Maybe Timeout -> SessionId -> Connection -> SchemaExpr -> IO (Either RelationalError ())

129−handleExecuteSchemaExpr ti sessionId conn schemaExpr = do

115+handleExecuteSchemaExpr ti sessionId conn schemaExpr =

130− ret <- timeoutOrDie ti (executeSchemaExpr sessionId conn schemaExpr)

116+ timeoutRelErr ti (executeSchemaExpr sessionId conn schemaExpr)

131− reply ret conn

132

117

133−handleLogout :: Timeout -> Connection -> Reply Bool

118+handleLogout :: Maybe Timeout -> Connection -> IO Bool

134−handleLogout _ =

119+handleLogout _ _ =

135 --liftIO $ closeRemote_ conn

120 --liftIO $ closeRemote_ conn

136− reply (pure True)

121+ pure True

137

122

138−handleTestTimeout :: Timeout -> SessionId -> Connection -> Reply Bool

123+handleTestTimeout :: Maybe Timeout -> SessionId -> Connection -> IO Bool

139−handleTestTimeout ti _ conn = do

124+handleTestTimeout ti _ _ = do

140− ret <- timeoutOrDie ti (threadDelay 100000 >> pure True)

125+ ret <- timeoutRelErr ti (threadDelay 100000 >> pure (Right ()))

141− reply ret conn

126+ case ret of

127+ Right () -> pure True

128+ Left _ -> pure False

142

129

130+

131+

143−handleRetrieveSessionIsDirty :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Bool)

132+handleRetrieveSessionIsDirty :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Bool)

144−handleRetrieveSessionIsDirty ti sessionId conn = do

133+handleRetrieveSessionIsDirty ti sessionId conn =

145− ret <- timeoutOrDie ti (disconnectedTransactionIsDirty sessionId conn)

134+ timeoutRelErr ti (disconnectedTransactionIsDirty sessionId conn)

146− reply ret conn

135+

147−

148−handleExecuteAutoMergeToHead :: Timeout -> SessionId -> Connection -> MergeStrategy -> HeadName -> Reply (Either RelationalError ())

136+handleExecuteAutoMergeToHead :: Maybe Timeout -> SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())

149−handleExecuteAutoMergeToHead ti sessionId conn strat headName' = do

137+handleExecuteAutoMergeToHead ti sessionId conn strat headName' =

150− ret <- timeoutOrDie ti (autoMergeToHead sessionId conn strat headName')

138+ timeoutRelErr ti (autoMergeToHead sessionId conn strat headName')

151− reply ret conn

152

139

153−handleRetrieveTypeConstructorMapping :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError TypeConstructorMapping)

140+handleRetrieveTypeConstructorMapping :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError TypeConstructorMapping)

154−handleRetrieveTypeConstructorMapping ti sessionId conn = do

141+handleRetrieveTypeConstructorMapping ti sessionId conn =

155− ret <- timeoutOrDie ti (C.typeConstructorMapping sessionId conn)

142+ timeoutRelErr ti (C.typeConstructorMapping sessionId conn)

156− reply ret conn

143+

157−

144+handleValidateMerkleHashes :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError ())

145+handleValidateMerkleHashes ti sessionId conn =

146+ timeoutRelErr ti (C.validateMerkleHashes sessionId conn)

src/lib/ProjectM36/Server/ParseArgs.hs+60−25

@@ -3,65 +3,100 @@ import ProjectM36.Base

3import ProjectM36.Client

4import Options.Applicative

5import ProjectM36.Server.Config

6+#if __GLASGOW_HASKELL__ < 804

6import Data.Monoid

7import Data.Monoid

8+#endif

8parseArgsWithDefaults :: ServerConfig -> Parser ServerConfig

10parseArgsWithDefaults :: ServerConfig -> Parser ServerConfig

9−parseArgsWithDefaults defaults = ServerConfig <$>

11+parseArgsWithDefaults defaults = ServerConfig <$>

10− parsePersistenceStrategy <*>

12+ parsePersistenceStrategy <*>

11− parseCheckFS <*>

13+ parseCheckFS <*>

12− parseDatabaseName <*>

14+ parseDatabaseName <*>

13− parseHostname (bindHost defaults) <*>

15+ parseHostname (bindHost defaults) <*>

14− parsePort (bindPort defaults) <*>

16+ parsePort (bindPort defaults) <*>

15− many parseGhcPkgPath <*>

17+ many parseGhcPkgPath <*>

16− parseTimeout (perRequestTimeout defaults) <*>

18+ parseTimeout (perRequestTimeout defaults) <*>

17− pure False

19+ parseTestMode

18−

20+

19parsePersistenceStrategy :: Parser PersistenceStrategy

21parsePersistenceStrategy :: Parser PersistenceStrategy

20parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>

22parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>

21 MinimalPersistence <$> dbdirOpt <|>

23 MinimalPersistence <$> dbdirOpt <|>

22 pure NoPersistence

24 pure NoPersistence

23− where

25+ where

24− dbdirOpt = strOption (short 'd' <>

26+ dbdirOpt = strOption (short 'd' <>

25− long "database-directory" <>

27+ long "database-directory" <>

26 metavar "DIRECTORY" <>

28 metavar "DIRECTORY" <>

27 showDefaultWith show

29 showDefaultWith show

28 )

30 )

29 fsyncOpt = switch (short 'f' <>

31 fsyncOpt = switch (short 'f' <>

30 long "fsync" <>

32 long "fsync" <>

31 help "Fsync all new transactions.")

33 help "Fsync all new transactions.")

32−

34+

35+parseTestMode :: Parser Bool

36+parseTestMode = flag True False (long "test-mode" <> hidden)

37+

33−parseCheckFS :: Parser Bool

38+parseCheckFS :: Parser Bool

34parseCheckFS = flag True False (long "disable-fscheck" <>

39parseCheckFS = flag True False (long "disable-fscheck" <>

35 help "Disable filesystem check for journaling.")

40 help "Disable filesystem check for journaling.")

36−

41+

37parseDatabaseName :: Parser DatabaseName

42parseDatabaseName :: Parser DatabaseName

38parseDatabaseName = strOption (short 'n' <>

43parseDatabaseName = strOption (short 'n' <>

39 long "database" <>

44 long "database" <>

40 metavar "DATABASE_NAME")

45 metavar "DATABASE_NAME")

41−

46+

42−parseHostname :: Hostname -> Parser Hostname

47+parseHostname :: Hostname -> Parser Hostname

43parseHostname defHostname = strOption (short 'h' <>

48parseHostname defHostname = strOption (short 'h' <>

44 long "hostname" <>

49 long "hostname" <>

45 metavar "HOST_NAME" <>

50 metavar "HOST_NAME" <>

46 value defHostname)

51 value defHostname)

47−

52+

48−parsePort :: Port -> Parser Port

53+parsePort :: Port -> Parser Port

49parsePort defPort = option auto (short 'p' <>

54parsePort defPort = option auto (short 'p' <>

50 long "port" <>

55 long "port" <>

51 metavar "PORT_NUMBER" <>

56 metavar "PORT_NUMBER" <>

52 value defPort)

57 value defPort)

53−

58+

54parseGhcPkgPath :: Parser String

59parseGhcPkgPath :: Parser String

55parseGhcPkgPath = strOption (long "ghc-pkg-dir" <>

60parseGhcPkgPath = strOption (long "ghc-pkg-dir" <>

56 metavar "GHC_PACKAGE_DIRECTORY")

61 metavar "GHC_PACKAGE_DIRECTORY")

57−

62+

58−parseTimeout :: Int -> Parser Int

63+parseTimeout :: Int -> Parser Int

59parseTimeout defTimeout = option auto (long "timeout" <>

64parseTimeout defTimeout = option auto (long "timeout" <>

60 metavar "MICROSECONDS" <>

65 metavar "MICROSECONDS" <>

61 value defTimeout)

66 value defTimeout)

63parseConfig :: IO ServerConfig

68parseConfig :: IO ServerConfig

64parseConfig = parseConfigWithDefaults defaultServerConfig

69parseConfig = parseConfigWithDefaults defaultServerConfig

65−

70+

66parseConfigWithDefaults :: ServerConfig -> IO ServerConfig

71parseConfigWithDefaults :: ServerConfig -> IO ServerConfig

67−parseConfigWithDefaults defaults = execParser (info (parseArgsWithDefaults defaults) idm)

72+parseConfigWithDefaults defaults = execParser (info (parseArgsWithDefaults defaults <**> helpOption) idm)

73+

74+parseWSConfigWithDefaults :: ServerConfig -> IO WebsocketServerConfig

75+parseWSConfigWithDefaults defaults = execParser (info (parseWSArgsWithDefaults defaults <**> helpOption) idm)

76+

77+parseWSArgsWithDefaults :: ServerConfig -> Parser WebsocketServerConfig

78+parseWSArgsWithDefaults defaults = WebsocketServerConfig <$>

79+ parseArgsWithDefaults defaults <*>

80+ parseTlsCertificatePath <*>

81+ parseTlsKeyPath

82+

83+

84+parseTlsCertificatePath :: Parser (Maybe String)

85+parseTlsCertificatePath = optional $ strOption (long "tls-certificate-path" <>

86+ metavar "TLS_CERTIFICATE_PATH")

87+

88+parseTlsKeyPath :: Parser (Maybe String)

89+parseTlsKeyPath = optional $ strOption (long "tls-key-path" <>

90+ metavar "TLS_KEY_PATH")

91+

92+helpOption :: Parser (a -> a)

93+helpOption = abortOption helpText $ mconcat

94+ [ long "help"

95+ , help "Show this help text"

96+ , hidden ]

97+ where

98+#if MIN_VERSION_optparse_applicative(0,16,0)

99+ helpText = ShowHelpText Nothing

100+#else

101+ helpText = ShowHelpText

102+#endif

src/lib/ProjectM36/Server/RemoteCallTypes.hs+71−32

@@ -1,64 +1,103 @@

1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}

1+{-# LANGUAGE DeriveGeneric, DerivingVia, CPP #-}

2module ProjectM36.Server.RemoteCallTypes where

3import ProjectM36.Base

4import ProjectM36.IsomorphicSchema

5import ProjectM36.TransactionGraph

6+import ProjectM36.DataFrame

6import ProjectM36.TransGraphRelationalExpression

7import ProjectM36.TransGraphRelationalExpression

7import ProjectM36.Session

8import ProjectM36.Session

9+import ProjectM36.Serialise.DataFrame ()

10+import ProjectM36.Serialise.IsomorphicSchema ()

8import GHC.Generics

11import GHC.Generics

9−import Data.Binary

12+import Codec.Winery

10−import Control.Distributed.Process (ProcessId)

13+

14+#define RPCData(typeName) deriving Generic \

15+ deriving Serialise via WineryVariant typeName

12{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}

17{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}

13-- | The initial login message. The argument should be the process id of the initiating client. This ProcessId will receive notification callbacks.

18-- | The initial login message. The argument should be the process id of the initiating client. This ProcessId will receive notification callbacks.

14−data Login = Login ProcessId

19+data Login = Login DatabaseName

15− deriving (Binary, Generic)

20+ RPCData(Login)

17data Logout = Logout

22data Logout = Logout

18− deriving (Binary, Generic)

23+ RPCData(Logout)

24+

19−data ExecuteRelationalExpr = ExecuteRelationalExpr SessionId RelationalExpr

25+data ExecuteRelationalExpr = ExecuteRelationalExpr SessionId RelationalExpr

20− deriving (Binary, Generic)

26+ RPCData(ExecuteRelationalExpr)

27+

28+data ExecuteDataFrameExpr = ExecuteDataFrameExpr SessionId DataFrameExpr

29+ RPCData(ExecuteDataFrameExpr)

30+

21data ExecuteDatabaseContextExpr = ExecuteDatabaseContextExpr SessionId DatabaseContextExpr

31data ExecuteDatabaseContextExpr = ExecuteDatabaseContextExpr SessionId DatabaseContextExpr

22− deriving (Binary, Generic)

32+ RPCData(ExecuteDatabaseContextExpr)

33+

23data ExecuteDatabaseContextIOExpr = ExecuteDatabaseContextIOExpr SessionId DatabaseContextIOExpr

34data ExecuteDatabaseContextIOExpr = ExecuteDatabaseContextIOExpr SessionId DatabaseContextIOExpr

24− deriving (Binary, Generic)

35+ RPCData(ExecuteDatabaseContextIOExpr)

36+

25data ExecuteGraphExpr = ExecuteGraphExpr SessionId TransactionGraphOperator

37data ExecuteGraphExpr = ExecuteGraphExpr SessionId TransactionGraphOperator

26− deriving (Binary, Generic)

38+ RPCData(ExecuteGraphExpr)

39+

27data ExecuteTransGraphRelationalExpr = ExecuteTransGraphRelationalExpr SessionId TransGraphRelationalExpr

40data ExecuteTransGraphRelationalExpr = ExecuteTransGraphRelationalExpr SessionId TransGraphRelationalExpr

28− deriving (Binary, Generic)

41+ RPCData(ExecuteTransGraphRelationalExpr)

42+

29data ExecuteHeadName = ExecuteHeadName SessionId

43data ExecuteHeadName = ExecuteHeadName SessionId

30− deriving (Binary, Generic)

44+ RPCData(ExecuteHeadName)

45+

31data ExecuteTypeForRelationalExpr = ExecuteTypeForRelationalExpr SessionId RelationalExpr

46data ExecuteTypeForRelationalExpr = ExecuteTypeForRelationalExpr SessionId RelationalExpr

32− deriving (Binary, Generic)

47+ RPCData(ExecuteTypeForRelationalExpr)

48+

33−data ExecuteSchemaExpr = ExecuteSchemaExpr SessionId SchemaExpr

49+data ExecuteSchemaExpr = ExecuteSchemaExpr SessionId SchemaExpr RPCData(ExecuteSchemaExpr)

34− deriving (Binary, Generic)

50+

35data ExecuteSetCurrentSchema = ExecuteSetCurrentSchema SessionId SchemaName

51data ExecuteSetCurrentSchema = ExecuteSetCurrentSchema SessionId SchemaName

36− deriving (Binary, Generic)

52+ RPCData(ExecuteSetCurrentSchema)

53+

37data RetrieveInclusionDependencies = RetrieveInclusionDependencies SessionId

54data RetrieveInclusionDependencies = RetrieveInclusionDependencies SessionId

38− deriving (Binary, Generic)

55+ RPCData(RetrieveInclusionDependencies)

56+

39data RetrievePlanForDatabaseContextExpr = RetrievePlanForDatabaseContextExpr SessionId DatabaseContextExpr

57data RetrievePlanForDatabaseContextExpr = RetrievePlanForDatabaseContextExpr SessionId DatabaseContextExpr

40− deriving (Binary, Generic)

58+ RPCData(RetrievePlanForDatabaseContextExpr)

59+

41data RetrieveTransactionGraph = RetrieveTransactionGraph SessionId

60data RetrieveTransactionGraph = RetrieveTransactionGraph SessionId

42− deriving (Binary, Generic)

61+ RPCData(RetrieveTransactionGraph)

62+

43data RetrieveHeadTransactionId = RetrieveHeadTransactionId SessionId

63data RetrieveHeadTransactionId = RetrieveHeadTransactionId SessionId

44− deriving (Binary, Generic)

64+ RPCData(RetrieveHeadTransactionId)

65+

45data CreateSessionAtCommit = CreateSessionAtCommit TransactionId

66data CreateSessionAtCommit = CreateSessionAtCommit TransactionId

46− deriving (Binary, Generic)

67+ RPCData(CreateSessionAtCommit)

68+

47data CreateSessionAtHead = CreateSessionAtHead HeadName

69data CreateSessionAtHead = CreateSessionAtHead HeadName

48− deriving (Binary, Generic)

70+ RPCData(CreateSessionAtHead)

71+

49data CloseSession = CloseSession SessionId

72data CloseSession = CloseSession SessionId

50− deriving (Binary, Generic)

73+ RPCData(CloseSession)

74+

51data RetrieveAtomTypesAsRelation = RetrieveAtomTypesAsRelation SessionId

75data RetrieveAtomTypesAsRelation = RetrieveAtomTypesAsRelation SessionId

52− deriving (Binary, Generic)

76+ RPCData(RetrieveAtomTypesAsRelation)

77+

53data RetrieveRelationVariableSummary = RetrieveRelationVariableSummary SessionId

78data RetrieveRelationVariableSummary = RetrieveRelationVariableSummary SessionId

54− deriving (Binary, Generic)

79+ RPCData(RetrieveRelationVariableSummary)

80+

81+data RetrieveAtomFunctionSummary = RetrieveAtomFunctionSummary SessionId

82+ RPCData(RetrieveAtomFunctionSummary)

83+

84+data RetrieveDatabaseContextFunctionSummary = RetrieveDatabaseContextFunctionSummary SessionId

85+ RPCData(RetrieveDatabaseContextFunctionSummary)

86+

55data RetrieveCurrentSchemaName = RetrieveCurrentSchemaName SessionId

87data RetrieveCurrentSchemaName = RetrieveCurrentSchemaName SessionId

56− deriving (Binary, Generic)

88+ RPCData(RetrieveCurrentSchemaName)

89+

57data TestTimeout = TestTimeout SessionId

90data TestTimeout = TestTimeout SessionId

58− deriving (Binary, Generic)

91+ RPCData(TestTimeout)

92+

59−data RetrieveSessionIsDirty = RetrieveSessionIsDirty SessionId

93+data RetrieveSessionIsDirty = RetrieveSessionIsDirty SessionId

60− deriving (Binary, Generic)

94+ RPCData(RetrieveSessionIsDirty)

95+

61data ExecuteAutoMergeToHead = ExecuteAutoMergeToHead SessionId MergeStrategy HeadName

96data ExecuteAutoMergeToHead = ExecuteAutoMergeToHead SessionId MergeStrategy HeadName

62− deriving (Binary, Generic)

97+ RPCData(ExecuteAutoMergeToHead)

98+

63data RetrieveTypeConstructorMapping = RetrieveTypeConstructorMapping SessionId

99data RetrieveTypeConstructorMapping = RetrieveTypeConstructorMapping SessionId

64− deriving (Binary, Generic)

100+ RPCData(RetrieveTypeConstructorMapping)

101+

102+data ExecuteValidateMerkleHashes = ExecuteValidateMerkleHashes SessionId

103+ RPCData(ExecuteValidateMerkleHashes)

src/lib/ProjectM36/Session.hs+3−2

@@ -3,6 +3,7 @@ import ProjectM36.Base

3import Data.UUID

4import qualified Data.Map as M

5import ProjectM36.Error

6+import qualified ProjectM36.DisconnectedTransaction as Discon

7type SessionId = UUID

8type SessionId = UUID

@@ -18,7 +19,7 @@ disconnectedTransaction :: Session -> DisconnectedTransaction

18disconnectedTransaction (Session discon _) = discon

19disconnectedTransaction (Session discon _) = discon

20isDirty :: Session -> DirtyFlag

21isDirty :: Session -> DirtyFlag

21−isDirty (Session (DisconnectedTransaction _ _ dirtyFlag) _) = dirtyFlag

22+isDirty (Session discon _) = Discon.isDirty discon

23concreteDatabaseContext :: Session -> DatabaseContext

24concreteDatabaseContext :: Session -> DatabaseContext

24concreteDatabaseContext (Session (DisconnectedTransaction _ (Schemas context _) _) _) = context

25concreteDatabaseContext (Session (DisconnectedTransaction _ (Schemas context _) _) _) = context

@@ -40,4 +41,4 @@ setSchemaName sname session = if sname == defaultSchemaName || M.member sname (s

40 pure (Session (disconnectedTransaction session) sname)

41 pure (Session (disconnectedTransaction session) sname)

41 else

42 else

42 Left (SubschemaNameNotInUseError sname)

43 Left (SubschemaNameNotInUseError sname)

43−

44+

src/lib/ProjectM36/Sessions.hs+29−7

@@ -1,18 +1,42 @@

1+{-# LANGUAGE PackageImports #-}

1module ProjectM36.Sessions where

2module ProjectM36.Sessions where

2import Control.Concurrent.STM

3import Control.Concurrent.STM

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

3−import qualified STMContainers.Map as STMMap

8+import qualified STMContainers.Map as StmMap

4−import ListT

9+import qualified STMContainers.Set as StmSet

10+#endif

5import ProjectM36.Attribute

11import ProjectM36.Attribute

6import ProjectM36.Base

12import ProjectM36.Base

7import ProjectM36.Session

13import ProjectM36.Session

8import ProjectM36.Relation

14import ProjectM36.Relation

9import ProjectM36.Error

15import ProjectM36.Error

10import qualified Data.UUID as U

16import qualified Data.UUID as U

17+#if MIN_VERSION_stm_containers(1,0,0)

18+import qualified Control.Foldl as Foldl

19+import qualified DeferredFolds.UnfoldlM as UF

20+#else

21+import "list-t" ListT

22+#endif

12−type Sessions = STMMap.Map SessionId Session

24+type Sessions = StmMap.Map SessionId Session

26+--from https://github.com/nikita-volkov/stm-containers/blob/master/test/Main/MapTests.hs

14−stmMapToList :: STMMap.Map k v -> STM [(k, v)]

27+stmMapToList :: StmMap.Map k v -> STM [(k, v)]

28+#if MIN_VERSION_stm_containers(1,0,0)

29+stmMapToList = UF.foldM (Foldl.generalize Foldl.list) . StmMap.unfoldlM

30+#else

31+stmMapToList = ListT.fold (\l -> return . (:l)) [] . StmMap.stream

32+#endif

33+

34+stmSetToList :: StmSet.Set v -> STM [v]

35+#if MIN_VERSION_stm_containers(1,0,0)

36+stmSetToList = UF.foldM (Foldl.generalize Foldl.list) . StmSet.unfoldlM

37+#else

15−stmMapToList = ListT.fold (\l -> return . (:l)) [] . STMMap.stream

38+stmSetToList = ListT.fold (\l -> return . (:l)) [] . StmSet.stream

39+#endif

17uuidAtom :: U.UUID -> Atom

41uuidAtom :: U.UUID -> Atom

18uuidAtom = TextAtom . U.toText

42uuidAtom = TextAtom . U.toText

@@ -23,5 +47,3 @@ sessionsAsRelation sessions = do

23 let atomMatrix = map (\(sessionId, session) -> [uuidAtom sessionId, uuidAtom (parentId session)]) sessionAssocs

47 let atomMatrix = map (\(sessionId, session) -> [uuidAtom sessionId, uuidAtom (parentId session)]) sessionAssocs

24 pure $ mkRelationFromList (attributesFromList [Attribute "sessionid" TextAtomType,

48 pure $ mkRelationFromList (attributesFromList [Attribute "sessionid" TextAtomType,

25 Attribute "parentCommit" TextAtomType]) atomMatrix

49 Attribute "parentCommit" TextAtomType]) atomMatrix

26−

27−

src/lib/ProjectM36/Shortcuts.hsnew file+247

@@ -0,0 +1,247 @@

1+{-# OPTIONS_GHC -fno-warn-orphans #-}

2+{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE TypeApplications #-}

4+{-# LANGUAGE FlexibleInstances #-}

5+{-# LANGUAGE MultiParamTypeClasses #-}

6+{-# LANGUAGE TypeFamilies #-}

7+{-# LANGUAGE ExtendedDefaultRules #-}

8+{-# LANGUAGE ExistentialQuantification #-}

9+{-# LANGUAGE FlexibleContexts #-}

10+{-# LANGUAGE GADTs #-}

11+{-# LANGUAGE UndecidableInstances #-}

12+module ProjectM36.Shortcuts where

13+-- users need OverloadedLabels, OverloadedLists, and default(Int,Text) to use these shortcuts.

14+import Data.Text hiding (foldl, map)

15+import ProjectM36.Base

16+import ProjectM36.Relation

17+import ProjectM36.Atomable

18+import Prelude hiding ((!!))

19+import Data.Proxy

20+import GHC.OverloadedLabels

21+import GHC.TypeLits hiding (Text)

22+import qualified Data.Text as T

23+import qualified Data.Map as M

24+import qualified Data.Set as S

25+import GHC.Exts (IsList(..))

26+import Data.Convertible

27+

28+default (Text)

29+

30+instance IsList (AttributeNamesBase ()) where

31+ type Item (AttributeNamesBase ()) = AttributeName

32+ fromList = AttributeNames . S.fromList

33+ toList (AttributeNames ns) = S.toList ns

34+ toList _ = error "needs AttributeNames"

35+

36+instance IsList (TupleExprsBase ()) where

37+ type Item TupleExprs = TupleExpr

38+ fromList ts = TupleExprs () ts

39+ toList (TupleExprs _ ts) = ts

40+

41+instance IsList TupleExpr where

42+ type Item TupleExpr = (AttributeName, AtomExpr)

43+ fromList attributeValues = TupleExpr (M.fromList attributeValues)

44+ toList (TupleExpr attributeValues) = M.toList attributeValues

45+

46+

47+-- #xxx :: Text

48+instance KnownSymbol x => IsLabel x Text where

49+ fromLabel = T.pack $ symbolVal @x Proxy

50+

51+-- #relvarName :: RelationalExpr

52+instance KnownSymbol x => IsLabel x RelationalExpr where

53+ fromLabel = RelationVariable (T.pack $ symbolVal @x Proxy) ()

54+

55+-- *Main> #a Int :: AttributeExpr

56+-- NakedAttributeExpr (Attribute "a" IntAtomType)

57+-- *Main> #a (Attr @[Int]) :: AttributeExpr

58+-- NakedAttributeExpr (Attribute "a" (ConstructedAtomType "List" (fromList [("a",IntAtomType)])))

59+-- can't offer a Relation atomtype -- don't know how to express a Relation type in haskell type. Maybe something a HList of (Text, a) ?

60+--

61+-- ps. I don't understand the usage of "AttributeAndTypeNameExpr AttributeName TypeConstructor a"

62+instance (KnownSymbol x, Atomable a)=> IsLabel x (HaskAtomType a -> AttributeExpr) where

63+ fromLabel = (NakedAttributeExpr . Attribute name) . toAtomType''

64+ where name = T.pack $ symbolVal @x Proxy

65+

66+-- (#a 1) :: ExtendTupleExpr

67+-- no need for :=

68+instance (Convertible a AtomExpr, KnownSymbol x) => IsLabel x (a -> ExtendTupleExpr) where

69+ fromLabel x = AttributeExtendTupleExpr name (convert x)

70+ where name = T.pack $ symbolVal @x Proxy

71+

72+-- #name AtomExpr

73+-- ex. tuple [ #name 3 ]

74+-- default(Text) is needed in client code to avoid `no Atomable Char`

75+instance (Convertible a AtomExpr, KnownSymbol x) => IsLabel x (a -> (AttributeName, AtomExpr)) where

76+ fromLabel = \x -> (name, convert x)

77+ where name = T.pack $ symbolVal @x Proxy

78+

79+-- *Main> #a [1] :: AtomExpr

80+-- FunctionAtomExpr "a" [NakedAtomExpr (IntegerAtom 1)] ()

81+--

82+-- This usage is not working in RestrictionPredicateExpr and AttributeExtendTupleExpr. Use f "a" [1] instead.

83+instance (KnownSymbol x, Convertible a AtomExpr) => IsLabel x ([a] -> AtomExpr) where

84+ fromLabel = \as' -> FunctionAtomExpr name (map convert as') ()

85+ where name = T.pack $ symbolVal @x Proxy

86+

87+instance (KnownSymbol x) => IsLabel x AtomExpr where

88+ fromLabel = AttributeAtomExpr name

89+ where name = T.pack $ symbolVal @x Proxy

90+

91+

92+data HaskAtomType a where

93+ Int :: HaskAtomType Int

94+ Integer :: HaskAtomType Integer

95+ Double :: HaskAtomType Double

96+ Text :: HaskAtomType Text

97+-- Day :: HaskAtomType Day

98+-- DateTime :: HaskAtomType DateTime

99+-- ByteString :: HaskAtomType ByteString

100+ Bool :: HaskAtomType Bool

101+ Attr :: Atomable a => HaskAtomType a -- a Proxy-like value for type application.

102+

103+toAtomType'' :: Atomable a => HaskAtomType a -> AtomType

104+toAtomType'' (_ :: HaskAtomType a) = toAtomType (Proxy @a)

105+

106+-- usage: relation [tuple [#a 1, #b "b"], tuple [#a 2, #b "b"]]

107+relation :: [TupleExpr] -> RelationalExpr

108+relation ts = MakeRelationFromExprs Nothing (TupleExprs () ts)

109+

110+relation' :: [AttributeExprBase ()] -> [TupleExpr] -> RelationalExpr

111+relation' as' ts = MakeRelationFromExprs (Just as') (TupleExprs () ts)

112+

113+-- usage: tuple [#name "Mike",#age 6]

114+tuple :: [(AttributeName, AtomExpr)] -> TupleExprBase ()

115+tuple as' = TupleExpr (M.fromList as')

116+

117+-- #a rename [#b `as` #c]

118+rename :: RelationalExpr -> [(AttributeName,AttributeName)] -> RelationalExpr

119+rename relExpr renameList = case renameList of

120+ [] -> Restrict TruePredicate relExpr

121+ renames ->

122+ foldl (\acc (old,new) -> Rename old new acc) relExpr renames

123+

124+--project !!

125+-- #a !! [#b,#c]

126+infix 9 !!

127+(!!) :: RelationalExpr -> AttributeNames -> RelationalExpr

128+relExpr !! xs = Project xs relExpr

129+

130+--join ><

131+-- #a >< #b

132+(><) :: RelationalExpr -> RelationalExpr -> RelationalExpr

133+a >< b = Join a b

134+

135+allBut :: AttributeNames -> AttributeNames

136+allBut (AttributeNames ns) = InvertedAttributeNames ns

137+allBut _ = error "give allBut something other than attribute names."

138+

139+allFrom :: RelationalExpr -> AttributeNames

140+allFrom = RelationalExprAttributeNames

141+

142+as :: AttributeNames -> AttributeName -> (AttributeNames, AttributeName)

143+as = (,)

144+

145+-- #a `group` ([#b,#c] `as` #d)

146+group :: RelationalExpr -> (AttributeNames, AttributeName) -> RelationalExpr

147+group relExpr (aNames, aName) = Group aNames aName relExpr

148+

149+-- #a `ungroup` #b

150+ungroup :: RelationalExpr -> AttributeName -> RelationalExpr

151+ungroup relExpr aName = Ungroup aName relExpr

152+

153+-- *Main> #a #:= true #: ( #b (f "count" [1,2]))

154+-- Assign "a" (Extend (AttributeExtendTupleExpr "b" (FunctionAtomExpr "count" [NakedAtomExpr (IntegerAtom 1),NakedAtomExpr (IntegerAtom 2)] ())) (ExistingRelation (Relation attributesFromList [] (RelationTupleSet {asList = [RelationTuple attributesFromList [] []]}))))

155+(#:) :: RelationalExpr -> ExtendTupleExpr -> RelationalExpr

156+a #: b = Extend b a

157+infix 8 #:

158+

159+instance Convertible AtomExpr AtomExpr where

160+ safeConvert n = Right n

161+

162+instance Convertible RelVarName AtomExpr where

163+ safeConvert n = Right $ RelationAtomExpr (RelationVariable n ())

164+

165+instance Convertible RelationalExpr AtomExpr where

166+ safeConvert relExpr = Right $ RelationAtomExpr relExpr

167+

168+instance Convertible RelVarName RelationalExpr where

169+ safeConvert n = Right $ RelationVariable n ()

170+

171+-- @ in tutd

172+-- (@@) "aaa"

173+(@@) :: AttributeName -> AtomExpr

174+(@@) = AttributeAtomExpr

175+

176+-- works in RestrictedPredicateExpr and AttributeExtendTupleExpr

177+-- usage: f "gte" [1]

178+f :: Convertible a AtomExpr => AtomFunctionName -> [a] -> AtomExpr

179+f n as' = FunctionAtomExpr n (map convert as') ()

180+

181+-- DatabaseContextExpr

182+-- define

183+(#::) :: RelVarName -> [AttributeExpr] -> DatabaseContextExpr

184+s #:: xs = Define s xs

185+infix 5 #::

186+

187+-- assign

188+(#:=) :: RelVarName -> RelationalExpr -> DatabaseContextExpr

189+s #:= r = Assign s r

190+infix 5 #:=

191+

192+class Boolean a b where

193+ (&&&) :: a -> b -> RestrictionPredicateExpr

194+ infixl 6 &&&

195+ (|||) :: a -> b -> RestrictionPredicateExpr

196+ infixl 5 |||

197+

198+-- where: @~ mimics the restriction symbol in algebra

199+-- usage: true #: (#a 1) @~ #a ?= 1 &&& not' false ||| (f "gte" [1])

200+(@~) :: Convertible a RestrictionPredicateExpr => RelationalExpr -> a -> RelationalExpr

201+(@~) relExpr resPreExpr = Restrict (convert resPreExpr) relExpr

202+infix 4 @~

203+

204+true :: RelationalExpr

205+true = ExistingRelation relationTrue

206+

207+false :: RelationalExpr

208+false = ExistingRelation relationFalse

209+

210+trueP :: RestrictionPredicateExprBase a

211+trueP = TruePredicate

212+

213+falseP :: RestrictionPredicateExprBase a

214+falseP = NotPredicate TruePredicate

215+

216+(?=) :: Convertible a AtomExpr => AttributeName -> a -> RestrictionPredicateExpr

217+(?=) name a = AttributeEqualityPredicate name (convert a)

218+infix 9 ?=

219+

220+not' :: Convertible a RestrictionPredicateExpr => a -> RestrictionPredicateExpr

221+not' = NotPredicate . convert

222+

223+instance (Convertible a RestrictionPredicateExpr, Convertible b RestrictionPredicateExpr) => Boolean a b where

224+ a &&& b = AndPredicate (convert a) (convert b)

225+ a ||| b = OrPredicate (convert a) (convert b)

226+

227+instance {-# Incoherent #-} Atomable a => Convertible a RestrictionPredicateExpr where

228+ safeConvert n = Right $ AtomExprPredicate $ toAtomExpr . toAtom $ n

229+

230+instance {-# Incoherent #-} Convertible RelationalExpr RestrictionPredicateExpr where

231+ safeConvert a = Right $ RelationalExprPredicate a

232+

233+instance {-# Incoherent #-} Convertible AtomExpr RestrictionPredicateExpr where

234+ safeConvert a = Right $ AtomExprPredicate a

235+

236+instance {-# Incoherent #-} Convertible RestrictionPredicateExpr RestrictionPredicateExpr where

237+ safeConvert a = Right a

238+

239+instance {-# Incoherent #-} Atomable a => Convertible a AtomExpr where

240+ safeConvert n = Right $ toAtomExpr . toAtom $ n

241+

242+toAtomExpr :: Atom -> AtomExpr

243+toAtomExpr (ConstructedAtom n _ xs) = ConstructedAtomExpr n (toAtomExpr <$> xs) ()

244+toAtomExpr a = NakedAtomExpr a

245+

246+

247+

src/lib/ProjectM36/StaticOptimizer.hs+528−138

@@ -1,188 +1,578 @@

1+{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE FlexibleContexts #-}

1module ProjectM36.StaticOptimizer where

3module ProjectM36.StaticOptimizer where

2import ProjectM36.Base

4import ProjectM36.Base

3−import ProjectM36.RelationalExpression

5+import ProjectM36.GraphRefRelationalExpr

4import ProjectM36.Relation

6import ProjectM36.Relation

7+import ProjectM36.RelationalExpression

8+import ProjectM36.TransGraphRelationalExpression as TGRE hiding (askGraph)

5import ProjectM36.Error

9import ProjectM36.Error

10+import ProjectM36.Transaction

11+import ProjectM36.NormalizeExpr

12+import qualified ProjectM36.Attribute as A

6import qualified ProjectM36.AttributeNames as AS

13import qualified ProjectM36.AttributeNames as AS

7import ProjectM36.TupleSet

14import ProjectM36.TupleSet

8−import Control.Monad.State hiding (join)

15+import Control.Monad.State

9−import Data.Either (rights, lefts)

16+import Control.Monad.Reader

10−import Control.Monad.Trans.Reader

17+import Control.Monad.Except

18+import Control.Monad.Trans.Except

19+import Data.Functor.Identity

11import qualified Data.Map as M

20import qualified Data.Map as M

21+import qualified Data.Set as S

13-- the static optimizer performs optimizations which need not take any specific-relation statistics into account

23-- the static optimizer performs optimizations which need not take any specific-relation statistics into account

14−-- apply optimizations which merely remove steps to become no-ops: example: projection of a relation across all of its attributes => original relation

16−--should optimizations offer the possibility to return errors? If they perform the up-front type-checking, maybe so

25+data GraphRefSOptRelationalExprEnv =

17−applyStaticRelationalOptimization :: RelationalExpr -> RelationalExprState (Either RelationalError RelationalExpr)

26+ GraphRefSOptRelationalExprEnv

18−applyStaticRelationalOptimization e@(MakeStaticRelation _ _) = return $ Right e

27+ {

28+ ore_graph :: TransactionGraph,

29+ ore_mcontext :: Maybe DatabaseContext

30+ }

31+

32+type GraphRefSOptRelationalExprM a = ReaderT GraphRefSOptRelationalExprEnv (ExceptT RelationalError Identity) a

33+

34+data GraphRefSOptDatabaseContextExprEnv =

35+ GraphRefSOptDatabaseContextExprEnv

36+ {

37+ odce_graph :: TransactionGraph,

38+ odce_context :: DatabaseContext, --not optional for DatabaseContextExpr evaluation

39+ odce_transId :: TransactionId -- parent if context is committed- needed because MultipleExpr optimization requires running the DatabaseContextExprs (with empty relvars)

40+ }

41+

42+type GraphRefSOptDatabaseContextExprM a = ReaderT GraphRefSOptDatabaseContextExprEnv (ExceptT RelationalError Identity) a

43+

44+-- | A temporary function to be replaced by IO-based implementation.

45+optimizeAndEvalRelationalExpr :: RelationalExprEnv -> RelationalExpr -> Either RelationalError Relation

46+optimizeAndEvalRelationalExpr env expr = do

47+ let gfExpr = runProcessExprM UncommittedContextMarker (processRelationalExpr expr) -- references parent tid instead of context! options- I could add the context to the graph with a new transid or implement an evalRelationalExpr in RE.hs to use the context (which is what I had previously)

48+ graph = re_graph env

49+ ctx = re_context env

50+ gfEnv = freshGraphRefRelationalExprEnv (Just ctx) graph

51+ optExpr <- runGraphRefSOptRelationalExprM (Just ctx) (re_graph env) (fullOptimizeGraphRefRelationalExpr gfExpr)

52+ runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr optExpr)

53+

54+class Monad m => AskGraphContext m where

55+ askGraph :: m TransactionGraph

56+ askContext :: m DatabaseContext

57+

58+instance AskGraphContext (ReaderT GraphRefSOptDatabaseContextExprEnv (ExceptT RelationalError Identity)) where

59+ askGraph = asks odce_graph

60+ askContext = asks odce_context

61+

62+instance AskGraphContext (ReaderT GraphRefSOptRelationalExprEnv (ExceptT RelationalError Identity)) where

63+ askGraph = asks ore_graph

64+ askContext = do

65+ mctx <- asks ore_mcontext

66+ case mctx of

67+ Nothing -> throwError NoUncommittedContextInEvalError

68+ Just ctx -> pure ctx

69+

70+askTransId :: GraphRefSOptDatabaseContextExprM TransactionId

71+askTransId = asks odce_transId

72+

73+askMaybeContext :: GraphRefSOptRelationalExprM (Maybe DatabaseContext)

74+askMaybeContext = asks ore_mcontext

75+

76+optimizeDatabaseContextExpr :: DatabaseContextExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr

77+optimizeDatabaseContextExpr expr = do

78+ let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextExpr expr)

79+ optimizeGraphRefDatabaseContextExpr gfExpr

80+

81+optimizeAndEvalDatabaseContextExpr :: Bool -> DatabaseContextExpr -> DatabaseContextEvalMonad ()

82+optimizeAndEvalDatabaseContextExpr optimize expr = do

83+ graph <- asks dce_graph

84+ transId <- asks dce_transId

85+ context <- getStateContext

86+ let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextExpr expr)

87+ eOptExpr = if optimize then

88+ runGraphRefSOptDatabaseContextExprM transId context graph (optimizeGraphRefDatabaseContextExpr gfExpr)

89+ else

90+ pure gfExpr

91+ case eOptExpr of

92+ Left err -> throwError err

93+ Right optExpr -> evalGraphRefDatabaseContextExpr optExpr

94+

95+

96+optimizeAndEvalTransGraphRelationalExpr :: TransactionGraph -> TransGraphRelationalExpr -> Either RelationalError Relation

97+optimizeAndEvalTransGraphRelationalExpr graph tgExpr = do

98+ gfExpr <- TGRE.process (TransGraphEvalEnv graph) tgExpr

99+ optExpr <- runGraphRefSOptRelationalExprM Nothing graph (fullOptimizeGraphRefRelationalExpr gfExpr)

100+ let gfEnv = freshGraphRefRelationalExprEnv Nothing graph

101+ runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr optExpr)

102+

103+optimizeAndEvalDatabaseContextIOExpr :: DatabaseContextIOExpr -> DatabaseContextIOEvalMonad (Either RelationalError ())

104+optimizeAndEvalDatabaseContextIOExpr expr = do

105+ transId <- asks dbcio_transId

106+ ctx <- getDBCIOContext

107+ graph <- asks dbcio_graph

108+ let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextIOExpr expr)

109+ eOptExpr = runGraphRefSOptDatabaseContextExprM transId ctx graph (optimizeDatabaseContextIOExpr gfExpr)

110+ case eOptExpr of

111+ Left err -> pure (Left err)

112+ Right optExpr ->

113+ evalGraphRefDatabaseContextIOExpr optExpr

114+

115+{-

116+runStaticOptimizerMonad :: RelationalExprEnv -> StaticOptimizerMonad a -> Either RelationalError a

117+runStaticOptimizerMonad env m = runIdentity (runExceptT (runReaderT m env))

118+-}

119+

120+runGraphRefSOptRelationalExprM ::

121+ Maybe DatabaseContext ->

122+ TransactionGraph ->

123+ GraphRefSOptRelationalExprM a ->

124+ Either RelationalError a

125+runGraphRefSOptRelationalExprM mctx graph m = runIdentity (runExceptT (runReaderT m env))

126+ where

127+ env = GraphRefSOptRelationalExprEnv {

128+ ore_graph = graph,

129+ ore_mcontext = mctx

130+ }

131+

132+

133+runGraphRefSOptDatabaseContextExprM ::

134+ TransactionId ->

135+ DatabaseContext ->

136+ TransactionGraph ->

137+ GraphRefSOptDatabaseContextExprM a ->

138+ Either RelationalError a

139+runGraphRefSOptDatabaseContextExprM tid ctx graph m =

140+ runIdentity (runExceptT (runReaderT m env))

141+ where

142+ env = GraphRefSOptDatabaseContextExprEnv {

143+ odce_graph = graph,

144+ odce_context = ctx,

145+ odce_transId = tid

146+ }

147+

148+optimizeGraphRefRelationalExpr' ::

149+ Maybe DatabaseContext ->

150+ TransactionGraph ->

151+ GraphRefRelationalExpr ->

152+ Either RelationalError GraphRefRelationalExpr

153+optimizeGraphRefRelationalExpr' mctx graph expr =

154+ runIdentity (runExceptT (runReaderT (optimizeGraphRefRelationalExpr expr) env))

155+ where

156+ env = GraphRefSOptRelationalExprEnv {

157+ ore_graph = graph,

158+ ore_mcontext = mctx

159+ }

160

20−applyStaticRelationalOptimization e@(MakeRelationFromExprs _ _) = return $ Right e

161+-- | optimize relational expression within database context expr monad

162+liftGraphRefRelExpr :: GraphRefSOptRelationalExprM a -> GraphRefSOptDatabaseContextExprM a

163+liftGraphRefRelExpr m = do

164+ context <- asks odce_context

165+ graph <- asks odce_graph

166+ lift $ except $ runGraphRefSOptRelationalExprM (Just context) graph m

167+

168+fullOptimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr

169+fullOptimizeGraphRefRelationalExpr expr = do

170+ optExpr <- optimizeGraphRefRelationalExpr expr

171+ let optExpr' = applyStaticRestrictionPushdown (applyStaticRestrictionCollapse optExpr)

172+ applyStaticJoinElimination optExpr'

173

22−applyStaticRelationalOptimization e@(ExistingRelation _) = return $ Right e

174+-- apply optimizations which merely remove steps to become no-ops: example: projection of a relation across all of its attributes => original relation

175

24−applyStaticRelationalOptimization e@(RelationVariable _ _) = return $ Right e

176+--should optimizations offer the possibility to pure errors? If they perform the up-front type-checking, maybe so

177+optimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr

178+optimizeGraphRefRelationalExpr e@(MakeStaticRelation _ _) = pure e

179

180+optimizeGraphRefRelationalExpr e@MakeRelationFromExprs{} = pure e

181+

182+optimizeGraphRefRelationalExpr e@(ExistingRelation _) = pure e

183+

184+optimizeGraphRefRelationalExpr e@(RelationVariable _ _) = pure e

185+

26--remove project of attributes which removes no attributes

186--remove project of attributes which removes no attributes

27−applyStaticRelationalOptimization (Project attrNameSet expr) = do

187+optimizeGraphRefRelationalExpr (Project attrNameSet expr) = do

28− relType <- typeForRelationalExpr expr

188+ graph <- askGraph

189+ mctx <- askMaybeContext

190+ let relType = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr expr)

191+ gfEnv = freshGraphRefRelationalExprEnv mctx graph

29 case relType of

192 case relType of

30− Left err -> return $ Left err

193+ Left err -> throwError err

31 Right relType2

194 Right relType2

32− | AS.all == attrNameSet ->

195+ | AS.all == attrNameSet ->

33− applyStaticRelationalOptimization expr

196+ optimizeGraphRefRelationalExpr expr

34 | AttributeNames (attributeNames relType2) == attrNameSet ->

197 | AttributeNames (attributeNames relType2) == attrNameSet ->

35− applyStaticRelationalOptimization expr

198+ optimizeGraphRefRelationalExpr expr

36 | otherwise -> do

199 | otherwise -> do

37− optimizedSubExpression <- applyStaticRelationalOptimization expr

200+ optSubExpr <- optimizeGraphRefRelationalExpr expr

38− case optimizedSubExpression of

39− Left err -> pure $ Left err

40− Right optSubExpr -> pure $ Right $ Project attrNameSet optSubExpr

201+ pure (Project attrNameSet optSubExpr)

202

42−applyStaticRelationalOptimization (Union exprA exprB) = do

203+optimizeGraphRefRelationalExpr (Union exprA exprB) = do

43− optExprA <- applyStaticRelationalOptimization exprA

204+ optExprA <- optimizeGraphRefRelationalExpr exprA

44− optExprB <- applyStaticRelationalOptimization exprB

205+ optExprB <- optimizeGraphRefRelationalExpr exprB

206+ -- (x where pred1) union (x where pred2) -> (x where pred1 or pred2)

45− case optExprA of

207+ case (optExprA, optExprB) of

46− Left err -> return $ Left err

208+ (Restrict predA (RelationVariable nameA sA),

47− Right optExprAx -> case optExprB of

209+ Restrict predB (RelationVariable nameB sB)) | nameA == nameB && sA == sB -> pure (Restrict (AndPredicate predA predB) (RelationVariable nameA sA))

48− Left err -> return $ Left err

210+ (exprA', exprB') | isEmptyRelationExpr exprA' -> pure exprB'

49− Right optExprBx -> if optExprAx == optExprBx then

211+ | isEmptyRelationExpr exprB' -> pure exprA'

50− return (Right optExprAx)

212+ _ -> if optExprA == optExprB then

213+ pure optExprA

51− else

214+ else

52− return $ Right $ Union optExprAx optExprBx

215+ pure $ Union optExprA optExprB

216

54−applyStaticRelationalOptimization (Join exprA exprB) = do

217+optimizeGraphRefRelationalExpr (Join exprA exprB) = do

55− optExprA <- applyStaticRelationalOptimization exprA

218+ optExprA <- optimizeGraphRefRelationalExpr exprA

56− optExprB <- applyStaticRelationalOptimization exprB

219+ optExprB <- optimizeGraphRefRelationalExpr exprB

57− case optExprA of

220+ -- if the relvars to join are the same but with predicates, then just AndPredicate the predicates

58− Left err -> return $ Left err

59− Right optExprA2 -> case optExprB of

221+ case (optExprA, optExprB) of

60− Left err -> return $ Left err

222+ (Restrict predA (RelationVariable nameA sA),

223+ Restrict predB (RelationVariable nameB sB)) | nameA == nameB && sA == sB -> pure (Restrict (AndPredicate predA predB) (RelationVariable nameA sA))

61− Right optExprB2 -> if optExprA == optExprB then --A join A == A

224+ _ -> if optExprA == optExprB then --A join A == A

62− return optExprA

225+ pure optExprA

63 else

226 else

64− return $ Right (Join optExprA2 optExprB2)

227+ pure (Join optExprA optExprB)

228

66−applyStaticRelationalOptimization (Difference exprA exprB) = do

229+optimizeGraphRefRelationalExpr (Difference exprA exprB) = do

67− optExprA <- applyStaticRelationalOptimization exprA

230+ graph <- askGraph

68− optExprB <- applyStaticRelationalOptimization exprB

231+ context <- askMaybeContext

69− case optExprA of

232+ optExprA <- optimizeGraphRefRelationalExpr exprA

70− Left err -> return $ Left err

233+ optExprB <- optimizeGraphRefRelationalExpr exprB

71− Right optExprA2 -> case optExprB of

72− Left err -> return $ Left err

73− Right optExprB2 -> if optExprA == optExprB then do --A difference A == A where false

234+ if optExprA == optExprB then do --A difference A == A where false

74− eEmptyRel <- typeForRelationalExpr optExprA2

235+ let eEmptyRel = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr optExprA)

236+ gfEnv = freshGraphRefRelationalExprEnv context graph

75− case eEmptyRel of

237+ case eEmptyRel of

76− Left err -> pure (Left err)

238+ Left err -> throwError err

77− Right emptyRel -> pure (Right (ExistingRelation emptyRel))

239+ Right emptyRel -> pure (ExistingRelation emptyRel)

78− else

240+ else

79− return $ Right (Difference optExprA2 optExprB2)

241+ pure (Difference optExprA optExprB)

242

81−applyStaticRelationalOptimization e@Rename{} = return $ Right e

243+optimizeGraphRefRelationalExpr e@Rename{} = pure e

244

83−applyStaticRelationalOptimization (Group oldAttrNames newAttrName expr) =

245+optimizeGraphRefRelationalExpr (Group oldAttrNames newAttrName expr) =

84− return $ Right $ Group oldAttrNames newAttrName expr

246+ pure $ Group oldAttrNames newAttrName expr

247

86−applyStaticRelationalOptimization (Ungroup attrName expr) =

248+optimizeGraphRefRelationalExpr (Ungroup attrName expr) =

87− return $ Right $ Ungroup attrName expr

249+ pure $ Ungroup attrName expr

250

89--remove restriction of nothing

251--remove restriction of nothing

90−applyStaticRelationalOptimization (Restrict predicate expr) = do

252+optimizeGraphRefRelationalExpr (Restrict predicate expr) = do

253+ graph <- askGraph

254+ mctx <- askMaybeContext

91 optimizedPredicate <- applyStaticPredicateOptimization predicate

255 optimizedPredicate <- applyStaticPredicateOptimization predicate

92 case optimizedPredicate of

256 case optimizedPredicate of

93− Left err -> return $ Left err

257+ optimizedPredicate' | isTrueExpr optimizedPredicate' -> optimizeGraphRefRelationalExpr expr -- remove predicate entirely

94− Right optimizedPredicate2

258+ optimizedPredicate' | isFalseExpr optimizedPredicate' -> do -- replace where false predicate with empty relation with attributes from relexpr

95− | optimizedPredicate2 == TruePredicate -> applyStaticRelationalOptimization expr

259+ let attributesRel = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr expr)

96− | optimizedPredicate2 == NotPredicate TruePredicate -> do

260+ gfEnv = freshGraphRefRelationalExprEnv mctx graph

97− attributesRel <- typeForRelationalExpr expr

98 case attributesRel of

261 case attributesRel of

99− Left err -> return $ Left err

262+ Left err -> throwError err

100− Right attributesRelA -> return $ Right $ MakeStaticRelation (attributes attributesRelA) emptyTupleSet

263+ Right attributesRelA -> pure $ MakeStaticRelation (attributes attributesRelA) emptyTupleSet

101 | otherwise -> do

264 | otherwise -> do

102− optimizedSubExpression <- applyStaticRelationalOptimization expr

265+ optSubExpr <- optimizeGraphRefRelationalExpr expr

103− case optimizedSubExpression of

266+ pure $ Restrict optimizedPredicate' optSubExpr

104− Left err -> return $ Left err

105− Right optSubExpr -> return $ Right $ Restrict optimizedPredicate2 optSubExpr

106

267

107−applyStaticRelationalOptimization e@(Equals _ _) = return $ Right e

268+optimizeGraphRefRelationalExpr e@(Equals _ _) = pure e

108

269

109−applyStaticRelationalOptimization e@(NotEquals _ _) = return $ Right e

270+optimizeGraphRefRelationalExpr e@(NotEquals _ _) = pure e

110

271

111−applyStaticRelationalOptimization e@(Extend _ _) = return $ Right e

272+optimizeGraphRefRelationalExpr e@(Extend _ _) = pure e

112

273

113−applyStaticDatabaseOptimization :: DatabaseContextExpr -> DatabaseState (Either RelationalError DatabaseContextExpr)

274+optimizeGraphRefRelationalExpr e@(With _ _) = pure e

114−applyStaticDatabaseOptimization x@NoOperation = pure $ Right x

115−applyStaticDatabaseOptimization x@(Define _ _) = pure $ Right x

116

275

117−applyStaticDatabaseOptimization x@(Undefine _) = pure $ Right x

276+-- database context expr

277+optimizeGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr

278+optimizeGraphRefDatabaseContextExpr x@NoOperation = pure x

279+optimizeGraphRefDatabaseContextExpr x@(Define _ _) = pure x

118

280

119−applyStaticDatabaseOptimization (Assign name expr) = do

281+optimizeGraphRefDatabaseContextExpr x@(Undefine _) = pure x

120− context <- getStateContext

282+

121− let optimizedExpr = runReader (applyStaticRelationalOptimization expr) (RelationalExprStateElems context)

283+optimizeGraphRefDatabaseContextExpr (Assign name expr) = do

122− case optimizedExpr of

284+ optExpr <- liftGraphRefRelExpr (fullOptimizeGraphRefRelationalExpr expr)

123− Left err -> return $ Left err

285+ pure $ Assign name optExpr

124− Right optimizedExpr2 -> return $ Right (Assign name optimizedExpr2)

125

286

126−applyStaticDatabaseOptimization (Insert name expr) = do

287+optimizeGraphRefDatabaseContextExpr (Insert targetName expr) = do

127− context <- getStateContext

288+ optimizedExpr <- liftGraphRefRelExpr (fullOptimizeGraphRefRelationalExpr expr)

128− let optimizedExpr = runReader (applyStaticRelationalOptimization expr) (RelationalExprStateElems context)

289+ if isEmptyRelationExpr optimizedExpr then -- if we are trying to insert an empty relation, do nothing

290+ pure NoOperation

291+ else

129− case optimizedExpr of

292+ case optimizedExpr of

130− Left err -> return $ Left err

293+ -- if the target relvar and the insert relvar are the same, there is nothing to do

131− Right optimizedExpr2 -> return $ Right (Insert name optimizedExpr2)

294+ -- insert s s -> NoOperation

295+ RelationVariable insName _ | insName == targetName -> pure NoOperation

296+ _ -> pure (Insert targetName optimizedExpr)

132

297

133−applyStaticDatabaseOptimization (Delete name predicate) = do

298+optimizeGraphRefDatabaseContextExpr (Delete name predicate) =

134− context <- getStateContext

135− let optimizedPredicate = runReader (applyStaticPredicateOptimization predicate) (RelationalExprStateElems context)

299+ Delete name <$> liftGraphRefRelExpr (applyStaticPredicateOptimization predicate)

136− case optimizedPredicate of

137− Left err -> return $ Left err

138− Right optimizedPredicate2 -> return $ Right (Delete name optimizedPredicate2)

139

300

140−applyStaticDatabaseOptimization (Update name upmap predicate) = do

301+optimizeGraphRefDatabaseContextExpr (Update name upmap predicate) =

141− context <- getStateContext

142− let optimizedPredicate = runReader (applyStaticPredicateOptimization predicate) (RelationalExprStateElems context)

302+ Update name upmap <$> liftGraphRefRelExpr (applyStaticPredicateOptimization predicate)

143− case optimizedPredicate of

144− Left err -> return $ Left err

145− Right optimizedPredicate2 -> return $ Right (Update name upmap optimizedPredicate2)

146

303

147−applyStaticDatabaseOptimization dep@(AddInclusionDependency _ _) = return $ Right dep

304+optimizeGraphRefDatabaseContextExpr dep@(AddInclusionDependency _ _) = pure dep

148

305

149−applyStaticDatabaseOptimization (RemoveInclusionDependency name) = return $ Right (RemoveInclusionDependency name)

306+optimizeGraphRefDatabaseContextExpr (RemoveInclusionDependency name) = pure (RemoveInclusionDependency name)

150

307

151−applyStaticDatabaseOptimization (AddNotification name triggerExpr resultOldExpr resultNewExpr) = do

308+optimizeGraphRefDatabaseContextExpr (AddNotification name triggerExpr resultOldExpr resultNewExpr) =

152− context <- getStateContext

309+ --we can't optimize these expressions until they run

153− let eTriggerExprOpt = runReader (applyStaticRelationalOptimization triggerExpr) (RelationalExprStateElems context)

154− case eTriggerExprOpt of

155− Left err -> pure $ Left err

156− Right triggerExprOpt -> --it doesn't make sense to optimize queries when we don't have their proper contexts

157− pure (Right (AddNotification name triggerExprOpt resultOldExpr resultNewExpr))

310+ pure (AddNotification name triggerExpr resultOldExpr resultNewExpr)

158

311

159−applyStaticDatabaseOptimization notif@(RemoveNotification _) = pure (Right notif)

312+optimizeGraphRefDatabaseContextExpr notif@(RemoveNotification _) = pure notif

160

313

161−applyStaticDatabaseOptimization c@(AddTypeConstructor _ _) = pure (Right c)

314+optimizeGraphRefDatabaseContextExpr c@(AddTypeConstructor _ _) = pure c

162−applyStaticDatabaseOptimization c@(RemoveTypeConstructor _) = pure (Right c)

315+optimizeGraphRefDatabaseContextExpr c@(RemoveTypeConstructor _) = pure c

163−applyStaticDatabaseOptimization c@(RemoveAtomFunction _) = pure (Right c)

316+optimizeGraphRefDatabaseContextExpr c@(RemoveAtomFunction _) = pure c

164−applyStaticDatabaseOptimization c@(RemoveDatabaseContextFunction _) = pure (Right c)

317+optimizeGraphRefDatabaseContextExpr c@(RemoveDatabaseContextFunction _) = pure c

165−applyStaticDatabaseOptimization c@(ExecuteDatabaseContextFunction _ _) = pure (Right c)

318+optimizeGraphRefDatabaseContextExpr c@(ExecuteDatabaseContextFunction _ _) = pure c

166

319

167--optimization: from pgsql lists- check for join condition referencing foreign key- if join projection project away the referenced table, then it does not need to be scanned

320--optimization: from pgsql lists- check for join condition referencing foreign key- if join projection project away the referenced table, then it does not need to be scanned

168

321

169−--applyStaticDatabaseOptimization (MultipleExpr exprs) = return $ Right $ MultipleExpr exprs

322+--applyStaticDatabaseOptimization (MultipleExpr exprs) = pure $ Right $ MultipleExpr exprs

170--for multiple expressions, we must evaluate

323--for multiple expressions, we must evaluate

171−applyStaticDatabaseOptimization (MultipleExpr exprs) = do

324+optimizeGraphRefDatabaseContextExpr (MultipleExpr exprs) = do

172− context <- getStateContext

173− let optExprs = evalState substateRunner (contextWithEmptyTupleSets context, M.empty, False)

174− let errors = lefts optExprs

175− if not (null errors) then

176− return $ Left (head errors)

177− else

178− return $ Right $ MultipleExpr (rights optExprs)

179− where

180− substateRunner = forM exprs $ \expr -> do

181− --a previous expression could create a relvar, we don't want to miss it, so we clear the tuples and execute the expression to get an empty relation in the relvar

325+ --a previous expression in the exprs list could create a relvar; we don't want to miss it, so we clear the tuples and execute the expression to get an empty relation in the relvar

182− _ <- evalDatabaseContextExpr expr

326+ context <- askContext

183− applyStaticDatabaseOptimization expr

327+ graph <- askGraph

184− --this error handling could be improved with some lifting presumably

328+ parentId <- askTransId

185− --restore original context

329+

186−

330+ let emptyRvs ctx = ctx { relationVariables = mkEmptyRelVars (relationVariables ctx) }

187−applyStaticPredicateOptimization :: RestrictionPredicateExpr -> RelationalExprState (Either RelationalError RestrictionPredicateExpr)

331+ dbcEnv = mkDatabaseContextEvalEnv parentId graph

188−applyStaticPredicateOptimization predicate = return $ Right predicate

332+ folder (ctx, expracc) expr = do

333+ --optimize the expr and run it against empty relvars to add it to the context

334+ case runGraphRefSOptDatabaseContextExprM parentId ctx graph (optimizeGraphRefDatabaseContextExpr expr) of

335+ Left err -> throwError err

336+ Right optExpr ->

337+ case runDatabaseContextEvalMonad ctx dbcEnv (evalGraphRefDatabaseContextExpr optExpr) of

338+ Left err -> throwError err

339+ Right dbcState ->

340+ pure (emptyRvs $ dbc_context dbcState, expracc ++ [optExpr])

341+

342+ (_, exprs') <- foldM folder (context,[]) exprs

343+ pure (MultipleExpr exprs')

344+

345+applyStaticPredicateOptimization :: GraphRefRestrictionPredicateExpr -> GraphRefSOptRelationalExprM GraphRefRestrictionPredicateExpr

346+applyStaticPredicateOptimization predi = do

347+ optPred <- case predi of

348+-- where x and x => where x

349+ AndPredicate pred1 pred2 -> do

350+ optPredA <- applyStaticPredicateOptimization pred1

351+ optPredB <- applyStaticPredicateOptimization pred2

352+ if optPredA == optPredB then

353+ pure optPredA

354+ else

355+ pure (AndPredicate optPredA optPredB)

356+-- where x or x => where x

357+ OrPredicate pred1 pred2 -> do

358+ optPredA <- applyStaticPredicateOptimization pred1

359+ optPredB <- applyStaticPredicateOptimization pred2

360+ if (optPredA == optPredB) || isTrueExpr optPredA then

361+ pure optPredA

362+ else if isTrueExpr optPredB then

363+ pure optPredB

364+ else

365+ pure (OrPredicate optPredA optPredB)

366+ AttributeEqualityPredicate attrNameA (AttributeAtomExpr attrNameB) ->

367+ if attrNameA == attrNameB then

368+ pure TruePredicate

369+ else

370+ pure predi

371+ AttributeEqualityPredicate{} -> pure predi

372+ TruePredicate -> pure predi

373+ NotPredicate{} -> pure predi

374+ RelationalExprPredicate{} -> pure predi

375+ AtomExprPredicate{} -> pure predi

376+ let attrMap = findStaticRestrictionPredicates optPred

377+ pure (replaceStaticAtomExprs optPred attrMap)

378+

379+--determines if an atom expression is tautologically true

380+isTrueExpr :: RestrictionPredicateExprBase a -> Bool

381+isTrueExpr TruePredicate = True

382+isTrueExpr (AtomExprPredicate (NakedAtomExpr (BoolAtom True))) = True

383+isTrueExpr _ = False

384+

385+--determines if an atom expression is tautologically false

386+isFalseExpr :: RestrictionPredicateExprBase a -> Bool

387+isFalseExpr (NotPredicate expr) = isTrueExpr expr

388+isFalseExpr (AtomExprPredicate (NakedAtomExpr (BoolAtom False))) = True

389+isFalseExpr _ = False

390+

391+-- determine if the created relation can statically be determined to be empty

392+isEmptyRelationExpr :: RelationalExprBase a -> Bool

393+isEmptyRelationExpr (MakeRelationFromExprs _ (TupleExprs _ [])) = True

394+isEmptyRelationExpr (MakeStaticRelation _ tupSet) = null (asList tupSet)

395+isEmptyRelationExpr (ExistingRelation rel) = rel == emptyRelationWithAttrs (attributes rel)

396+isEmptyRelationExpr _ = False

397+

398+--transitive static variable optimization

399+replaceStaticAtomExprs :: GraphRefRestrictionPredicateExpr -> M.Map AttributeName GraphRefAtomExpr -> GraphRefRestrictionPredicateExpr

400+replaceStaticAtomExprs predIn replaceMap = case predIn of

401+ AttributeEqualityPredicate newAttrName (AttributeAtomExpr matchName) -> case M.lookup matchName replaceMap of

402+ Nothing -> predIn

403+ Just newVal -> AttributeEqualityPredicate newAttrName newVal

404+ AttributeEqualityPredicate{} -> predIn

405+ AndPredicate pred1 pred2 -> AndPredicate (replaceStaticAtomExprs pred1 replaceMap) (replaceStaticAtomExprs pred2 replaceMap)

406+ OrPredicate pred1 pred2 -> OrPredicate (replaceStaticAtomExprs pred1 replaceMap) (replaceStaticAtomExprs pred2 replaceMap)

407+ NotPredicate pred1 -> NotPredicate (replaceStaticAtomExprs pred1 replaceMap)

408+ TruePredicate -> predIn

409+ RelationalExprPredicate{} -> predIn

410+ AtomExprPredicate{} -> predIn

411+-- used for transitive attribute optimization- only works on statically-determined atoms for now- in the future, this could work for all AtomExprs which don't reference attributes

412+findStaticRestrictionPredicates :: GraphRefRestrictionPredicateExpr -> M.Map AttributeName GraphRefAtomExpr

413+findStaticRestrictionPredicates (AttributeEqualityPredicate attrName atomExpr) =

414+ case atomExpr of

415+ val@NakedAtomExpr{} -> M.singleton attrName val

416+ val@ConstructedAtomExpr{} -> M.singleton attrName val

417+ _ -> M.empty

418+

419+findStaticRestrictionPredicates (AndPredicate pred1 pred2) =

420+ M.union (findStaticRestrictionPredicates pred1) (findStaticRestrictionPredicates pred2)

421+findStaticRestrictionPredicates (OrPredicate pred1 pred2) =

422+ M.union (findStaticRestrictionPredicates pred1) (findStaticRestrictionPredicates pred2)

423+findStaticRestrictionPredicates (NotPredicate predi) = findStaticRestrictionPredicates predi

424+findStaticRestrictionPredicates TruePredicate = M.empty

425+findStaticRestrictionPredicates RelationalExprPredicate{} = M.empty

426+findStaticRestrictionPredicates AtomExprPredicate{} = M.empty

427+

428+isStaticAtomExpr :: AtomExpr -> Bool

429+isStaticAtomExpr NakedAtomExpr{} = True

430+isStaticAtomExpr ConstructedAtomExpr{} = True

431+isStaticAtomExpr AttributeAtomExpr{} = False

432+isStaticAtomExpr FunctionAtomExpr{} = False

433+isStaticAtomExpr RelationAtomExpr{} = False

434+

435+--if the projection of a join only uses the attributes from one of the expressions and there is a foreign key relationship between the expressions, we know that the join is inconsequential and can be removed

436+applyStaticJoinElimination :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr

437+applyStaticJoinElimination expr@(Project attrNameSet (Join exprA exprB)) = do

438+ graph <- askGraph

439+ case inSameTransaction exprA exprB of

440+ -- the sub exprs are in different transactions or none at all, so we cannot extract inclusion dependencies across transaction boundaries

441+ Nothing -> pure expr

442+ Just marker -> do

443+ commonContext <- case marker of

444+ UncommittedContextMarker -> askContext

445+ TransactionMarker tid -> concreteDatabaseContext <$> lift (except (transactionForId tid graph))

446+ let typeForExpr e = lift $ except $ runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr e)

447+ gfEnv = freshGraphRefRelationalExprEnv (Just commonContext) graph

448+

449+ projType <- typeForExpr expr

450+ typeA <- typeForExpr exprA

451+ typeB <- typeForExpr exprB

452+ let matchesProjectionAttributes

453+ | attrNames projType `S.isSubsetOf` attrNames typeA =

454+ Just ((exprA, typeA), (exprB, typeB))

455+ | attrNames projType `S.isSubsetOf` attrNames typeB =

456+ Just ((exprB, typeB), (exprA, typeA))

457+ | otherwise =

458+ Nothing

459+ attrNames = A.attributeNameSet . attributes

460+ case matchesProjectionAttributes of

461+ Nothing -> -- this optimization does not apply

462+ pure expr

463+ Just ((joinedExpr, joinedType), (unjoinedExpr, _)) -> do

464+ --lookup transaction

465+ --scan inclusion dependencies for a foreign key relationship

466+ let incDeps = inclusionDependencies commonContext

467+ fkConstraint = foldM isFkConstraint False incDeps

468+ --search for matching fk constraint

469+ isFkConstraint acc (InclusionDependency (Project subAttrNames subrv) (Project _ superrv)) = do

470+ let gfSubAttrNames = processM (processAttributeNames subAttrNames)

471+ gfSubRv = processM (processRelationalExpr subrv)

472+ gfSuperRv = processM (processRelationalExpr superrv)

473+ processM = runProcessExprM marker

474+ case runGraphRefRelationalExprM gfEnv (evalGraphRefAttributeNames gfSubAttrNames expr) of

475+ Left _ -> pure acc

476+ Right subAttrNameSet ->

477+ pure (acc || (joinedExpr == gfSubRv &&

478+ unjoinedExpr == gfSuperRv &&

479+ -- the fk attribute is one of the projection attributes

480+ A.attributeNamesContained subAttrNameSet (A.attributeNameSet (attributes joinedType))

481+ ))

482+ isFkConstraint acc _ = pure acc

483+ case fkConstraint of

484+ Right True -> --join elimination optimization applies

485+ optimizeGraphRefRelationalExpr (Project attrNameSet joinedExpr)

486+ Right False -> --join elimination optimization does not apply

487+ pure expr

488+ Left err -> throwError err

489+

490+applyStaticJoinElimination expr = pure expr

491+

492+--restriction collapse converts chained restrictions into (Restrict (And pred1 pred2 pred3...))

493+ --this optimization should be fairly uncontroversial- performing a tuple scan once is cheaper than twice- parallelization can still take place

494+applyStaticRestrictionCollapse :: GraphRefRelationalExpr -> GraphRefRelationalExpr

495+applyStaticRestrictionCollapse expr =

496+ case expr of

497+ MakeRelationFromExprs _ _ -> expr

498+ MakeStaticRelation _ _ -> expr

499+ ExistingRelation _ -> expr

500+ RelationVariable _ _ -> expr

501+ With _ _ -> expr

502+ Project attrs subexpr ->

503+ Project attrs (applyStaticRestrictionCollapse subexpr)

504+ Union sub1 sub2 ->

505+ Union (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)

506+ Join sub1 sub2 ->

507+ Join (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)

508+ Rename n1 n2 sub ->

509+ Rename n1 n2 (applyStaticRestrictionCollapse sub)

510+ Difference sub1 sub2 ->

511+ Difference (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)

512+ Group n1 n2 sub ->

513+ Group n1 n2 (applyStaticRestrictionCollapse sub)

514+ Ungroup n1 sub ->

515+ Ungroup n1 (applyStaticRestrictionCollapse sub)

516+ Equals sub1 sub2 ->

517+ Equals (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)

518+ NotEquals sub1 sub2 ->

519+ NotEquals (applyStaticRestrictionCollapse sub1) (applyStaticRestrictionCollapse sub2)

520+ Extend n sub ->

521+ Extend n (applyStaticRestrictionCollapse sub)

522+ Restrict firstPred _ ->

523+ let restrictions = sequentialRestrictions expr

524+ finalExpr = last restrictions

525+ optFinalExpr = case finalExpr of

526+ Restrict _ subexpr -> applyStaticRestrictionCollapse subexpr

527+ otherExpr -> otherExpr

528+ andPreds = foldr (\(Restrict subpred _) acc -> AndPredicate acc subpred) firstPred (tail restrictions) in

529+ Restrict andPreds optFinalExpr

530+

531+sequentialRestrictions :: RelationalExprBase a -> [RelationalExprBase a]

532+sequentialRestrictions expr@(Restrict _ subexpr) = expr:sequentialRestrictions subexpr

533+sequentialRestrictions _ = []

534+

535+--restriction pushdown only really makes sense for tuple-oriented storage schemes where performing a restriction before projection can cut down on the intermediate storage needed to store the data before the projection

536+-- x{proj} where c1 -> (x where c1){proj} #project on fewer tuples

537+-- (x union y) where c -> (x where c) union (y where c) #with a selective restriction, fewer tuples will need to be joined

538+applyStaticRestrictionPushdown :: GraphRefRelationalExpr -> GraphRefRelationalExpr

539+applyStaticRestrictionPushdown expr = case expr of

540+ MakeRelationFromExprs _ _ -> expr

541+ MakeStaticRelation _ _ -> expr

542+ ExistingRelation _ -> expr

543+ RelationVariable _ _ -> expr

544+ With _ _ -> expr

545+ Project _ _ -> expr

546+ --this transformation cannot be inverted because the projection attributes might not exist in the inverted version

547+ Restrict restrictAttrs (Project projAttrs subexpr) ->

548+ Project projAttrs (Restrict restrictAttrs (applyStaticRestrictionPushdown subexpr))

549+ Restrict restrictAttrs (Union subexpr1 subexpr2) ->

550+ let optSub1 = applyStaticRestrictionPushdown subexpr1

551+ optSub2 = applyStaticRestrictionPushdown subexpr2 in

552+ Union (Restrict restrictAttrs optSub1) (Restrict restrictAttrs optSub2)

553+ Restrict attrs subexpr ->

554+ Restrict attrs (applyStaticRestrictionPushdown subexpr)

555+

556+ Union sub1 sub2 ->

557+ Union (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)

558+ Join sub1 sub2 ->

559+ Join (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)

560+ Rename n1 n2 sub ->

561+ Rename n1 n2 (applyStaticRestrictionPushdown sub)

562+ Difference sub1 sub2 ->

563+ Difference (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)

564+ Group n1 n2 sub ->

565+ Group n1 n2 (applyStaticRestrictionPushdown sub)

566+ Ungroup n1 sub ->

567+ Ungroup n1 (applyStaticRestrictionPushdown sub)

568+ Equals sub1 sub2 ->

569+ Equals (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)

570+ NotEquals sub1 sub2 ->

571+ NotEquals (applyStaticRestrictionPushdown sub1) (applyStaticRestrictionPushdown sub2)

572+ Extend n sub ->

573+ Extend n (applyStaticRestrictionPushdown sub)

574+

575+-- no optimizations available

576+optimizeDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextIOExpr

577+optimizeDatabaseContextIOExpr = pure

578+

src/lib/ProjectM36/TransGraphRelationalExpression.hs+142−116

@@ -1,154 +1,180 @@

1−{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}

1+{-# LANGUAGE FlexibleInstances #-}

2{-# OPTIONS_GHC -fno-warn-orphans #-}

3--really, a better name for this module could be "TransTransactionGraphRelationalExpr", but that name is too long

4module ProjectM36.TransGraphRelationalExpression where

5import ProjectM36.Base

6import ProjectM36.TransactionGraph

7−import ProjectM36.Transaction

8−import ProjectM36.RelationalExpression

9import ProjectM36.Error

7import ProjectM36.Error

10−import ProjectM36.Tuple

11−import ProjectM36.AtomType

12import qualified Data.Map as M

8import qualified Data.Map as M

13import Control.Monad.Trans.Reader

9import Control.Monad.Trans.Reader

14−import Data.Binary

10+import Control.Monad.Trans.Class

11+import Control.Monad.Trans.Except

12+import Data.Functor.Identity

16-- | The TransGraphRelationalExpression is equivalent to a relational expression except that relation variables can reference points in the transaction graph (at previous points in time).

14-- | The TransGraphRelationalExpression is equivalent to a relational expression except that relation variables can reference points in the transaction graph (at previous points in time).

17type TransGraphRelationalExpr = RelationalExprBase TransactionIdLookup

15type TransGraphRelationalExpr = RelationalExprBase TransactionIdLookup

19−instance Binary TransGraphRelationalExpr

17+type TransGraphAttributeNames = AttributeNamesBase TransactionIdLookup

21type TransGraphExtendTupleExpr = ExtendTupleExprBase TransactionIdLookup

19type TransGraphExtendTupleExpr = ExtendTupleExprBase TransactionIdLookup

23−instance Binary TransGraphExtendTupleExpr

24−

25type TransGraphTupleExpr = TupleExprBase TransactionIdLookup

21type TransGraphTupleExpr = TupleExprBase TransactionIdLookup

27−instance Binary TransGraphTupleExpr

23+type TransGraphTupleExprs = TupleExprsBase TransactionIdLookup

29type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup

25type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup

31−instance Binary TransGraphRestrictionPredicateExpr

32−

33type TransGraphAtomExpr = AtomExprBase TransactionIdLookup

27type TransGraphAtomExpr = AtomExprBase TransactionIdLookup

35−instance Binary TransGraphAtomExpr

36−

37type TransGraphAttributeExpr = AttributeExprBase TransactionIdLookup

29type TransGraphAttributeExpr = AttributeExprBase TransactionIdLookup

31+type TransGraphWithNameExpr = WithNameExprBase TransactionIdLookup

32+

33+newtype TransGraphEvalEnv = TransGraphEvalEnv {

34+ tge_graph :: TransactionGraph

35+ }

36+

37+type TransGraphEvalMonad a = ReaderT TransGraphEvalEnv (ExceptT RelationalError Identity) a

38+

39+process :: TransGraphEvalEnv -> TransGraphRelationalExpr -> Either RelationalError GraphRefRelationalExpr

40+process env texpr = runIdentity (runExceptT (runReaderT (processTransGraphRelationalExpr texpr) env))

41+

42+liftE :: Either RelationalError a -> TransGraphEvalMonad a

43+liftE = lift . except

44+

45+askGraph :: TransGraphEvalMonad TransactionGraph

46+askGraph = tge_graph <$> ask

47+

48+findTransId :: TransactionIdLookup -> TransGraphEvalMonad GraphRefTransactionMarker

49+findTransId tlook = TransactionMarker . transactionId <$> findTrans tlook

50+

51+findTrans :: TransactionIdLookup -> TransGraphEvalMonad Transaction

52+findTrans tlook = do

53+ graph <- askGraph

54+ liftE $ lookupTransaction graph tlook

55+

39-- OUTDATED a previous attempt at this function attempted to convert TransGraphRelationalExpr to RelationalExpr by resolving the transaction lookups. However, there is no way to resolve a FunctionAtomExpr to an Atom without fully evaluating the higher levels (TupleExpr, etc.). An anonymous function expression cannot be serialized, so that workaround is out. Still, I suspect we can reuse the existing static optimizer logic to work on both structures. The current conversion reduces the chance of whole-query optimization due to full-evaluation on top of full-evaluation, so this function would benefit from some re-design.

56-- OUTDATED a previous attempt at this function attempted to convert TransGraphRelationalExpr to RelationalExpr by resolving the transaction lookups. However, there is no way to resolve a FunctionAtomExpr to an Atom without fully evaluating the higher levels (TupleExpr, etc.). An anonymous function expression cannot be serialized, so that workaround is out. Still, I suspect we can reuse the existing static optimizer logic to work on both structures. The current conversion reduces the chance of whole-query optimization due to full-evaluation on top of full-evaluation, so this function would benefit from some re-design.

40−evalTransGraphRelationalExpr :: TransGraphRelationalExpr -> TransactionGraph -> Either RelationalError RelationalExpr

57+processTransGraphRelationalExpr :: TransGraphRelationalExpr -> TransGraphEvalMonad GraphRefRelationalExpr

41−evalTransGraphRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) graph = do

58+processTransGraphRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do

42− tupleExprs' <- mapM (evalTransGraphTupleExpr graph) tupleExprs

59+ tupleExprs' <- processTransGraphTupleExprs tupleExprs

43 case mAttrExprs of

60 case mAttrExprs of

44 Nothing -> pure (MakeRelationFromExprs Nothing tupleExprs')

61 Nothing -> pure (MakeRelationFromExprs Nothing tupleExprs')

45 Just attrExprs -> do

62 Just attrExprs -> do

46− attrExprs' <- mapM (evalTransGraphAttributeExpr graph) attrExprs

63+ attrExprs' <- mapM processTransGraphAttributeExpr attrExprs

47 pure (MakeRelationFromExprs (Just attrExprs') tupleExprs')

64 pure (MakeRelationFromExprs (Just attrExprs') tupleExprs')

48−evalTransGraphRelationalExpr (MakeStaticRelation attrs tupSet) _ = pure (MakeStaticRelation attrs tupSet)

65+processTransGraphRelationalExpr (MakeStaticRelation attrs tupSet) = pure (MakeStaticRelation attrs tupSet)

49−evalTransGraphRelationalExpr (ExistingRelation rel) _ = pure (ExistingRelation rel)

66+processTransGraphRelationalExpr (ExistingRelation rel) = pure (ExistingRelation rel)

50−evalTransGraphRelationalExpr (RelationVariable rvname transLookup) graph = do

67+processTransGraphRelationalExpr (RelationVariable rvname transLookup) =

51− trans <- lookupTransaction graph transLookup

68+ RelationVariable rvname <$> findTransId transLookup

52− rel <- runReader (evalRelationalExpr (RelationVariable rvname ())) (RelationalExprStateElems (concreteDatabaseContext trans))

69+processTransGraphRelationalExpr (Project transAttrNames expr) =

53− pure (ExistingRelation rel)

70+ Project <$> processTransGraphAttributeNames transAttrNames <*> processTransGraphRelationalExpr expr

54−evalTransGraphRelationalExpr (Project attrNames expr) graph = do

71+processTransGraphRelationalExpr (Union exprA exprB) =

55− expr' <- evalTransGraphRelationalExpr expr graph

72+ Union <$> processTransGraphRelationalExpr exprA <*> processTransGraphRelationalExpr exprB

56− pure (Project attrNames expr')

73+processTransGraphRelationalExpr (Join exprA exprB) =

57−evalTransGraphRelationalExpr (Union exprA exprB) graph = do

74+ Join <$> processTransGraphRelationalExpr exprA <*> processTransGraphRelationalExpr exprB

58− exprA' <- evalTransGraphRelationalExpr exprA graph

59− exprB' <- evalTransGraphRelationalExpr exprB graph

60− pure (Union exprA' exprB')

61−evalTransGraphRelationalExpr (Join exprA exprB) graph = do

62− exprA' <- evalTransGraphRelationalExpr exprA graph

63− exprB' <- evalTransGraphRelationalExpr exprB graph

64− pure (Join exprA' exprB')

65−evalTransGraphRelationalExpr (Rename attrName1 attrName2 expr) graph = do

75+processTransGraphRelationalExpr (Rename attrName1 attrName2 expr) =

66− expr' <- evalTransGraphRelationalExpr expr graph

67− pure (Rename attrName1 attrName2 expr')

76+ Rename attrName1 attrName2 <$> processTransGraphRelationalExpr expr

68−evalTransGraphRelationalExpr (Difference exprA exprB) graph = do

77+processTransGraphRelationalExpr (Difference exprA exprB) =

69− exprA' <- evalTransGraphRelationalExpr exprA graph

78+ Difference <$> processTransGraphRelationalExpr exprA <*> processTransGraphRelationalExpr exprB

70− exprB' <- evalTransGraphRelationalExpr exprB graph

79+processTransGraphRelationalExpr (Group transAttrNames attrName expr) =

71− pure (Difference exprA' exprB')

80+ Group <$>

72−evalTransGraphRelationalExpr (Group attrNames attrName expr) graph = do

81+ processTransGraphAttributeNames transAttrNames <*>

73− expr' <- evalTransGraphRelationalExpr expr graph

82+ pure attrName <*>

74− pure (Group attrNames attrName expr')

83+ processTransGraphRelationalExpr expr

75−evalTransGraphRelationalExpr (Ungroup attrName expr) graph = do

84+processTransGraphRelationalExpr (Ungroup attrName expr) =

76− expr' <- evalTransGraphRelationalExpr expr graph

77− pure (Ungroup attrName expr')

85+ Ungroup attrName <$> processTransGraphRelationalExpr expr

78−evalTransGraphRelationalExpr (Restrict predicateExpr expr) graph = do

86+processTransGraphRelationalExpr (Restrict predicateExpr expr) =

79− expr' <- evalTransGraphRelationalExpr expr graph

80− predicateExpr' <- evalTransGraphRestrictionPredicateExpr predicateExpr graph

87+ Restrict <$> evalTransGraphRestrictionPredicateExpr predicateExpr <*>

81− pure (Restrict predicateExpr' expr')

88+ processTransGraphRelationalExpr expr

82−evalTransGraphRelationalExpr (Equals exprA exprB) graph = do

89+processTransGraphRelationalExpr (Equals exprA exprB) = do

83− exprA' <- evalTransGraphRelationalExpr exprA graph

90+ exprA' <- processTransGraphRelationalExpr exprA

84− exprB' <- evalTransGraphRelationalExpr exprB graph

91+ exprB' <- processTransGraphRelationalExpr exprB

85 pure (Equals exprA' exprB')

92 pure (Equals exprA' exprB')

86−evalTransGraphRelationalExpr (NotEquals exprA exprB) graph = do

93+processTransGraphRelationalExpr (NotEquals exprA exprB) = do

87− exprA' <- evalTransGraphRelationalExpr exprA graph

94+ exprA' <- processTransGraphRelationalExpr exprA

88− exprB' <- evalTransGraphRelationalExpr exprB graph

95+ exprB' <- processTransGraphRelationalExpr exprB

89 pure (NotEquals exprA' exprB')

96 pure (NotEquals exprA' exprB')

90−evalTransGraphRelationalExpr (Extend extendExpr expr) graph = do

97+processTransGraphRelationalExpr (Extend extendExpr expr) = do

91− extendExpr' <- evalTransGraphExtendTupleExpr extendExpr graph

98+ extendExpr' <- processTransGraphExtendTupleExpr extendExpr

92− expr' <- evalTransGraphRelationalExpr expr graph

99+ expr' <- processTransGraphRelationalExpr expr

93 pure (Extend extendExpr' expr')

100 pure (Extend extendExpr' expr')

94−

101+processTransGraphRelationalExpr (With views expr) = do

95−evalTransGraphTupleExpr :: TransactionGraph -> TransGraphTupleExpr -> Either RelationalError TupleExpr

102+ evaldViews <- mapM (\(wnexpr, vexpr) -> do

103+ wnexpr' <- processTransGraphWithNameExpr wnexpr

104+ vexpr' <- processTransGraphRelationalExpr vexpr

105+ pure (wnexpr', vexpr')

106+ ) views

107+ expr' <- processTransGraphRelationalExpr expr

108+ pure (With evaldViews expr')

109+

110+processTransGraphTupleExprs :: TransGraphTupleExprs -> TransGraphEvalMonad GraphRefTupleExprs

111+processTransGraphTupleExprs (TupleExprs marker texprs) =

112+ TupleExprs <$> findTransId marker <*> mapM processTransGraphTupleExpr texprs

113+

114+processTransGraphTupleExpr :: TransGraphTupleExpr -> TransGraphEvalMonad GraphRefTupleExpr

96−evalTransGraphTupleExpr graph (TupleExpr attrMap) = do

115+processTransGraphTupleExpr (TupleExpr attrMap) = do

97− attrAssoc <- mapM (\(attrName, atomExpr) -> do

116+ let attrAssoc = mapM (\(attrName, atomExpr) -> do

98− aExpr <- evalTransGraphAtomExpr graph atomExpr

117+ aExpr <- processTransGraphAtomExpr atomExpr

99 pure (attrName, aExpr)

118 pure (attrName, aExpr)

100 ) (M.toList attrMap)

119 ) (M.toList attrMap)

101− pure (TupleExpr (M.fromList attrAssoc))

120+ TupleExpr . M.fromList <$> attrAssoc

102

121

103−evalTransGraphAtomExpr :: TransactionGraph -> TransGraphAtomExpr -> Either RelationalError AtomExpr

122+processTransGraphAtomExpr :: TransGraphAtomExpr -> TransGraphEvalMonad GraphRefAtomExpr

104−evalTransGraphAtomExpr _ (AttributeAtomExpr aname) = pure $ AttributeAtomExpr aname

123+processTransGraphAtomExpr (AttributeAtomExpr aname) = pure $ AttributeAtomExpr aname

105−evalTransGraphAtomExpr _ (NakedAtomExpr atom) = pure $ NakedAtomExpr atom

124+processTransGraphAtomExpr (NakedAtomExpr atom) = pure $ NakedAtomExpr atom

106−evalTransGraphAtomExpr graph (FunctionAtomExpr funcName args tLookup) = do

125+processTransGraphAtomExpr (FunctionAtomExpr funcName args tLookup) =

107− trans <- lookupTransaction graph tLookup

126+ FunctionAtomExpr funcName <$> mapM processTransGraphAtomExpr args <*> findTransId tLookup

108− --I can't return a FunctionAtomExpr because the function needs to be resolved at a specific context

109− args' <- mapM (evalTransGraphAtomExpr graph) args

110− atom <- runReader (evalAtomExpr emptyTuple (FunctionAtomExpr funcName args' ())) (RelationalExprStateElems (concreteDatabaseContext trans))

111− pure (NakedAtomExpr atom)

112−evalTransGraphAtomExpr graph (RelationAtomExpr expr) = do

127+processTransGraphAtomExpr (RelationAtomExpr expr) =

113− expr' <- evalTransGraphRelationalExpr expr graph

128+ RelationAtomExpr <$> processTransGraphRelationalExpr expr

114− pure (RelationAtomExpr expr')

115−evalTransGraphAtomExpr graph (ConstructedAtomExpr dConsName args tLookup) = do

129+processTransGraphAtomExpr (ConstructedAtomExpr dConsName args tLookup) =

116− trans <- lookupTransaction graph tLookup

130+ ConstructedAtomExpr dConsName <$> mapM processTransGraphAtomExpr args <*> findTransId tLookup

117− args' <- mapM (evalTransGraphAtomExpr graph) args

118− atom <- runReader (evalAtomExpr emptyTuple (ConstructedAtomExpr dConsName args' ())) (RelationalExprStateElems (concreteDatabaseContext trans))

119− pure (NakedAtomExpr atom)

120−

121−evalTransGraphRestrictionPredicateExpr :: TransGraphRestrictionPredicateExpr -> TransactionGraph -> Either RelationalError RestrictionPredicateExpr

131+evalTransGraphRestrictionPredicateExpr :: TransGraphRestrictionPredicateExpr -> TransGraphEvalMonad GraphRefRestrictionPredicateExpr

122−evalTransGraphRestrictionPredicateExpr TruePredicate _ = pure TruePredicate

132+evalTransGraphRestrictionPredicateExpr TruePredicate = pure TruePredicate

123−evalTransGraphRestrictionPredicateExpr (AndPredicate exprA exprB) graph = do

133+evalTransGraphRestrictionPredicateExpr (AndPredicate exprA exprB) = do

124− exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph

134+ exprA' <- evalTransGraphRestrictionPredicateExpr exprA

125− exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph

135+ exprB' <- evalTransGraphRestrictionPredicateExpr exprB

126 pure (AndPredicate exprA' exprB')

136 pure (AndPredicate exprA' exprB')

127−evalTransGraphRestrictionPredicateExpr (OrPredicate exprA exprB) graph = do

137+evalTransGraphRestrictionPredicateExpr (OrPredicate exprA exprB) = do

128− exprA' <- evalTransGraphRestrictionPredicateExpr exprA graph

138+ exprA' <- evalTransGraphRestrictionPredicateExpr exprA

129− exprB' <- evalTransGraphRestrictionPredicateExpr exprB graph

139+ exprB' <- evalTransGraphRestrictionPredicateExpr exprB

130 pure (OrPredicate exprA' exprB')

140 pure (OrPredicate exprA' exprB')

131−evalTransGraphRestrictionPredicateExpr (NotPredicate expr) graph = do

141+evalTransGraphRestrictionPredicateExpr (NotPredicate expr) = do

132− expr' <- evalTransGraphRestrictionPredicateExpr expr graph

142+ let expr' = evalTransGraphRestrictionPredicateExpr expr

133− pure (NotPredicate expr')

143+ NotPredicate <$> expr'

134−evalTransGraphRestrictionPredicateExpr (RelationalExprPredicate expr) graph = do

144+evalTransGraphRestrictionPredicateExpr (RelationalExprPredicate expr) = do

135− expr' <- evalTransGraphRelationalExpr expr graph

145+ let expr' = processTransGraphRelationalExpr expr

136− pure (RelationalExprPredicate expr')

146+ RelationalExprPredicate <$> expr'

137−evalTransGraphRestrictionPredicateExpr (AtomExprPredicate expr) graph = do

147+evalTransGraphRestrictionPredicateExpr (AtomExprPredicate expr) = do

138− expr' <- evalTransGraphAtomExpr graph expr

148+ let expr' = processTransGraphAtomExpr expr

139− pure (AtomExprPredicate expr')

149+ AtomExprPredicate <$> expr'

140−evalTransGraphRestrictionPredicateExpr (AttributeEqualityPredicate attrName expr) graph = do

150+evalTransGraphRestrictionPredicateExpr (AttributeEqualityPredicate attrName expr) = do

141− expr' <- evalTransGraphAtomExpr graph expr

151+ let expr' = processTransGraphAtomExpr expr

142− pure (AttributeEqualityPredicate attrName expr')

152+ AttributeEqualityPredicate attrName <$> expr'

143

153

144−evalTransGraphExtendTupleExpr :: TransGraphExtendTupleExpr -> TransactionGraph -> Either RelationalError ExtendTupleExpr

154+processTransGraphExtendTupleExpr :: TransGraphExtendTupleExpr -> TransGraphEvalMonad GraphRefExtendTupleExpr

145−evalTransGraphExtendTupleExpr (AttributeExtendTupleExpr attrName expr) graph = do

155+processTransGraphExtendTupleExpr (AttributeExtendTupleExpr attrName expr) =

146− expr' <- evalTransGraphAtomExpr graph expr

156+ AttributeExtendTupleExpr attrName <$> processTransGraphAtomExpr expr

147− pure (AttributeExtendTupleExpr attrName expr')

157+

148−

158+processTransGraphAttributeExpr :: TransGraphAttributeExpr -> TransGraphEvalMonad GraphRefAttributeExpr

149−evalTransGraphAttributeExpr :: TransactionGraph -> TransGraphAttributeExpr -> Either RelationalError AttributeExpr

150−evalTransGraphAttributeExpr graph (AttributeAndTypeNameExpr attrName tCons tLookup) = do

159+processTransGraphAttributeExpr (AttributeAndTypeNameExpr attrName tCons tLookup) =

151− trans <- lookupTransaction graph tLookup

160+ AttributeAndTypeNameExpr attrName tCons <$> findTransId tLookup

152− aType <- atomTypeForTypeConstructor tCons (typeConstructorMapping (concreteDatabaseContext trans)) M.empty

161+processTransGraphAttributeExpr (NakedAttributeExpr attr) = pure (NakedAttributeExpr attr)

153− pure (NakedAttributeExpr (Attribute attrName aType))

162+

154−evalTransGraphAttributeExpr _ (NakedAttributeExpr attr) = pure (NakedAttributeExpr attr)

163+processTransGraphAttributeNames :: TransGraphAttributeNames -> TransGraphEvalMonad GraphRefAttributeNames

164+processTransGraphAttributeNames (AttributeNames names) = pure (AttributeNames names)

165+processTransGraphAttributeNames (InvertedAttributeNames names) = pure (InvertedAttributeNames names)

166+processTransGraphAttributeNames (UnionAttributeNames namesA namesB) = do

167+ nA <- processTransGraphAttributeNames namesA

168+ nB <- processTransGraphAttributeNames namesB

169+ pure (UnionAttributeNames nA nB)

170+processTransGraphAttributeNames (IntersectAttributeNames namesA namesB) = do

171+ nA <- processTransGraphAttributeNames namesA

172+ nB <- processTransGraphAttributeNames namesB

173+ pure (IntersectAttributeNames nA nB)

174+processTransGraphAttributeNames (RelationalExprAttributeNames expr) = do

175+ evaldExpr <- processTransGraphRelationalExpr expr

176+ pure (RelationalExprAttributeNames evaldExpr)

177+

178+processTransGraphWithNameExpr :: TransGraphWithNameExpr -> TransGraphEvalMonad GraphRefWithNameExpr

179+processTransGraphWithNameExpr (WithNameExpr rvname tlookup) =

180+ WithNameExpr rvname <$> findTransId tlookup

src/lib/ProjectM36/Transaction.hs+24−16

@@ -3,28 +3,24 @@ import ProjectM36.Base

3import qualified Data.Set as S

4import qualified Data.UUID as U

5import Data.Time.Clock

6+import qualified Data.List.NonEmpty as NE

7−transactionTimestamp :: Transaction -> UTCTime

8+parentIds :: Transaction -> S.Set TransactionId

8−transactionTimestamp (Transaction _ (TransactionInfo _ _ stamp) _) = stamp

9+parentIds (Transaction _ tinfo _) = S.fromList (NE.toList (parents tinfo))

9−transactionTimestamp (Transaction _ (MergeTransactionInfo _ _ _ stamp) _) = stamp

11−transactionParentIds :: Transaction -> S.Set TransactionId

11+rootParent :: TransactionParents

12−transactionParentIds (Transaction _ (TransactionInfo pId _ _) _) = S.singleton pId

12+rootParent = singleParent U.nil

13−transactionParentIds (Transaction _ (MergeTransactionInfo pId1 pId2 _ _) _) = S.fromList [pId1, pId2]

15−transactionChildIds :: Transaction -> S.Set TransactionId

14+singleParent :: TransactionId -> TransactionParents

16−transactionChildIds (Transaction _ (TransactionInfo _ children _) _) = children

15+singleParent tid = tid NE.:| []

17−transactionChildIds (Transaction _ (MergeTransactionInfo _ _ children _) _) = children

18−

19−-- | Create a new transaction which is identical to the original except that a new set of child transaction ids is added.

20−transactionSetChildren :: Transaction -> S.Set TransactionId -> Transaction

21−transactionSetChildren t@(Transaction _ (TransactionInfo pId _ stamp) schemas') childIds = Transaction (transactionId t) (TransactionInfo pId childIds stamp) schemas'

22−transactionSetChildren t@(Transaction _ (MergeTransactionInfo pId1 pId2 _ stamp) schemas') childIds = Transaction (transactionId t) (MergeTransactionInfo pId1 pId2 childIds stamp) schemas'

24-- | Return the same transaction but referencing only the specific child transactions. This is useful when traversing a graph and returning a subgraph. This doesn't filter parent transactions because it assumes a head-to-root traversal.

17-- | Return the same transaction but referencing only the specific child transactions. This is useful when traversing a graph and returning a subgraph. This doesn't filter parent transactions because it assumes a head-to-root traversal.

25filterTransactionInfoTransactions :: S.Set TransactionId -> TransactionInfo -> TransactionInfo

18filterTransactionInfoTransactions :: S.Set TransactionId -> TransactionInfo -> TransactionInfo

26−filterTransactionInfoTransactions filterIds (TransactionInfo parentId childIds stamp) = TransactionInfo (filterParent parentId filterIds) (S.intersection childIds filterIds) stamp

19+filterTransactionInfoTransactions filterIds tinfo =

27−filterTransactionInfoTransactions filterIds (MergeTransactionInfo parentIdA parentIdB childIds stamp) = MergeTransactionInfo (filterParent parentIdA filterIds) (filterParent parentIdB filterIds) (S.intersection childIds filterIds) stamp

20+ tinfo { parents = case

21+ NE.filter (`S.member` filterIds) (parents tinfo) of

22+ [] -> rootParent

23+ xs -> NE.fromList xs}

29filterParent :: TransactionId -> S.Set TransactionId -> TransactionId

25filterParent :: TransactionId -> S.Set TransactionId -> TransactionId

30filterParent parentId validIds = if S.member parentId validIds then parentId else U.nil

26filterParent parentId validIds = if S.member parentId validIds then parentId else U.nil

@@ -44,3 +40,15 @@ schemas (Transaction _ _ schemas') = schemas'

44-- | Returns all subschemas which are isomorphic or sub-isomorphic to the concrete schema.

40-- | Returns all subschemas which are isomorphic or sub-isomorphic to the concrete schema.

45subschemas :: Transaction -> Subschemas

41subschemas :: Transaction -> Subschemas

46subschemas (Transaction _ _ (Schemas _ sschemas)) = sschemas

42subschemas (Transaction _ _ (Schemas _ sschemas)) = sschemas

43+

44+fresh :: TransactionId -> UTCTime -> Schemas -> Transaction

45+fresh freshId stamp' = Transaction freshId tinfo

46+ where

47+ tinfo = TransactionInfo {parents = rootParent,

48+ stamp = stamp',

49+ merkleHash = mempty

50+ }

51+

52+timestamp :: Transaction -> UTCTime

53+timestamp (Transaction _ tinfo _) = stamp tinfo

54+

src/lib/ProjectM36/Transaction/Persist.hs+66−59

@@ -1,3 +1,4 @@

1+{-# LANGUAGE TypeApplications #-}

1module ProjectM36.Transaction.Persist where

2module ProjectM36.Transaction.Persist where

2import ProjectM36.Base

3import ProjectM36.Base

3import ProjectM36.Error

4import ProjectM36.Error

@@ -7,25 +8,24 @@ import ProjectM36.AtomFunction

7import ProjectM36.Persist (writeBSFileSync, DiskSync, renameSync)

8import ProjectM36.Persist (writeBSFileSync, DiskSync, renameSync)

8import qualified Data.Map as M

9import qualified Data.Map as M

9import qualified Data.HashSet as HS

10import qualified Data.HashSet as HS

10−import qualified Data.Binary as B

11−--import qualified Data.ByteString as BS

12import System.FilePath

11import System.FilePath

13import System.Directory

12import System.Directory

14import qualified Data.Text as T

13import qualified Data.Text as T

15import Control.Monad

14import Control.Monad

16import ProjectM36.ScriptSession

15import ProjectM36.ScriptSession

17import ProjectM36.AtomFunctions.Basic (precompiledAtomFunctions)

16import ProjectM36.AtomFunctions.Basic (precompiledAtomFunctions)

18−import Control.Exception

17+import Codec.Winery

18+

19+#ifdef PM36_HASKELL_SCRIPTING

19import GHC

20import GHC

21+import Control.Exception

20import GHC.Paths

22import GHC.Paths

21−import Codec.Compression.GZip

23+#endif

22−import qualified Data.ByteString as BS

23−import qualified Data.ByteString.Lazy as BSL

25getDirectoryNames :: FilePath -> IO [FilePath]

26−getDirectoryNames path = do

26+getDirectoryNames path =

27− subpaths <- getDirectoryContents path

28− return $ filter (\n -> n `notElem` ["..", "."]) subpaths

27+ filter (\ n -> n `notElem` ["..", "."]) <$> getDirectoryContents path

28+

30tempTransactionDir :: FilePath -> TransactionId -> FilePath

31tempTransactionDir dbdir transId = dbdir </> "." ++ show transId

@@ -36,8 +36,8 @@ transactionDir dbdir transId = dbdir </> show transId

36transactionInfoPath :: FilePath -> FilePath

37transactionInfoPath transdir = transdir </> "info"

39−relvarsDir :: FilePath -> FilePath

39+relvarsPath :: FilePath -> FilePath

40−relvarsDir transdir = transdir </> "relvars"

40+relvarsPath transdir = transdir </> "relvars"

42incDepsDir :: FilePath -> FilePath

43incDepsDir transdir = transdir </> "incdeps"

@@ -62,7 +62,7 @@ readTransaction dbdir transId mScriptSession = do

62 return $ Left $ MissingTransactionError transId

63 else do

64 relvars <- readRelVars transDir

65− transInfo <- B.decodeFile (transactionInfoPath transDir)

65+ transInfo <- readFileDeserialise (transactionInfoPath transDir)

66 incDeps <- readIncDeps transDir

67 typeCons <- readTypeConstructorMapping transDir

68 sschemas <- readSubschemas transDir

@@ -85,77 +85,75 @@ writeTransaction sync dbdir trans = do

85 transDirExists <- doesDirectoryExist finalTransDir

86 unless transDirExists $ do

87 --create sub directories

88− mapM_ createDirectory [tempTransDir, relvarsDir tempTransDir, incDepsDir tempTransDir, dbcFuncsDir tempTransDir]

88+ mapM_ createDirectory [tempTransDir, incDepsDir tempTransDir, dbcFuncsDir tempTransDir]

89 writeRelVars sync tempTransDir (relationVariables context)

90 writeIncDeps sync tempTransDir (inclusionDependencies context)

91 writeAtomFuncs sync tempTransDir (atomFunctions context)

92 writeDBCFuncs sync tempTransDir (dbcFunctions context)

93 writeTypeConstructorMapping sync tempTransDir (typeConstructorMapping context)

94 writeSubschemas sync tempTransDir (subschemas trans)

95− B.encodeFile (transactionInfoPath tempTransDir) (transactionInfo trans)

95+ writeFileSerialise (transactionInfoPath tempTransDir) (transactionInfo trans)

96 --move the temp directory to final location

97 renameSync sync tempTransDir finalTransDir

98− pure ()

99−

100−writeRelVar :: DiskSync -> FilePath -> (RelVarName, Relation) -> IO ()

101−writeRelVar sync transDir (relvarName, rel) = do

102− let relvarPath = relvarsDir transDir </> T.unpack relvarName

103− writeBSFileSync sync relvarPath (compress (B.encode rel))

104−

105−writeRelVars :: DiskSync -> FilePath -> M.Map RelVarName Relation -> IO ()

106−writeRelVars sync transDir relvars = mapM_ (writeRelVar sync transDir) $ M.toList relvars

107

108−readRelVars :: FilePath -> IO (M.Map RelVarName Relation)

99+writeRelVars :: DiskSync -> FilePath -> RelationVariables -> IO ()

109−readRelVars transDir = do

100+writeRelVars sync transDir relvars = do

110− let relvarsPath = relvarsDir transDir

101+ let path = relvarsPath transDir

111− relvarNames <- getDirectoryNames relvarsPath

102+ writeBSFileSync sync path (serialise relvars)

112− relvars <- mapM (\name -> do

103+

113− rel <- B.decode . decompress . BSL.fromStrict <$> BS.readFile (relvarsPath </> name)

104+readRelVars :: FilePath -> IO RelationVariables

114− return (T.pack name, rel)) relvarNames

105+readRelVars transDir =

115− return $ M.fromList relvars

106+ readFileDeserialise (relvarsPath transDir)

116

107

117writeAtomFuncs :: DiskSync -> FilePath -> AtomFunctions -> IO ()

108writeAtomFuncs :: DiskSync -> FilePath -> AtomFunctions -> IO ()

118writeAtomFuncs sync transDir funcs = do

109writeAtomFuncs sync transDir funcs = do

119 let atomFuncPath = atomFuncsPath transDir

110 let atomFuncPath = atomFuncsPath transDir

120− writeBSFileSync sync atomFuncPath (B.encode $ map (\f -> (atomFuncType f, atomFuncName f, atomFunctionScript f)) (HS.toList funcs))

111+ writeBSFileSync sync atomFuncPath (serialise $ map (\f -> (atomFuncType f, atomFuncName f, atomFunctionScript f)) (HS.toList funcs))

121

112

122--all the atom functions are in one file

113--all the atom functions are in one file

123readAtomFuncs :: FilePath -> Maybe ScriptSession -> IO AtomFunctions

114readAtomFuncs :: FilePath -> Maybe ScriptSession -> IO AtomFunctions

124readAtomFuncs transDir mScriptSession = do

115readAtomFuncs transDir mScriptSession = do

125− atomFuncsList <- B.decodeFile (atomFuncsPath transDir)

116+ atomFuncsList <- readFileDeserialise (atomFuncsPath transDir)

126 --only Haskell script functions can be serialized

117 --only Haskell script functions can be serialized

127 --we always return the pre-compiled functions

118 --we always return the pre-compiled functions

128 funcs <- mapM (\(funcType, funcName, mFuncScript) -> loadAtomFunc precompiledAtomFunctions mScriptSession funcName funcType mFuncScript) atomFuncsList

119 funcs <- mapM (\(funcType, funcName, mFuncScript) -> loadAtomFunc precompiledAtomFunctions mScriptSession funcName funcType mFuncScript) atomFuncsList

129 pure (HS.union precompiledAtomFunctions (HS.fromList funcs))

120 pure (HS.union precompiledAtomFunctions (HS.fromList funcs))

130

121

131loadAtomFunc :: AtomFunctions -> Maybe ScriptSession -> AtomFunctionName -> [AtomType] -> Maybe AtomFunctionBodyScript -> IO AtomFunction

122loadAtomFunc :: AtomFunctions -> Maybe ScriptSession -> AtomFunctionName -> [AtomType] -> Maybe AtomFunctionBodyScript -> IO AtomFunction

132−loadAtomFunc precompiledFuncs mScriptSession funcName funcType mFuncScript = case mFuncScript of

123+loadAtomFunc precompiledFuncs _mScriptSession funcName _funcType mFuncScript = case mFuncScript of

133 --handle pre-compiled case- pull it from the precompiled list

124 --handle pre-compiled case- pull it from the precompiled list

134 Nothing -> case atomFunctionForName funcName precompiledFuncs of

125 Nothing -> case atomFunctionForName funcName precompiledFuncs of

135 --WARNING: possible landmine here if we remove a precompiled atom function in the future, then the transaction cannot be restored

126 --WARNING: possible landmine here if we remove a precompiled atom function in the future, then the transaction cannot be restored

136 Left _ -> error ("expected precompiled atom function: " ++ T.unpack funcName)

127 Left _ -> error ("expected precompiled atom function: " ++ T.unpack funcName)

137 Right realFunc -> pure realFunc

128 Right realFunc -> pure realFunc

138 --handle a real Haskell scripted function- compile and load

129 --handle a real Haskell scripted function- compile and load

139− Just funcScript ->

130+ Just _funcScript ->

140− case mScriptSession of

131+#ifdef PM36_HASKELL_SCRIPTING

132+ case _mScriptSession of

141 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

133 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

142 Just scriptSession -> do

134 Just scriptSession -> do

143 --risk of GHC exception during compilation here

135 --risk of GHC exception during compilation here

144 eCompiledScript <- runGhc (Just libdir) $ do

136 eCompiledScript <- runGhc (Just libdir) $ do

145 setSession (hscEnv scriptSession)

137 setSession (hscEnv scriptSession)

146− compileScript (atomFunctionBodyType scriptSession) funcScript

138+ compileScript (atomFunctionBodyType scriptSession) _funcScript

147 case eCompiledScript of

139 case eCompiledScript of

148 Left err -> throwIO err

140 Left err -> throwIO err

149 Right compiledScript -> pure AtomFunction { atomFuncName = funcName,

141 Right compiledScript -> pure AtomFunction { atomFuncName = funcName,

150− atomFuncType = funcType,

142+ atomFuncType = _funcType,

151− atomFuncBody = AtomFunctionBody (Just funcScript) compiledScript }

143+ atomFuncBody = AtomFunctionBody (Just _funcScript) compiledScript }

144+#else

145+ error "Haskell scripting is disabled"

146+#endif

152

147

153--if the script session is enabled, compile the script, otherwise, hard error!

148--if the script session is enabled, compile the script, otherwise, hard error!

154

149

155readAtomFunc :: FilePath -> AtomFunctionName -> Maybe ScriptSession -> AtomFunctions -> IO AtomFunction

150readAtomFunc :: FilePath -> AtomFunctionName -> Maybe ScriptSession -> AtomFunctions -> IO AtomFunction

151+#if !defined(PM36_HASKELL_SCRIPTING)

152+readAtomFunc _ _ _ _ = error "Haskell scripting is disabled"

153+#else

156readAtomFunc transDir funcName mScriptSession precompiledFuncs = do

154readAtomFunc transDir funcName mScriptSession precompiledFuncs = do

157 let atomFuncPath = atomFuncsPath transDir

155 let atomFuncPath = atomFuncsPath transDir

158− (funcType, mFuncScript) <- B.decodeFile atomFuncPath

156+ (funcType, mFuncScript) <- readFileDeserialise @([AtomType],Maybe T.Text) atomFuncPath

159 case mFuncScript of

157 case mFuncScript of

160 --handle pre-compiled case- pull it from the precompiled list

158 --handle pre-compiled case- pull it from the precompiled list

161 Nothing -> case atomFunctionForName funcName precompiledFuncs of

159 Nothing -> case atomFunctionForName funcName precompiledFuncs of

@@ -163,7 +161,8 @@ readAtomFunc transDir funcName mScriptSession precompiledFuncs = do

163 Left _ -> error ("expected precompiled atom function: " ++ T.unpack funcName)

161 Left _ -> error ("expected precompiled atom function: " ++ T.unpack funcName)

164 Right realFunc -> pure realFunc

162 Right realFunc -> pure realFunc

165 --handle a real Haskell scripted function- compile and load

163 --handle a real Haskell scripted function- compile and load

166− Just funcScript ->

164+ Just funcScript ->

165+

167 case mScriptSession of

166 case mScriptSession of

168 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

167 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

169 Just scriptSession -> do

168 Just scriptSession -> do

@@ -176,6 +175,7 @@ readAtomFunc transDir funcName mScriptSession precompiledFuncs = do

176 Right compiledScript -> pure AtomFunction { atomFuncName = funcName,

175 Right compiledScript -> pure AtomFunction { atomFuncName = funcName,

177 atomFuncType = funcType,

176 atomFuncType = funcType,

178 atomFuncBody = AtomFunctionBody (Just funcScript) compiledScript }

177 atomFuncBody = AtomFunctionBody (Just funcScript) compiledScript }

178+#endif

179

180

181writeDBCFuncs :: DiskSync -> FilePath -> DatabaseContextFunctions -> IO ()

@@ -184,40 +184,48 @@ writeDBCFuncs sync transDir funcs = mapM_ (writeDBCFunc sync transDir) (HS.toLis

184writeDBCFunc :: DiskSync -> FilePath -> DatabaseContextFunction -> IO ()

185writeDBCFunc sync transDir func = do

186 let dbcFuncPath = dbcFuncsDir transDir </> T.unpack (dbcFuncName func)

187− writeBSFileSync sync dbcFuncPath (B.encode (dbcFuncType func, databaseContextFunctionScript func))

187+ writeBSFileSync sync dbcFuncPath (serialise (dbcFuncType func, databaseContextFunctionScript func))

188

189readDBCFuncs :: FilePath -> Maybe ScriptSession -> IO DatabaseContextFunctions

190readDBCFuncs transDir mScriptSession = do

191 funcNames <- getDirectoryNames (dbcFuncsDir transDir)

192 --only Haskell script functions can be serialized

193 --we always return the pre-compiled functions

194− funcs <- mapM ((\name -> readDBCFunc transDir name mScriptSession precompiledDatabaseContextFunctions) . T.pack) funcNames

194+ let funcs = mapM ((\name -> readDBCFunc transDir name mScriptSession precompiledDatabaseContextFunctions) . T.pack) funcNames

195− return $ HS.union basicDatabaseContextFunctions (HS.fromList funcs)

195+ HS.union basicDatabaseContextFunctions . HS.fromList <$> funcs

196

197−readDBCFunc :: FilePath -> DatabaseContextFunctionName -> Maybe ScriptSession -> DatabaseContextFunctions -> IO DatabaseContextFunction

197+readDBCFunc :: FilePath -> DatabaseContextFunctionName -> Maybe ScriptSession -> DatabaseContextFunctions -> IO DatabaseContextFunction

198+#if !defined(PM36_HASKELL_SCRIPTING)

199+readDBCFunc transDir funcName _ precompiledFuncs = do

200+#else

198readDBCFunc transDir funcName mScriptSession precompiledFuncs = do

201readDBCFunc transDir funcName mScriptSession precompiledFuncs = do

202+#endif

199 let dbcFuncPath = dbcFuncsDir transDir </> T.unpack funcName

203 let dbcFuncPath = dbcFuncsDir transDir </> T.unpack funcName

200− (funcType, mFuncScript) <- B.decodeFile dbcFuncPath

204+ (_funcType, mFuncScript) <- readFileDeserialise @([AtomType], Maybe T.Text) dbcFuncPath

201 case mFuncScript of

205 case mFuncScript of

202 Nothing -> case databaseContextFunctionForName funcName precompiledFuncs of

206 Nothing -> case databaseContextFunctionForName funcName precompiledFuncs of

203 Left _ -> error ("expected precompiled dbc function: " ++ T.unpack funcName)

207 Left _ -> error ("expected precompiled dbc function: " ++ T.unpack funcName)

204 Right realFunc -> pure realFunc --return precompiled function

208 Right realFunc -> pure realFunc --return precompiled function

205− Just funcScript ->

209+ Just _funcScript ->

210+#ifdef PM36_HASKELL_SCRIPTING

206 case mScriptSession of

211 case mScriptSession of

207 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

212 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

208 Just scriptSession -> do

213 Just scriptSession -> do

209 eCompiledScript <- runGhc (Just libdir) $ do

214 eCompiledScript <- runGhc (Just libdir) $ do

210 setSession (hscEnv scriptSession)

215 setSession (hscEnv scriptSession)

211− compileScript (dbcFunctionBodyType scriptSession) funcScript

216+ compileScript (dbcFunctionBodyType scriptSession) _funcScript

212 case eCompiledScript of

217 case eCompiledScript of

213 Left err -> throwIO err

218 Left err -> throwIO err

214 Right compiledScript -> pure DatabaseContextFunction { dbcFuncName = funcName,

219 Right compiledScript -> pure DatabaseContextFunction { dbcFuncName = funcName,

215− dbcFuncType = funcType,

220+ dbcFuncType = _funcType,

216− dbcFuncBody = DatabaseContextFunctionBody (Just funcScript) compiledScript}

221+ dbcFuncBody = DatabaseContextFunctionBody (Just _funcScript) compiledScript}

222+#else

223+ error "Haskell scripting is disabled"

224+#endif

217

225

218writeIncDep :: DiskSync -> FilePath -> (IncDepName, InclusionDependency) -> IO ()

226writeIncDep :: DiskSync -> FilePath -> (IncDepName, InclusionDependency) -> IO ()

219writeIncDep sync transDir (incDepName, incDep) =

227writeIncDep sync transDir (incDepName, incDep) =

220− writeBSFileSync sync (incDepsDir transDir </> T.unpack incDepName) $ B.encode incDep

228+ writeBSFileSync sync (incDepsDir transDir </> T.unpack incDepName) $ serialise incDep

221

229

222writeIncDeps :: DiskSync -> FilePath -> M.Map IncDepName InclusionDependency -> IO ()

230writeIncDeps :: DiskSync -> FilePath -> M.Map IncDepName InclusionDependency -> IO ()

223writeIncDeps sync transDir incdeps = mapM_ (writeIncDep sync transDir) $ M.toList incdeps

231writeIncDeps sync transDir incdeps = mapM_ (writeIncDep sync transDir) $ M.toList incdeps

@@ -225,33 +233,32 @@ writeIncDeps sync transDir incdeps = mapM_ (writeIncDep sync transDir) $ M.toLis

225readIncDep :: FilePath -> IncDepName -> IO (IncDepName, InclusionDependency)

233readIncDep :: FilePath -> IncDepName -> IO (IncDepName, InclusionDependency)

226readIncDep transDir incdepName = do

234readIncDep transDir incdepName = do

227 let incDepPath = incDepsDir transDir </> T.unpack incdepName

235 let incDepPath = incDepsDir transDir </> T.unpack incdepName

228− incDepData <- B.decodeFile incDepPath

236+ incDepData <- readFileDeserialise incDepPath

229 pure (incdepName, incDepData)

237 pure (incdepName, incDepData)

230

238

231readIncDeps :: FilePath -> IO (M.Map IncDepName InclusionDependency)

239readIncDeps :: FilePath -> IO (M.Map IncDepName InclusionDependency)

232readIncDeps transDir = do

240readIncDeps transDir = do

233 let incDepsPath = incDepsDir transDir

241 let incDepsPath = incDepsDir transDir

234 incDepNames <- getDirectoryNames incDepsPath

242 incDepNames <- getDirectoryNames incDepsPath

235− incDeps <- mapM (readIncDep transDir . T.pack) incDepNames

243+ M.fromList <$> mapM (readIncDep transDir . T.pack) incDepNames

236− return $ M.fromList incDeps

237

244

238readSubschemas :: FilePath -> IO Subschemas

245readSubschemas :: FilePath -> IO Subschemas

239readSubschemas transDir = do

246readSubschemas transDir = do

240 let sschemasPath = subschemasPath transDir

247 let sschemasPath = subschemasPath transDir

241− B.decodeFile sschemasPath

248+ readFileDeserialise sschemasPath

242

249

243writeSubschemas :: DiskSync -> FilePath -> Subschemas -> IO ()

250writeSubschemas :: DiskSync -> FilePath -> Subschemas -> IO ()

244writeSubschemas sync transDir sschemas = do

251writeSubschemas sync transDir sschemas = do

245 let sschemasPath = subschemasPath transDir

252 let sschemasPath = subschemasPath transDir

246− writeBSFileSync sync sschemasPath (B.encode sschemas)

253+ writeBSFileSync sync sschemasPath (serialise sschemas)

247

254

248writeTypeConstructorMapping :: DiskSync -> FilePath -> TypeConstructorMapping -> IO ()

255writeTypeConstructorMapping :: DiskSync -> FilePath -> TypeConstructorMapping -> IO ()

249writeTypeConstructorMapping sync path types = let atPath = typeConsPath path in

256writeTypeConstructorMapping sync path types = let atPath = typeConsPath path in

250− writeBSFileSync sync atPath $ B.encode types

257+ writeBSFileSync sync atPath $ serialise types

251

258

252readTypeConstructorMapping :: FilePath -> IO TypeConstructorMapping

259readTypeConstructorMapping :: FilePath -> IO TypeConstructorMapping

253readTypeConstructorMapping path = do

260readTypeConstructorMapping path = do

254 let atPath = typeConsPath path

261 let atPath = typeConsPath path

255− B.decodeFile atPath

262+ readFileDeserialise atPath

263+

256

264

257−

src/lib/ProjectM36/Transaction/Type.hsnew file+8

@@ -0,0 +1,8 @@

1+module ProjectM36.Transaction where

2+import ProjectM36.Base

4+uid :: Transaction -> TransactionId

5+uid (Transaction uid _ _) = uid

7+info :: Transaction -> TransactionInfo

8+info (Transaction _ info _) = info

src/lib/ProjectM36/TransactionDiffs.hsnew file+12

@@ -0,0 +1,12 @@

1+module ProjectM36.TransactionDiffs where

2+import ProjectM36.Base

3+import Data.List.NonEmpty

4+import Data.UUID as U

6+{-

7+root :: TransactionDiffs

8+root = single U.nil NoOperation

10+single :: TransactionId -> TransactionDiffExpr -> TransactionDiffs

11+single tid expr = (tid, expr) :| []

12+-}

src/lib/ProjectM36/TransactionGraph.hs+241−152

@@ -1,46 +1,52 @@

1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}

1+{-# LANGUAGE DeriveGeneric, CPP, FlexibleContexts, DerivingVia #-}

2module ProjectM36.TransactionGraph where

3import ProjectM36.Base

4import ProjectM36.Error

5import ProjectM36.Transaction

6+import ProjectM36.TransactionInfo as TI

6import ProjectM36.Relation

7import ProjectM36.Relation

7import ProjectM36.TupleSet

8import ProjectM36.TupleSet

8import ProjectM36.Tuple

9import ProjectM36.Tuple

9import ProjectM36.RelationalExpression

10import ProjectM36.RelationalExpression

10import ProjectM36.TransactionGraph.Merge

11import ProjectM36.TransactionGraph.Merge

12+import ProjectM36.MerkleHash

11import qualified ProjectM36.DisconnectedTransaction as Discon

13import qualified ProjectM36.DisconnectedTransaction as Discon

14+import qualified ProjectM36.Attribute as A

16+import Codec.Winery

17+import Control.Monad.Except hiding (join)

18+import Control.Monad.Reader hiding (join)

13import qualified Data.Vector as V

19import qualified Data.Vector as V

14−import qualified ProjectM36.Attribute as A

15import qualified Data.UUID as U

20import qualified Data.UUID as U

16import qualified Data.Set as S

21import qualified Data.Set as S

17import qualified Data.Map as M

22import qualified Data.Map as M

18−import Control.Monad

23+import qualified Data.List.NonEmpty as NE

19import Data.Time.Clock

24import Data.Time.Clock

20import qualified Data.Text as T

25import qualified Data.Text as T

21import GHC.Generics

26import GHC.Generics

22−import Data.Binary

23import Data.Either (lefts, rights, isRight)

27import Data.Either (lefts, rights, isRight)

28+#if __GLASGOW_HASKELL__ < 804

24import Data.Monoid

29import Data.Monoid

30+#endif

25import Control.Arrow

31import Control.Arrow

26import Data.Maybe

32import Data.Maybe

27−

33+import Data.UUID.V4

28−{-

34+import qualified Data.ByteString.Lazy as BL

29−--import Debug.Trace

35+import ProjectM36.DatabaseContext as DBC

30−import Control.Monad.Reader

36+import Crypto.Hash.SHA256

31−import qualified ProjectM36.DisconnectedTransaction as D

32−-}

34-- | Record a lookup for a specific transaction in the graph.

38-- | Record a lookup for a specific transaction in the graph.

35data TransactionIdLookup = TransactionIdLookup TransactionId |

39data TransactionIdLookup = TransactionIdLookup TransactionId |

36 TransactionIdHeadNameLookup HeadName [TransactionIdHeadBacktrack]

40 TransactionIdHeadNameLookup HeadName [TransactionIdHeadBacktrack]

37− deriving (Show, Eq, Binary, Generic)

41+ deriving (Show, Eq, Generic)

42+ deriving Serialise via WineryVariant TransactionIdLookup

39-- | Used for git-style head backtracking such as topic~3^2.

44-- | Used for git-style head backtracking such as topic~3^2.

40−data TransactionIdHeadBacktrack = TransactionIdHeadParentBacktrack Int | -- ^ git equivalent of ~: walk back n parents, arbitrarily choosing a parent when a choice must be made

45+data TransactionIdHeadBacktrack = TransactionIdHeadParentBacktrack Int | -- ^ git equivalent of ~v: walk back n parents, arbitrarily choosing a parent when a choice must be made

41 TransactionIdHeadBranchBacktrack Int | -- ^ git equivalent of ^: walk back one parent level to the nth arbitrarily-chosen parent

46 TransactionIdHeadBranchBacktrack Int | -- ^ git equivalent of ^: walk back one parent level to the nth arbitrarily-chosen parent

42 TransactionStampHeadBacktrack UTCTime -- ^ git equivalent of 'git-rev-list -n 1 --before X' find the first transaction which was created before the timestamp

47 TransactionStampHeadBacktrack UTCTime -- ^ git equivalent of 'git-rev-list -n 1 --before X' find the first transaction which was created before the timestamp

43− deriving (Show, Eq, Binary, Generic)

48+ deriving (Show, Eq, Generic)

49+ deriving Serialise via WineryVariant TransactionIdHeadBacktrack

46-- | Operators which manipulate a transaction graph and which transaction the current 'Session' is based upon.

52-- | Operators which manipulate a transaction graph and which transaction the current 'Session' is based upon.

@@ -52,22 +58,32 @@ data TransactionGraphOperator = JumpToHead HeadName |

52 MergeTransactions MergeStrategy HeadName HeadName |

58 MergeTransactions MergeStrategy HeadName HeadName |

53 Commit |

59 Commit |

54 Rollback

60 Rollback

55− deriving (Eq, Show, Binary, Generic)

61+ deriving (Eq, Show, Generic)

62+ deriving Serialise via WineryVariant TransactionGraphOperator

57isCommit :: TransactionGraphOperator -> Bool

64isCommit :: TransactionGraphOperator -> Bool

58isCommit Commit = True

65isCommit Commit = True

59isCommit _ = False

66isCommit _ = False

61−data ROTransactionGraphOperator = ShowGraph

68+data ROTransactionGraphOperator = ShowGraph | ValidateMerkleHashes

62 deriving Show

69 deriving Show

64bootstrapTransactionGraph :: UTCTime -> TransactionId -> DatabaseContext -> TransactionGraph

71bootstrapTransactionGraph :: UTCTime -> TransactionId -> DatabaseContext -> TransactionGraph

65−bootstrapTransactionGraph stamp freshId context = TransactionGraph bootstrapHeads bootstrapTransactions

72+bootstrapTransactionGraph stamp' freshId context = TransactionGraph bootstrapHeads bootstrapTransactions

66 where

73 where

67 bootstrapHeads = M.singleton "master" freshTransaction

74 bootstrapHeads = M.singleton "master" freshTransaction

68 newSchemas = Schemas context M.empty

75 newSchemas = Schemas context M.empty

69− freshTransaction = Transaction freshId (TransactionInfo U.nil S.empty stamp) newSchemas

76+ freshTransaction = fresh freshId stamp' newSchemas

77+ hashedTransaction = Transaction freshId ((transactionInfo freshTransaction) { merkleHash = calculateMerkleHash freshTransaction emptyTransactionGraph }) newSchemas

70− bootstrapTransactions = S.singleton freshTransaction

78+ bootstrapTransactions = S.singleton hashedTransaction

79+

80+-- | Create a transaction graph from a context.

81+freshTransactionGraph :: DatabaseContext -> IO (TransactionGraph, TransactionId)

82+freshTransactionGraph ctx = do

83+ now <- getCurrentTime

84+ freshId <- nextRandom

85+ pure (bootstrapTransactionGraph now freshId ctx, freshId)

86+

72emptyTransactionGraph :: TransactionGraph

88emptyTransactionGraph :: TransactionGraph

73emptyTransactionGraph = TransactionGraph M.empty S.empty

89emptyTransactionGraph = TransactionGraph M.empty S.empty

@@ -86,76 +102,79 @@ headNameForTransaction transaction (TransactionGraph heads _) = if M.null matchi

86 where

102 where

87 matchingTrans = M.filter (transaction ==) heads

103 matchingTrans = M.filter (transaction ==) heads

104

89−transactionForId :: TransactionId -> TransactionGraph -> Either RelationalError Transaction

90−transactionForId tid graph

91− | tid == U.nil =

92− Left RootTransactionTraversalError

93− | S.null matchingTrans =

94− Left $ NoSuchTransactionError tid

95− | otherwise =

96− Right $ head (S.toList matchingTrans)

97− where

98− matchingTrans = S.filter (\(Transaction idMatch _ _) -> idMatch == tid) (transactionsForGraph graph)

99−

100transactionsForIds :: S.Set TransactionId -> TransactionGraph -> Either RelationalError (S.Set Transaction)

105transactionsForIds :: S.Set TransactionId -> TransactionGraph -> Either RelationalError (S.Set Transaction)

101−transactionsForIds idSet graph = do

106+transactionsForIds idSet graph =

102− transList <- forM (S.toList idSet) (`transactionForId` graph)

107+ S.fromList <$> forM (S.toList idSet) (`transactionForId` graph)

103− return (S.fromList transList)

108+

109+-- | A root transaction terminates a graph and has no parents.

110+isRootTransaction :: Transaction -> Bool

111+isRootTransaction trans = parentIds trans == S.singleton U.nil

104

112

105−isRootTransaction :: Transaction -> TransactionGraph -> Bool

113+rootTransactions :: TransactionGraph -> S.Set Transaction

106−isRootTransaction (Transaction _ (TransactionInfo pId _ _) _) _ = U.null pId

114+rootTransactions graph = S.filter isRootTransaction (transactionsForGraph graph)

107−isRootTransaction (Transaction _ MergeTransactionInfo{} _) _ = False

108

115

109-- the first transaction has no parent - all other do have parents- merges have two parents

116-- the first transaction has no parent - all other do have parents- merges have two parents

110parentTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

117parentTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

111−parentTransactions (Transaction _ (TransactionInfo pId _ _) _) graph = do

118+parentTransactions trans = transactionsForIds (parentIds trans)

112− trans <- transactionForId pId graph

113− return (S.singleton trans)

114−

115−parentTransactions (Transaction _ (MergeTransactionInfo pId1 pId2 _ _) _ ) graph = transactionsForIds (S.fromList [pId1, pId2]) graph

116−

117

119

118childTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

120childTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

119−childTransactions (Transaction _ (TransactionInfo _ children _) _) = transactionsForIds children

121+childTransactions trans graph = transactionsForIds childIds graph

120−childTransactions (Transaction _ (MergeTransactionInfo _ _ children _) _) = transactionsForIds children

122+ where

123+ childIds = S.map transactionId (S.filter filt (transactionsForGraph graph))

124+ filt trans' = S.member (transactionId trans) (parentIds trans')

121

125

122-- create a new commit and add it to the heads

126-- create a new commit and add it to the heads

123-- technically, the new head could be added to an existing commit, but by adding a new commit, the new head is unambiguously linked to a new commit (with a context indentical to its parent)

127-- technically, the new head could be added to an existing commit, but by adding a new commit, the new head is unambiguously linked to a new commit (with a context indentical to its parent)

124addBranch :: UTCTime -> TransactionId -> HeadName -> TransactionId -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

128addBranch :: UTCTime -> TransactionId -> HeadName -> TransactionId -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

125−addBranch stamp newId newBranchName branchPointId graph = do

129+addBranch stamp' newId newBranchName branchPointId graph = do

126 parentTrans <- transactionForId branchPointId graph

130 parentTrans <- transactionForId branchPointId graph

127− let newTrans = Transaction newId (TransactionInfo branchPointId S.empty stamp) (schemas parentTrans)

131+ let newTrans = Transaction newId (TI.singleParent branchPointId stamp') (schemas parentTrans)

128 addTransactionToGraph newBranchName newTrans graph

132 addTransactionToGraph newBranchName newTrans graph

129

133

130--adds a disconnected transaction to a transaction graph at some head

134--adds a disconnected transaction to a transaction graph at some head

131addDisconnectedTransaction :: UTCTime -> TransactionId -> HeadName -> DisconnectedTransaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

135addDisconnectedTransaction :: UTCTime -> TransactionId -> HeadName -> DisconnectedTransaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

132−addDisconnectedTransaction stamp newId headName (DisconnectedTransaction parentId schemas' _) = addTransactionToGraph headName (Transaction newId (TransactionInfo parentId S.empty stamp) schemas')

136+addDisconnectedTransaction stamp' newId headName (DisconnectedTransaction parentId schemas' _) graph = addTransactionToGraph headName newTrans' graph

133−

137+ where

134−

138+ newTrans = Transaction newId newTInfo schemas'

139+ newTInfo = TI.singleParent parentId stamp'

140+ newTrans' = Transaction newId (newTInfo { merkleHash = newHash }) schemas'

141+ newHash = calculateMerkleHash newTrans graph--lookup parents in graph to calculate

142+--LOOP

135addTransactionToGraph :: HeadName -> Transaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

143addTransactionToGraph :: HeadName -> Transaction -> TransactionGraph -> Either RelationalError (Transaction, TransactionGraph)

136addTransactionToGraph headName newTrans graph = do

144addTransactionToGraph headName newTrans graph = do

137− let parentIds = transactionParentIds newTrans

145+ let parentIds' = parentIds newTrans

138− childIds = transactionChildIds newTrans

139 newId = transactionId newTrans

146 newId = transactionId newTrans

140 validateIds ids = mapM (`transactionForId` graph) (S.toList ids)

147 validateIds ids = mapM (`transactionForId` graph) (S.toList ids)

141− addChildTransaction trans = transactionSetChildren trans (S.insert newId (transactionChildIds trans))

148+ childTs <- childTransactions newTrans graph

142 --validate that the parent transactions are in the graph

149 --validate that the parent transactions are in the graph

143− _ <- validateIds parentIds

150+ _ <- validateIds parentIds'

144− when (S.size parentIds < 1) (Left $ NewTransactionMissingParentError newId)

151+ when (S.size parentIds' < 1) (Left $ NewTransactionMissingParentError newId)

145 --if the headName already exists, ensure that it refers to a parent

152 --if the headName already exists, ensure that it refers to a parent

146 case transactionForHead headName graph of

153 case transactionForHead headName graph of

147 Nothing -> pure () -- any headName is OK

154 Nothing -> pure () -- any headName is OK

148− Just trans -> when (S.notMember (transactionId trans) parentIds) (Left (HeadNameSwitchingHeadProhibitedError headName))

155+ Just trans -> when (S.notMember (transactionId trans) parentIds') (Left (HeadNameSwitchingHeadProhibitedError headName))

149 --validate that the transaction has no children

156 --validate that the transaction has no children

150− unless (S.null childIds) (Left $ NewTransactionMayNotHaveChildrenError newId)

157+ unless (S.null childTs) (Left $ NewTransactionMayNotHaveChildrenError newId)

151 --validate that the trasaction's id is unique

158 --validate that the trasaction's id is unique

152 when (isRight (transactionForId newId graph)) (Left (TransactionIdInUseError newId))

159 when (isRight (transactionForId newId graph)) (Left (TransactionIdInUseError newId))

153− --update the parent transactions to point to the new transaction

160+ --replace all references to UncommittedTransactionMarker to new transaction id

154− parents <- mapM (`transactionForId` graph) (S.toList parentIds)

161+ let newTrans' = newTransUncommittedReplace newTrans

155− let updatedParents = S.map addChildTransaction (S.fromList parents)

156− updatedTransSet = S.insert newTrans (S.union updatedParents (transactionsForGraph graph))

162+ updatedTransSet = S.insert newTrans' (transactionsForGraph graph)

157− updatedHeads = M.insert headName newTrans (transactionHeadsForGraph graph)

163+ updatedHeads = M.insert headName newTrans' (transactionHeadsForGraph graph)

158− pure (newTrans, TransactionGraph updatedHeads updatedTransSet)

164+ pure (newTrans', TransactionGraph updatedHeads updatedTransSet)

165+

166+--replace all occurrences of the uncommitted context marker

167+newTransUncommittedReplace :: Transaction -> Transaction

168+newTransUncommittedReplace trans@(Transaction tid tinfo (Schemas ctx sschemas)) =

169+ Transaction tid tinfo (Schemas fixedContext sschemas)

170+ where

171+ uncommittedReplace UncommittedContextMarker = TransactionMarker tid

172+ uncommittedReplace marker = marker

173+ relvars = relationVariables (concreteDatabaseContext trans)

174+ fixedRelvars = M.map (fmap uncommittedReplace) relvars

175+ fixedContext = ctx { relationVariables = fixedRelvars }

176+

177+

159

178

160validateGraph :: TransactionGraph -> Maybe [RelationalError]

179validateGraph :: TransactionGraph -> Maybe [RelationalError]

161validateGraph graph@(TransactionGraph _ transSet) = do

180validateGraph graph@(TransactionGraph _ transSet) = do

@@ -164,7 +183,7 @@ validateGraph graph@(TransactionGraph _ transSet) = do

164 --uuids = map transactionId transSet

183 --uuids = map transactionId transSet

165 --check that all heads appear in the transSet

184 --check that all heads appear in the transSet

166 --check that all forward and backward links are in place

185 --check that all forward and backward links are in place

167− _ <- mapM (walkParentTransactions S.empty graph) (S.toList transSet)

186+ mapM_ (walkParentTransactions S.empty graph) (S.toList transSet)

168 mapM (walkChildTransactions S.empty graph) (S.toList transSet)

187 mapM (walkChildTransactions S.empty graph) (S.toList transSet)

169

188

170--verify that all parent links exist and that all children exist

189--verify that all parent links exist and that all children exist

@@ -227,7 +246,7 @@ evalGraphOp _ _ discon graph (WalkBackToTime backTime) = do

227 case transactionForId jumpDest graph of

246 case transactionForId jumpDest graph of

228 Left err -> Left err

247 Left err -> Left err

229 Right trans -> do

248 Right trans -> do

230− let disconnectedTrans = DisconnectedTransaction (transactionId trans) (schemas trans) False

249+ let disconnectedTrans = Discon.freshTransaction (transactionId trans) (schemas trans)

231 Right (disconnectedTrans, graph)

250 Right (disconnectedTrans, graph)

232

251

233-- add new head pointing to branchPoint

252-- add new head pointing to branchPoint

@@ -245,15 +264,15 @@ evalGraphOp newId discon@(DisconnectedTransaction parentId disconContext) graph

245

264

246-- create a new commit and add it to the heads

265-- create a new commit and add it to the heads

247-- technically, the new head could be added to an existing commit, but by adding a new commit, the new head is unambiguously linked to a new commit (with a context indentical to its parent)

266-- technically, the new head could be added to an existing commit, but by adding a new commit, the new head is unambiguously linked to a new commit (with a context indentical to its parent)

248−evalGraphOp stamp newId (DisconnectedTransaction parentId schemas' _) graph (Branch newBranchName) = do

267+evalGraphOp stamp' newId (DisconnectedTransaction parentId schemas' _) graph (Branch newBranchName) = do

249− let newDiscon = DisconnectedTransaction newId schemas' False

268+ let newDiscon = Discon.freshTransaction newId schemas'

250− case addBranch stamp newId newBranchName parentId graph of

269+ case addBranch stamp' newId newBranchName parentId graph of

251 Left err -> Left err

270 Left err -> Left err

252 Right (_, newGraph) -> Right (newDiscon, newGraph)

271 Right (_, newGraph) -> Right (newDiscon, newGraph)

253

272

254-- add the disconnected transaction to the graph

273-- add the disconnected transaction to the graph

255-- affects graph and disconnectedtransaction- the new disconnectedtransaction's parent is the freshly committed transaction

274-- affects graph and disconnectedtransaction- the new disconnectedtransaction's parent is the freshly committed transaction

256−evalGraphOp stamp newTransId discon@(DisconnectedTransaction parentId schemas' _) graph Commit = case transactionForId parentId graph of

275+evalGraphOp stamp' newTransId discon@(DisconnectedTransaction parentId schemas' _) graph Commit = case transactionForId parentId graph of

257 Left err -> Left err

276 Left err -> Left err

258 Right parentTransaction -> case headNameForTransaction parentTransaction graph of

277 Right parentTransaction -> case headNameForTransaction parentTransaction graph of

259 Nothing -> Left $ TransactionIsNotAHeadError parentId

278 Nothing -> Left $ TransactionIsNotAHeadError parentId

@@ -261,17 +280,20 @@ evalGraphOp stamp newTransId discon@(DisconnectedTransaction parentId schemas' _

261 Left err-> Left err

280 Left err-> Left err

262 Right (_, updatedGraph) -> Right (newDisconnectedTrans, updatedGraph)

281 Right (_, updatedGraph) -> Right (newDisconnectedTrans, updatedGraph)

263 where

282 where

264− newDisconnectedTrans = DisconnectedTransaction newTransId schemas' False

283+ newDisconnectedTrans = Discon.freshTransaction newTransId schemas'

265− maybeUpdatedGraph = addDisconnectedTransaction stamp newTransId headName discon graph

284+ maybeUpdatedGraph = addDisconnectedTransaction stamp' newTransId headName discon graph

266

285

267-- refresh the disconnected transaction, return the same graph

286-- refresh the disconnected transaction, return the same graph

268evalGraphOp _ _ (DisconnectedTransaction parentId _ _) graph Rollback = case transactionForId parentId graph of

287evalGraphOp _ _ (DisconnectedTransaction parentId _ _) graph Rollback = case transactionForId parentId graph of

269 Left err -> Left err

288 Left err -> Left err

270 Right parentTransaction -> Right (newDiscon, graph)

289 Right parentTransaction -> Right (newDiscon, graph)

271 where

290 where

272− newDiscon = DisconnectedTransaction parentId (schemas parentTransaction) False

291+ newDiscon = Discon.freshTransaction parentId (schemas parentTransaction)

273

292

274−evalGraphOp stamp newId (DisconnectedTransaction parentId _ _) graph (MergeTransactions mergeStrategy headNameA headNameB) = mergeTransactions stamp newId parentId mergeStrategy (headNameA, headNameB) graph

293+evalGraphOp stamp' newId (DisconnectedTransaction parentId _ _) graph (MergeTransactions mergeStrategy headNameA headNameB) =

294+ runGraphRefRelationalExprM env $ mergeTransactions stamp' newId parentId mergeStrategy (headNameA, headNameB)

295+ where

296+ env = freshGraphRefRelationalExprEnv Nothing graph

275

297

276evalGraphOp _ _ discon graph@(TransactionGraph graphHeads transSet) (DeleteBranch branchName) = case transactionForHead branchName graph of

298evalGraphOp _ _ discon graph@(TransactionGraph graphHeads transSet) (DeleteBranch branchName) = case transactionForHead branchName graph of

277 Nothing -> Left (NoSuchHeadNameError branchName)

299 Nothing -> Left (NoSuchHeadNameError branchName)

@@ -284,6 +306,7 @@ graphAsRelation (DisconnectedTransaction parentId _ _) graph@(TransactionGraph _

284 mkRelationFromList attrs tupleMatrix

306 mkRelationFromList attrs tupleMatrix

285 where

307 where

286 attrs = A.attributesFromList [Attribute "id" TextAtomType,

308 attrs = A.attributesFromList [Attribute "id" TextAtomType,

309+ Attribute "hash" ByteStringAtomType,

287 Attribute "stamp" DateTimeAtomType,

310 Attribute "stamp" DateTimeAtomType,

288 Attribute "parents" (RelationAtomType parentAttributes),

311 Attribute "parents" (RelationAtomType parentAttributes),

289 Attribute "current" BoolAtomType,

312 Attribute "current" BoolAtomType,

@@ -293,7 +316,8 @@ graphAsRelation (DisconnectedTransaction parentId _ _) graph@(TransactionGraph _

293 tupleGenerator transaction = case transactionParentsRelation transaction graph of

316 tupleGenerator transaction = case transactionParentsRelation transaction graph of

294 Left err -> Left err

317 Left err -> Left err

295 Right parentTransRel -> Right [TextAtom $ T.pack $ show (transactionId transaction),

318 Right parentTransRel -> Right [TextAtom $ T.pack $ show (transactionId transaction),

319+ ByteStringAtom $ _unMerkleHash (merkleHash (transactionInfo transaction)),

296− DateTimeAtom (transactionTimestamp transaction),

320+ DateTimeAtom (timestamp transaction),

297 RelationAtom parentTransRel,

321 RelationAtom parentTransRel,

298 BoolAtom $ parentId == transactionId transaction,

322 BoolAtom $ parentId == transactionId transaction,

299 TextAtom $ fromMaybe "" (headNameForTransaction transaction graph)

323 TextAtom $ fromMaybe "" (headNameForTransaction transaction graph)

@@ -301,7 +325,7 @@ graphAsRelation (DisconnectedTransaction parentId _ _) graph@(TransactionGraph _

301

325

302transactionParentsRelation :: Transaction -> TransactionGraph -> Either RelationalError Relation

326transactionParentsRelation :: Transaction -> TransactionGraph -> Either RelationalError Relation

303transactionParentsRelation trans graph =

327transactionParentsRelation trans graph =

304− if isRootTransaction trans graph then

328+ if isRootTransaction trans then

305 mkRelation attrs emptyTupleSet

329 mkRelation attrs emptyTupleSet

306 else do

330 else do

307 parentTransSet <- parentTransactions trans graph

331 parentTransSet <- parentTransactions trans graph

@@ -320,39 +344,47 @@ evalROGraphOp discon graph ShowGraph = do

320-}

344-}

321

345

322-- | Execute the merge strategy against the transactions, returning a new transaction which can be then added to the transaction graph

346-- | Execute the merge strategy against the transactions, returning a new transaction which can be then added to the transaction graph

323−createMergeTransaction :: UTCTime -> TransactionId -> MergeStrategy -> TransactionGraph -> (Transaction, Transaction) -> Either MergeError Transaction

347+createMergeTransaction :: UTCTime -> TransactionId -> MergeStrategy -> (Transaction, Transaction) -> GraphRefRelationalExprM Transaction

324−createMergeTransaction stamp newId (SelectedBranchMergeStrategy selectedBranch) graph t2@(trans1, trans2) = do

348+createMergeTransaction stamp' newId (SelectedBranchMergeStrategy selectedBranch) t2@(trans1, trans2) = do

349+ graph <- gfGraph

325 selectedTrans <- validateHeadName selectedBranch graph t2

350 selectedTrans <- validateHeadName selectedBranch graph t2

326− pure $ Transaction newId (MergeTransactionInfo (transactionId trans1) (transactionId trans2) S.empty stamp) (schemas selectedTrans)

351+ pure $ addMerkleHash graph $

352+ Transaction newId (TransactionInfo {

353+ parents = NE.fromList [transactionId trans1,

354+ transactionId trans2],

355+ stamp = stamp',

356+ merkleHash = mempty }) (schemas selectedTrans)

327

357

328-- merge functions, relvars, individually

358-- merge functions, relvars, individually

329−createMergeTransaction stamp newId strat@UnionMergeStrategy graph t2 = createUnionMergeTransaction stamp newId strat graph t2

359+createMergeTransaction stamp' newId strat@UnionMergeStrategy t2 =

360+ createUnionMergeTransaction stamp' newId strat t2

330

361

331-- merge function, relvars, but, on error, just take the component from the preferred branch

362-- merge function, relvars, but, on error, just take the component from the preferred branch

332−createMergeTransaction stamp newId strat@(UnionPreferMergeStrategy _) graph t2 = createUnionMergeTransaction stamp newId strat graph t2

363+createMergeTransaction stamp' newId strat@(UnionPreferMergeStrategy _) t2 =

364+ createUnionMergeTransaction stamp' newId strat t2

333

365

334-- | Returns the correct Transaction for the branch name in the graph and ensures that it is one of the two transaction arguments in the tuple.

366-- | Returns the correct Transaction for the branch name in the graph and ensures that it is one of the two transaction arguments in the tuple.

335−validateHeadName :: HeadName -> TransactionGraph -> (Transaction, Transaction) -> Either MergeError Transaction

367+validateHeadName :: HeadName -> TransactionGraph -> (Transaction, Transaction) -> GraphRefRelationalExprM Transaction

336validateHeadName headName graph (t1, t2) =

368validateHeadName headName graph (t1, t2) =

337 case transactionForHead headName graph of

369 case transactionForHead headName graph of

338− Nothing -> Left SelectedHeadMismatchMergeError

370+ Nothing -> throwError (MergeTransactionError SelectedHeadMismatchMergeError)

339 Just trans -> if trans /= t1 && trans /= t2 then

371 Just trans -> if trans /= t1 && trans /= t2 then

340− Left SelectedHeadMismatchMergeError

372+ throwError (MergeTransactionError SelectedHeadMismatchMergeError)

341 else

373 else

342− Right trans

374+ pure trans

343

375

344-- Algorithm: start at one transaction and work backwards up the parents. If there is a node we have not yet visited as a child, then walk that up to its head. If that branch contains the goal transaction, then we have completed a valid subgraph traversal.

376-- Algorithm: start at one transaction and work backwards up the parents. If there is a node we have not yet visited as a child, then walk that up to its head. If that branch contains the goal transaction, then we have completed a valid subgraph traversal.

345subGraphOfFirstCommonAncestor :: TransactionGraph -> TransactionHeads -> Transaction -> Transaction -> S.Set Transaction -> Either RelationalError TransactionGraph

377subGraphOfFirstCommonAncestor :: TransactionGraph -> TransactionHeads -> Transaction -> Transaction -> S.Set Transaction -> Either RelationalError TransactionGraph

346−subGraphOfFirstCommonAncestor origGraph resultHeads currentTrans goalTrans traverseSet = do

378+subGraphOfFirstCommonAncestor origGraph resultHeads currentTrans' goalTrans traverseSet = do

347− let currentid = transactionId currentTrans

379+ let currentid = transactionId currentTrans'

348 goalid = transactionId goalTrans

380 goalid = transactionId goalTrans

349− if currentTrans == goalTrans then

381+ if currentTrans' == goalTrans then

350 Right (TransactionGraph resultHeads traverseSet) -- add filter

382 Right (TransactionGraph resultHeads traverseSet) -- add filter

351 --catch root transaction to improve error?

383 --catch root transaction to improve error?

352 else do

384 else do

353− currentTransChildren <- S.fromList <$> mapM (`transactionForId` origGraph) (S.toList (transactionChildIds currentTrans))

385+ currentTransChildren <- childTransactions currentTrans' origGraph

354− let searchChildren = S.difference (S.insert currentTrans traverseSet) currentTransChildren

386+ let searchChildren = S.difference (S.insert currentTrans' traverseSet) currentTransChildren

355− searchChild start = pathToTransaction origGraph start goalTrans (S.insert currentTrans traverseSet)

387+ searchChild start' = pathToTransaction origGraph start' goalTrans (S.insert currentTrans' traverseSet)

356 childSearches = map searchChild (S.toList searchChildren)

388 childSearches = map searchChild (S.toList searchChildren)

357 errors = lefts childSearches

389 errors = lefts childSearches

358 pathsFound = rights childSearches

390 pathsFound = rights childSearches

@@ -361,17 +393,16 @@ subGraphOfFirstCommonAncestor origGraph resultHeads currentTrans goalTrans trave

361 unless (null realErrors) (Left (head realErrors))

393 unless (null realErrors) (Left (head realErrors))

362 -- if no paths found, search the parent

394 -- if no paths found, search the parent

363 if null pathsFound then

395 if null pathsFound then

364− case oneParent currentTrans of

396+ case oneParent currentTrans' of

365 Left RootTransactionTraversalError -> Left (NoCommonTransactionAncestorError currentid goalid)

397 Left RootTransactionTraversalError -> Left (NoCommonTransactionAncestorError currentid goalid)

366 Left err -> Left err

398 Left err -> Left err

367 Right currentTransParent ->

399 Right currentTransParent ->

368− subGraphOfFirstCommonAncestor origGraph resultHeads currentTransParent goalTrans (S.insert currentTrans traverseSet)

400+ subGraphOfFirstCommonAncestor origGraph resultHeads currentTransParent goalTrans (S.insert currentTrans' traverseSet)

369 else -- we found a path

401 else -- we found a path

370 Right (TransactionGraph resultHeads (S.unions (traverseSet : pathsFound)))

402 Right (TransactionGraph resultHeads (S.unions (traverseSet : pathsFound)))

371 where

403 where

372− oneParent (Transaction _ (TransactionInfo parentId _ _) _) = transactionForId parentId origGraph

404+ oneParent (Transaction _ tinfo _) = transactionForId (NE.head (parents tinfo)) origGraph

373− oneParent (Transaction _ (MergeTransactionInfo parentId _ _ _) _) = transactionForId parentId origGraph

405+

374−

375-- | Search from a past graph point to all following heads for a specific transaction. If found, return the transaction path, otherwise a RelationalError.

406-- | Search from a past graph point to all following heads for a specific transaction. If found, return the transaction path, otherwise a RelationalError.

376pathToTransaction :: TransactionGraph -> Transaction -> Transaction -> S.Set Transaction -> Either RelationalError (S.Set Transaction)

407pathToTransaction :: TransactionGraph -> Transaction -> Transaction -> S.Set Transaction -> Either RelationalError (S.Set Transaction)

377pathToTransaction graph currentTransaction targetTransaction accumTransSet = do

408pathToTransaction graph currentTransaction targetTransaction accumTransSet = do

@@ -379,11 +410,11 @@ pathToTransaction graph currentTransaction targetTransaction accumTransSet = do

379 if transactionId targetTransaction == transactionId currentTransaction then

410 if transactionId targetTransaction == transactionId currentTransaction then

380 Right accumTransSet

411 Right accumTransSet

381 else do

412 else do

382− currentTransChildren <- mapM (`transactionForId` graph) (S.toList (transactionChildIds currentTransaction))

413+ currentTransChildren <- childTransactions currentTransaction graph

383 if null currentTransChildren then

414 if null currentTransChildren then

384 Left (FailedToFindTransactionError targetId)

415 Left (FailedToFindTransactionError targetId)

385 else do

416 else do

386− let searches = map (\t -> pathToTransaction graph t targetTransaction (S.insert t accumTransSet)) currentTransChildren

417+ let searches = map (\t -> pathToTransaction graph t targetTransaction (S.insert t accumTransSet)) (S.toList currentTransChildren)

387 let realErrors = filter (/= FailedToFindTransactionError targetId) (lefts searches)

418 let realErrors = filter (/= FailedToFindTransactionError targetId) (lefts searches)

388 paths = rights searches

419 paths = rights searches

389 if not (null realErrors) then -- found some real errors

420 if not (null realErrors) then -- found some real errors

@@ -393,35 +424,39 @@ pathToTransaction graph currentTransaction targetTransaction accumTransSet = do

393 else --we have some paths!

424 else --we have some paths!

394 Right (S.unions paths)

425 Right (S.unions paths)

395

426

396−mergeTransactions :: UTCTime -> TransactionId -> TransactionId -> MergeStrategy -> (HeadName, HeadName) -> TransactionGraph -> Either RelationalError (DisconnectedTransaction, TransactionGraph)

427+mergeTransactions :: UTCTime -> TransactionId -> TransactionId -> MergeStrategy -> (HeadName, HeadName) -> GraphRefRelationalExprM (DisconnectedTransaction, TransactionGraph)

397−mergeTransactions stamp newId parentId mergeStrategy (headNameA, headNameB) graph = do

428+mergeTransactions stamp' newId parentId mergeStrategy (headNameA, headNameB) = do

429+ graph <- gfGraph

398 let transactionForHeadErr name = case transactionForHead name graph of

430 let transactionForHeadErr name = case transactionForHead name graph of

399− Nothing -> Left (NoSuchHeadNameError name)

431+ Nothing -> throwError (NoSuchHeadNameError name)

400− Just t -> Right t

432+ Just t -> pure t

433+ runE e = case e of

434+ Left e' -> throwError e'

435+ Right v -> pure v

401− transA <- transactionForHeadErr headNameA

436+ transA <- transactionForHeadErr headNameA

402− transB <- transactionForHeadErr headNameB

437+ transB <- transactionForHeadErr headNameB

403− disconParent <- transactionForId parentId graph

438+ disconParent <- gfTransForId parentId

404− let subHeads = M.filterWithKey (\k _ -> elem k [headNameA, headNameB]) (transactionHeadsForGraph graph)

439+ let subHeads = M.filterWithKey (\k _ -> k `elem` [headNameA, headNameB]) (transactionHeadsForGraph graph)

405− subGraph <- subGraphOfFirstCommonAncestor graph subHeads transA transB S.empty

440+ subGraph <- runE $ subGraphOfFirstCommonAncestor graph subHeads transA transB S.empty

406− subGraph' <- filterSubGraph subGraph subHeads

441+ subGraph' <- runE $ filterSubGraph subGraph subHeads

407− case createMergeTransaction stamp newId mergeStrategy subGraph' (transA, transB) of

442+ mergedTrans <- local (const (freshGraphRefRelationalExprEnv Nothing subGraph')) $ createMergeTransaction stamp' newId mergeStrategy (transA, transB)

408− Left err -> Left (MergeTransactionError err)

409− Right mergedTrans -> case checkConstraints (concreteDatabaseContext mergedTrans) of

410− Just err -> Left err

411− Nothing -> case headNameForTransaction disconParent graph of

443+ case headNameForTransaction disconParent graph of

412− Nothing -> Left (TransactionIsNotAHeadError parentId)

444+ Nothing -> throwError (TransactionIsNotAHeadError parentId)

413 Just headName -> do

445 Just headName -> do

414− (newTrans, newGraph) <- addTransactionToGraph headName mergedTrans graph

446+ (newTrans, newGraph) <- runE $ addTransactionToGraph headName mergedTrans graph

447+ case checkConstraints (concreteDatabaseContext mergedTrans) newId graph of

448+ Left err -> throwError err

449+ Right _ -> do

415− let newGraph' = TransactionGraph (transactionHeadsForGraph newGraph) (transactionsForGraph newGraph)

450+ let newGraph' = TransactionGraph (transactionHeadsForGraph newGraph) (transactionsForGraph newGraph)

416− newDiscon = DisconnectedTransaction newId (schemas newTrans) False

451+ newDiscon = Discon.freshTransaction newId (schemas newTrans)

417− pure (newDiscon, newGraph')

452+ pure (newDiscon, newGraph')

418

453

419--TEMPORARY COPY/PASTE

454--TEMPORARY COPY/PASTE

420showTransactionStructureX :: Transaction -> TransactionGraph -> String

455showTransactionStructureX :: Transaction -> TransactionGraph -> String

421showTransactionStructureX trans graph = headInfo ++ " " ++ show (transactionId trans) ++ " " ++ parentTransactionsInfo

456showTransactionStructureX trans graph = headInfo ++ " " ++ show (transactionId trans) ++ " " ++ parentTransactionsInfo

422 where

457 where

423 headInfo = maybe "" show (headNameForTransaction trans graph)

458 headInfo = maybe "" show (headNameForTransaction trans graph)

424− parentTransactionsInfo = if isRootTransaction trans graph then "root" else case parentTransactions trans graph of

459+ parentTransactionsInfo = if isRootTransaction trans then "root" else case parentTransactions trans graph of

425 Left err -> show err

460 Left err -> show err

426 Right parentTransSet -> concat $ S.toList $ S.map (show . transactionId) parentTransSet

461 Right parentTransSet -> concat $ S.toList $ S.map (show . transactionId) parentTransSet

427

462

@@ -440,25 +475,29 @@ filterSubGraph graph heads = Right $ TransactionGraph newHeads newTransSet

440 newHeads = M.map (filterTransaction validIds) heads

475 newHeads = M.map (filterTransaction validIds) heads

441

476

442--helper function for commonalities in union merge

477--helper function for commonalities in union merge

443−createUnionMergeTransaction :: UTCTime -> TransactionId -> MergeStrategy -> TransactionGraph -> (Transaction, Transaction) -> Either MergeError Transaction

478+createUnionMergeTransaction :: UTCTime -> TransactionId -> MergeStrategy -> (Transaction, Transaction) -> GraphRefRelationalExprM Transaction

444−createUnionMergeTransaction stamp newId strategy graph (t1,t2) = do

479+createUnionMergeTransaction stamp' newId strategy (t1,t2) = do

445 let contextA = concreteDatabaseContext t1

480 let contextA = concreteDatabaseContext t1

446 contextB = concreteDatabaseContext t2

481 contextB = concreteDatabaseContext t2

447−

482+ liftMergeE x = case x of

483+ Left e -> throwError (MergeTransactionError e)

484+ Right t -> pure t

485+

486+ graph <- gfGraph

448 preference <- case strategy of

487 preference <- case strategy of

449 UnionMergeStrategy -> pure PreferNeither

488 UnionMergeStrategy -> pure PreferNeither

450 UnionPreferMergeStrategy preferBranch ->

489 UnionPreferMergeStrategy preferBranch ->

451 case transactionForHead preferBranch graph of

490 case transactionForHead preferBranch graph of

452− Nothing -> Left (PreferredHeadMissingMergeError preferBranch)

491+ Nothing -> throwError (MergeTransactionError (PreferredHeadMissingMergeError preferBranch))

453 Just preferredTrans -> pure $ if t1 == preferredTrans then PreferFirst else PreferSecond

492 Just preferredTrans -> pure $ if t1 == preferredTrans then PreferFirst else PreferSecond

454− badStrat -> Left (InvalidMergeStrategyError badStrat)

493+ badStrat -> throwError (MergeTransactionError (InvalidMergeStrategyError badStrat))

455

494

456− incDeps <- unionMergeMaps preference (inclusionDependencies contextA) (inclusionDependencies contextB)

495+ incDeps <- liftMergeE $ unionMergeMaps preference (inclusionDependencies contextA) (inclusionDependencies contextB)

457 relVars <- unionMergeRelVars preference (relationVariables contextA) (relationVariables contextB)

496 relVars <- unionMergeRelVars preference (relationVariables contextA) (relationVariables contextB)

458− atomFuncs <- unionMergeAtomFunctions preference (atomFunctions contextA) (atomFunctions contextB)

497+ atomFuncs <- liftMergeE $ unionMergeAtomFunctions preference (atomFunctions contextA) (atomFunctions contextB)

459− notifs <- unionMergeMaps preference (notifications contextA) (notifications contextB)

498+ notifs <- liftMergeE $ unionMergeMaps preference (notifications contextA) (notifications contextB)

460− types <- unionMergeTypeConstructorMapping preference (typeConstructorMapping contextA) (typeConstructorMapping contextB)

499+ types <- liftMergeE $ unionMergeTypeConstructorMapping preference (typeConstructorMapping contextA) (typeConstructorMapping contextB)

461− dbcFuncs <- unionMergeDatabaseContextFunctions preference (dbcFunctions contextA) (dbcFunctions contextB)

500+ dbcFuncs <- liftMergeE $ unionMergeDatabaseContextFunctions preference (dbcFunctions contextA) (dbcFunctions contextB)

462 -- TODO: add merge of subschemas

501 -- TODO: add merge of subschemas

463 let newContext = DatabaseContext {

502 let newContext = DatabaseContext {

464 inclusionDependencies = incDeps,

503 inclusionDependencies = incDeps,

@@ -469,7 +508,12 @@ createUnionMergeTransaction stamp newId strategy graph (t1,t2) = do

469 typeConstructorMapping = types

508 typeConstructorMapping = types

470 }

509 }

471 newSchemas = Schemas newContext (subschemas t1)

510 newSchemas = Schemas newContext (subschemas t1)

472− pure (Transaction newId (MergeTransactionInfo (transactionId t1) (transactionId t2) S.empty stamp) newSchemas)

511+ pure $ addMerkleHash graph $

512+ Transaction newId (TransactionInfo {

513+ parents = NE.fromList [transactionId t1,

514+ transactionId t2],

515+ stamp = stamp',

516+ merkleHash = mempty }) newSchemas

473

517

474lookupTransaction :: TransactionGraph -> TransactionIdLookup -> Either RelationalError Transaction

518lookupTransaction :: TransactionGraph -> TransactionIdLookup -> Either RelationalError Transaction

475lookupTransaction graph (TransactionIdLookup tid) = transactionForId tid graph

519lookupTransaction graph (TransactionIdLookup tid) = transactionForId tid graph

@@ -486,56 +530,57 @@ backtrackGraph :: TransactionGraph -> TransactionId -> TransactionIdHeadBacktrac

486-- tilde, step back one parent link- if a choice must be made, choose the "first" link arbitrarily

530-- tilde, step back one parent link- if a choice must be made, choose the "first" link arbitrarily

487backtrackGraph graph currentTid (TransactionIdHeadParentBacktrack steps) = do

531backtrackGraph graph currentTid (TransactionIdHeadParentBacktrack steps) = do

488 trans <- transactionForId currentTid graph

532 trans <- transactionForId currentTid graph

533+

489− let parents = S.toAscList (transactionParentIds trans)

534+ let parentIds' = S.toAscList (parentIds trans)

490− if length parents < 1 then

535+ case parentIds' of

491− Left RootTransactionTraversalError

536+ [] -> Left RootTransactionTraversalError

492− else do

537+ firstParentId:_ -> do

493− parentTrans <- transactionForId (head parents) graph

538+ parentTrans <- transactionForId firstParentId graph

494− if steps == 1 then

539+ if steps == 1 then

495− pure (transactionId parentTrans)

540+ pure (transactionId parentTrans)

496− else

541+ else

497− backtrackGraph graph (transactionId parentTrans) (TransactionIdHeadParentBacktrack (steps - 1))

542+ backtrackGraph graph (transactionId parentTrans) (TransactionIdHeadParentBacktrack (steps - 1))

498

543

499backtrackGraph graph currentTid (TransactionIdHeadBranchBacktrack steps) = do

544backtrackGraph graph currentTid (TransactionIdHeadBranchBacktrack steps) = do

500 trans <- transactionForId currentTid graph

545 trans <- transactionForId currentTid graph

501− let parents = transactionParentIds trans

546+ let parentIds' = parentIds trans

502− if S.size parents < 1 then

547+ if S.size parentIds' < 1 then

503 Left RootTransactionTraversalError

548 Left RootTransactionTraversalError

504− else if S.size parents < steps then

549+ else if S.size parentIds' < steps then

505− Left (ParentCountTraversalError (S.size parents) steps)

550+ Left (ParentCountTraversalError (S.size parentIds') steps)

506 else

551 else

507− pure (S.elemAt (steps - 1) parents)

552+ pure (S.elemAt (steps - 1) parentIds')

508

553

509−backtrackGraph graph currentTid btrack@(TransactionStampHeadBacktrack stamp) = do

554+backtrackGraph graph currentTid btrack@(TransactionStampHeadBacktrack stamp') = do

510 trans <- transactionForId currentTid graph

555 trans <- transactionForId currentTid graph

511− let parents = transactionParentIds trans

556+ let parentIds' = parentIds trans

512− if transactionTimestamp trans < stamp then

557+ if timestamp trans <= stamp' then

513 pure currentTid

558 pure currentTid

514− else if S.null parents then

559+ else if S.null parentIds' then

515 Left RootTransactionTraversalError

560 Left RootTransactionTraversalError

516 else

561 else

517− let arbitraryParent = head (S.toList parents) in

562+ let arbitraryParent = head (S.toList parentIds') in

518 backtrackGraph graph arbitraryParent btrack

563 backtrackGraph graph arbitraryParent btrack

519

564

520-- | Create a temporary branch for commit, merge the result to head, delete the temporary branch. This is useful to atomically commit a transaction, avoiding a TransactionIsNotHeadError but trading it for a potential MergeError.

565-- | Create a temporary branch for commit, merge the result to head, delete the temporary branch. This is useful to atomically commit a transaction, avoiding a TransactionIsNotHeadError but trading it for a potential MergeError.

521--this is not a GraphOp because it combines multiple graph operations

566--this is not a GraphOp because it combines multiple graph operations

522autoMergeToHead :: UTCTime -> (TransactionId, TransactionId, TransactionId) -> DisconnectedTransaction -> HeadName -> MergeStrategy -> TransactionGraph -> Either RelationalError (DisconnectedTransaction, TransactionGraph)

567autoMergeToHead :: UTCTime -> (TransactionId, TransactionId, TransactionId) -> DisconnectedTransaction -> HeadName -> MergeStrategy -> TransactionGraph -> Either RelationalError (DisconnectedTransaction, TransactionGraph)

523−autoMergeToHead stamp (tempBranchTransId, tempCommitTransId, mergeTransId) discon mergeToHeadName strat graph = do

568+autoMergeToHead stamp' (tempBranchTransId, tempCommitTransId, mergeTransId) discon mergeToHeadName strat graph = do

524 let tempBranchName = "mergebranch_" <> U.toText tempBranchTransId

569 let tempBranchName = "mergebranch_" <> U.toText tempBranchTransId

525 --create the temp branch

570 --create the temp branch

526− (discon', graph') <- evalGraphOp stamp tempBranchTransId discon graph (Branch tempBranchName)

571+ (discon', graph') <- evalGraphOp stamp' tempBranchTransId discon graph (Branch tempBranchName)

527

572

528 --commit to the new branch- possible future optimization: don't require fsync for this- create a temp commit type

573 --commit to the new branch- possible future optimization: don't require fsync for this- create a temp commit type

529− (discon'', graph'') <- evalGraphOp stamp tempCommitTransId discon' graph' Commit

574+ (discon'', graph'') <- evalGraphOp stamp' tempCommitTransId discon' graph' Commit

530

575

531 --jump to merge head

576 --jump to merge head

532− (discon''', graph''') <- evalGraphOp stamp tempBranchTransId discon'' graph'' (JumpToHead mergeToHeadName)

577+ (discon''', graph''') <- evalGraphOp stamp' tempBranchTransId discon'' graph'' (JumpToHead mergeToHeadName)

533

578

534 --create the merge

579 --create the merge

535− (discon'''', graph'''') <- evalGraphOp stamp mergeTransId discon''' graph''' (MergeTransactions strat tempBranchName mergeToHeadName)

580+ (discon'''', graph'''') <- evalGraphOp stamp' mergeTransId discon''' graph''' (MergeTransactions strat tempBranchName mergeToHeadName)

536

581

537 --delete the temp branch

582 --delete the temp branch

538− (discon''''', graph''''') <- evalGraphOp stamp tempBranchTransId discon'''' graph'''' (DeleteBranch tempBranchName)

583+ (discon''''', graph''''') <- evalGraphOp stamp' tempBranchTransId discon'''' graph'''' (DeleteBranch tempBranchName)

539 {-

584 {-

540 let rel = runReader (evalRelationalExpr (RelationVariable "s" ())) (mkRelationalExprState $ D.concreteDatabaseContext discon'''')

585 let rel = runReader (evalRelationalExpr (RelationVariable "s" ())) (mkRelationalExprState $ D.concreteDatabaseContext discon'''')

541 traceShowM rel

586 traceShowM rel

@@ -543,4 +588,48 @@ autoMergeToHead stamp (tempBranchTransId, tempCommitTransId, mergeTransId) disco

543

588

544 pure (discon''''', graph''''')

589 pure (discon''''', graph''''')

545

590

591+

592+addMerkleHash :: TransactionGraph -> Transaction -> Transaction

593+addMerkleHash graph trans = Transaction (transactionId trans) newInfo (schemas trans)

594+ where

595+ newInfo = (transactionInfo trans) { merkleHash = calculateMerkleHash trans graph }

546

596

597+-- the new hash includes the parents' ids, the current id, and the hash of the context, and the merkle hashes of the parent transactions

598+calculateMerkleHash :: Transaction -> TransactionGraph -> MerkleHash

599+calculateMerkleHash trans graph = MerkleHash $ hashlazy (BL.fromChunks [transIds,

600+ schemasBytes

601+ ] <> dbcBytes <> parentMerkleHashes)

602+ where

603+ parentMerkleHashes = BL.fromChunks $ map (_unMerkleHash . getMerkleHash) parentTranses

604+ parentTranses =

605+ case transactionsForIds (parentIds trans) graph of

606+ Left RootTransactionTraversalError -> []

607+ Left e -> error ("failed to find transaction in Merkle hash construction: " ++ show e)

608+ Right t -> S.toList t

609+ getMerkleHash t = merkleHash (transactionInfo t)

610+ transIds = serialise (transactionId trans : S.toList (parentIds trans))

611+ dbcBytes = DBC.hashBytes (concreteDatabaseContext trans)

612+ schemasBytes = serialise (subschemas trans)

613+

614+validateMerkleHash :: Transaction -> TransactionGraph -> Either MerkleValidationError ()

615+validateMerkleHash trans graph =

616+ if expectedHash /= actualHash then

617+ Left (MerkleValidationError (transactionId trans) expectedHash actualHash)

618+ else

619+ pure ()

620+ where

621+ expectedHash = merkleHash (transactionInfo trans)

622+ actualHash = calculateMerkleHash trans graph

623+

624+data MerkleValidationError = MerkleValidationError TransactionId MerkleHash MerkleHash

625+ deriving (Show, Eq, Generic)

626+

627+validateMerkleHashes :: TransactionGraph -> Either [MerkleValidationError] ()

628+validateMerkleHashes graph =

629+ if null errs then pure () else Left errs

630+ where

631+ errs = S.foldr validateTrans [] (transactionsForGraph graph)

632+ validateTrans trans acc =

633+ case validateMerkleHash trans graph of

634+ Left err -> err : acc

635+ _ -> acc

src/lib/ProjectM36/TransactionGraph/Merge.hs+16−12

@@ -2,10 +2,11 @@

2module ProjectM36.TransactionGraph.Merge where

3import ProjectM36.Base

4import ProjectM36.Error

5+import ProjectM36.RelationalExpression

6+import Control.Monad.Except hiding (join)

5import qualified Data.Set as S

7import qualified Data.Set as S

6import qualified Data.Map as M

8import qualified Data.Map as M

7import qualified ProjectM36.TypeConstructorDef as TCD

9import qualified ProjectM36.TypeConstructorDef as TCD

8−import ProjectM36.Relation

9import Control.Monad (foldM)

10import Control.Monad (foldM)

10import qualified Data.HashSet as HS

11import qualified Data.HashSet as HS

@@ -22,19 +23,22 @@ unionMergeMaps prefer mapA mapB = case prefer of

22 Left StrategyViolatesComponentMergeError

23 Left StrategyViolatesComponentMergeError

24-- perform the merge even if the attributes are different- is this what we want? Obviously, we need finer-grained merge options.

25-- perform the merge even if the attributes are different- is this what we want? Obviously, we need finer-grained merge options.

25−unionMergeRelation :: MergePreference -> Relation -> Relation -> Either MergeError Relation

26+unionMergeRelation :: MergePreference -> GraphRefRelationalExpr -> GraphRefRelationalExpr -> GraphRefRelationalExprM GraphRefRelationalExpr

26−unionMergeRelation prefer relA relB = case relA `union` relB of

27+unionMergeRelation prefer relA relB = do

27− Right unionRel -> pure unionRel

28+ let unioned = Union relA relB

28− Left (AttributeNamesMismatchError _) -> preferredRelVar

29− Left _ -> Left StrategyViolatesRelationVariableMergeError

29+ mergeErr = MergeTransactionError StrategyViolatesRelationVariableMergeError

30− where

31− preferredRelVar = case prefer of

30+ preferredRelVar =

31+ case prefer of

32− PreferFirst -> Right relA

32+ PreferFirst -> pure relA

33− PreferSecond -> Right relB

33+ PreferSecond -> pure relB

34− PreferNeither -> Left StrategyViolatesRelationVariableMergeError

34+ PreferNeither -> throwError mergeErr

35+ handler AttributeNamesMismatchError{} = preferredRelVar

36+ handler _err' = throwError mergeErr

37+ --typecheck first?

38+ (evalGraphRefRelationalExpr unioned >> pure (Union relA relB)) `catchError` handler

36--try to execute unions against the relvars contents -- if a relvar only appears in one context, include it

40--try to execute unions against the relvars contents -- if a relvar only appears in one context, include it

37−unionMergeRelVars :: MergePreference -> RelationVariables -> RelationVariables -> Either MergeError RelationVariables

41+unionMergeRelVars :: MergePreference -> RelationVariables -> RelationVariables -> GraphRefRelationalExprM RelationVariables

38unionMergeRelVars prefer relvarsA relvarsB = do

42unionMergeRelVars prefer relvarsA relvarsB = do

39 let allNames = S.toList (S.union (M.keysSet relvarsA) (M.keysSet relvarsB))

43 let allNames = S.toList (S.union (M.keysSet relvarsA) (M.keysSet relvarsB))

40 foldM (\acc name -> do

44 foldM (\acc name -> do

src/lib/ProjectM36/TransactionGraph/Persist.hs+26−15

@@ -1,8 +1,8 @@

1module ProjectM36.TransactionGraph.Persist where

2import ProjectM36.Error

3−import ProjectM36.TransactionGraph

4import ProjectM36.Transaction

3import ProjectM36.Transaction

5import ProjectM36.Transaction.Persist

4import ProjectM36.Transaction.Persist

5+import ProjectM36.RelationalExpression

6import ProjectM36.Base

7import ProjectM36.ScriptSession

8import ProjectM36.Persist (writeFileSync, renameSync, DiskSync)

@@ -21,9 +21,12 @@ import Data.Either (isRight)

21import Data.Maybe (fromMaybe)

22import qualified Data.List as L

23import Control.Exception.Base

24−import qualified Data.Text.IO as TIO

24+import qualified Data.ByteString as BS

25+import qualified Data.Text.Encoding as TE

25import Data.ByteString (ByteString)

26import Data.ByteString (ByteString)

27+#if __GLASGOW_HASKELL__ < 804

26import Data.Monoid

28import Data.Monoid

29+#endif

27import qualified Crypto.Hash.SHA256 as SHA256

30import qualified Crypto.Hash.SHA256 as SHA256

28import Control.Arrow

31import Control.Arrow

29import Data.Time.Clock

32import Data.Time.Clock

@@ -83,13 +86,12 @@ setupDatabaseDir sync dbdir bootstrapGraph = do

83 locker <- openLockFile (lockFilePath dbdir)

86 locker <- openLockFile (lockFilePath dbdir)

84 gDigest <- bracket_ (lockFile locker WriteLock) (unlockFile locker) (readGraphTransactionIdFileDigest dbdir)

87 gDigest <- bracket_ (lockFile locker WriteLock) (unlockFile locker) (readGraphTransactionIdFileDigest dbdir)

85 pure (Right (locker, gDigest))

88 pure (Right (locker, gDigest))

86− else if not m36exists then do

89+ else if not m36exists then

87− locks <- bootstrapDatabaseDir sync dbdir bootstrapGraph

90+ Right <$> bootstrapDatabaseDir sync dbdir bootstrapGraph

88− pure (Right locks)

89 else

91 else

90 pure (Left (InvalidDirectoryError dbdir))

92 pure (Left (InvalidDirectoryError dbdir))

91{-

93{-

92−initialize a database directory with the graph from which to bootstrap- return lock file handle

94+initialize a database directory with the graph from which to bootstrap- return lock file handle which must be closed by the caller

93-}

95-}

94bootstrapDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (LockFile, LockFileHash)

96bootstrapDatabaseDir :: DiskSync -> FilePath -> TransactionGraph -> IO (LockFile, LockFileHash)

95bootstrapDatabaseDir sync dbdir bootstrapGraph = do

97bootstrapDatabaseDir sync dbdir bootstrapGraph = do

@@ -192,26 +194,35 @@ writeGraphTransactionIdFile sync destDirectory (TransactionGraph _ transSet) = w

192 uuidInfo = T.intercalate "\n" graphLines

194 uuidInfo = T.intercalate "\n" graphLines

193 digest = SHA256.hash (encodeUtf8 uuidInfo)

195 digest = SHA256.hash (encodeUtf8 uuidInfo)

194 graphLines = S.toList $ S.map graphLine transSet

196 graphLines = S.toList $ S.map graphLine transSet

195− epochTime = realToFrac . utcTimeToPOSIXSeconds . transactionTimestamp :: Transaction -> Double

197+ epochTime = realToFrac . utcTimeToPOSIXSeconds . timestamp :: Transaction -> Double

196 graphLine trans = U.toText (transactionId trans)

198 graphLine trans = U.toText (transactionId trans)

197 <> " "

199 <> " "

198 <> T.pack (show (epochTime trans))

200 <> T.pack (show (epochTime trans))

199 <> " "

201 <> " "

200− <> T.intercalate " " (S.toList (S.map U.toText $ transactionParentIds trans))

202+ <> T.intercalate " " (S.toList (S.map U.toText $ parentIds trans))

201

203

202readGraphTransactionIdFileDigest :: FilePath -> IO LockFileHash

204readGraphTransactionIdFileDigest :: FilePath -> IO LockFileHash

203readGraphTransactionIdFileDigest dbdir = do

205readGraphTransactionIdFileDigest dbdir = do

204− graphTransactionIdData <- TIO.readFile (transactionLogPath dbdir)

206+ let graphTransactionIdData = readUTF8FileOrError (transactionLogPath dbdir)

205− pure (SHA256.hash (encodeUtf8 graphTransactionIdData))

207+ SHA256.hash . encodeUtf8 <$> graphTransactionIdData

206

208

207readGraphTransactionIdFile :: FilePath -> IO (Either PersistenceError [(TransactionId, UTCTime, [TransactionId])])

209readGraphTransactionIdFile :: FilePath -> IO (Either PersistenceError [(TransactionId, UTCTime, [TransactionId])])

208readGraphTransactionIdFile dbdir = do

210readGraphTransactionIdFile dbdir = do

209 --read in all transactions' uuids

211 --read in all transactions' uuids

210− let grapher line = let tid:epochText:parentIds = T.words line in

212+ let grapher line = let tid:epochText:parentIds' = T.words line in

211− (readUUID tid, readEpoch epochText, map readUUID parentIds)

213+ (readUUID tid, readEpoch epochText, map readUUID parentIds')

212 readUUID uuidText = fromMaybe (error "failed to read uuid") (U.fromText uuidText)

214 readUUID uuidText = fromMaybe (error "failed to read uuid") (U.fromText uuidText)

213 readEpoch t = posixSecondsToUTCTime (realToFrac (either (error "failed to read epoch") fst (double t)))

215 readEpoch t = posixSecondsToUTCTime (realToFrac (either (error "failed to read epoch") fst (double t)))

214− --warning: uses lazy IO

216+ Right . map grapher . T.lines <$> readUTF8FileOrError (transactionLogPath dbdir)

215− graphTransactionIdData <- TIO.readFile (transactionLogPath dbdir)

217+

216− return $ Right (map grapher $ T.lines graphTransactionIdData)

218+--rationale- reading essential database files must fail hard

219+readUTF8FileOrError :: FilePath -> IO T.Text

220+readUTF8FileOrError pathIn = do

221+ eFileBytes <- try (BS.readFile pathIn) :: IO (Either IOError BS.ByteString)

222+ case eFileBytes of

223+ Left err -> error (show err)

224+ Right fileBytes ->

225+ case TE.decodeUtf8' fileBytes of

226+ Left err -> error (show err)

227+ Right utf8Bytes -> pure utf8Bytes

217

228

src/lib/ProjectM36/TransactionGraph/Show.hs+3−4

@@ -1,17 +1,16 @@

1module ProjectM36.TransactionGraph.Show where

2import ProjectM36.Base

3import ProjectM36.TransactionGraph

4−import ProjectM36.Transaction

5import qualified Data.Set as S

4import qualified Data.Set as S

7showTransactionStructure :: Transaction -> TransactionGraph -> String

6showTransactionStructure :: Transaction -> TransactionGraph -> String

8−showTransactionStructure trans graph = headInfo ++ " " ++ show (transactionId trans) ++ " p" ++ parentTransactionsInfo ++ " c" ++ childTransactionsInfo

7+showTransactionStructure trans graph = headInfo ++ " " ++ show (transactionId trans) ++ " p" ++ parentTransactionsInfo

9 where

8 where

10 headInfo = maybe "" show (headNameForTransaction trans graph)

9 headInfo = maybe "" show (headNameForTransaction trans graph)

11− parentTransactionsInfo = if isRootTransaction trans graph then "root" else case parentTransactions trans graph of

10+ parentTransactionsInfo = if isRootTransaction trans then "root" else case parentTransactions trans graph of

12 Left err -> show err

11 Left err -> show err

13 Right parentTransSet -> concat $ S.toList $ S.map (show . transactionId) parentTransSet

12 Right parentTransSet -> concat $ S.toList $ S.map (show . transactionId) parentTransSet

14− childTransactionsInfo = show (S.toList (transactionChildIds trans))

13+

16showGraphStructure :: TransactionGraph -> String

15showGraphStructure :: TransactionGraph -> String

17showGraphStructure graph@(TransactionGraph _ transSet) = S.foldr folder "" transSet

16showGraphStructure graph@(TransactionGraph _ transSet) = S.foldr folder "" transSet

src/lib/ProjectM36/TransactionGraph/Types.hsnew file+12

@@ -0,0 +1,12 @@

1+module ProjectM36.TransactionGraph.Types where

2+import ProjectM36.Base

4+transactions :: TransactionGraph -> S.Set Transaction

5+transactions (TransactionGraph _ t) = t

7+transactionHeads :: TransactionGraph -> TransactionHeads

8+transactionHeads (TransactionGraph heads _) = heads

10+transactionInfoDiffs :: TransactionInfo -> TransactionDiffs

11+transactionInfoDiffs (TransactionInfo _ d _) = d

12+transactionInfoDiffs (MergeTransactionInfo _ _ d _ ) = d

src/lib/ProjectM36/TransactionInfo.hsnew file+12

@@ -0,0 +1,12 @@

1+module ProjectM36.TransactionInfo where

2+import ProjectM36.Base

3+import Data.Time.Clock

4+import qualified Data.List.NonEmpty as NE

6+-- | Create a TransactionInfo with just one parent transaction ID.

7+singleParent :: TransactionId -> UTCTime -> TransactionInfo

8+singleParent tid stamp' = TransactionInfo {

9+ parents = tid NE.:| [],

10+ stamp = stamp',

11+ merkleHash = mempty }

12+

src/lib/ProjectM36/Tuple.hs+57−47

@@ -1,7 +1,7 @@

1module ProjectM36.Tuple where

2import ProjectM36.Base

3import ProjectM36.Error

4−import ProjectM36.Attribute

4+import ProjectM36.Attribute as A

5import ProjectM36.Atom

6import ProjectM36.AtomType

7import ProjectM36.DataTypes.Primitive

@@ -15,42 +15,42 @@ import Control.Arrow

15import Data.Maybe

17emptyTuple :: RelationTuple

18−emptyTuple = RelationTuple V.empty V.empty

18+emptyTuple = RelationTuple mempty mempty

20tupleSize :: RelationTuple -> Int

21−tupleSize (RelationTuple tupAttrs _) = V.length tupAttrs

21+tupleSize (RelationTuple tupAttrs _) = arity tupAttrs

23tupleAttributeNameSet :: RelationTuple -> S.Set AttributeName

24−tupleAttributeNameSet (RelationTuple tupAttrs _) = S.fromList $ V.toList $ V.map attributeName tupAttrs

24+tupleAttributeNameSet (RelationTuple tupAttrs _) = attributeNameSet tupAttrs

26tupleAttributes :: RelationTuple -> Attributes

27tupleAttributes (RelationTuple tupAttrs _) = tupAttrs

29tupleAssocs :: RelationTuple -> [(AttributeName, Atom)]

30−tupleAssocs (RelationTuple attrVec tupVec) = V.toList $ V.map (first attributeName) (V.zip attrVec tupVec)

30+tupleAssocs (RelationTuple attrs tupVec) = V.toList $ V.map (first attributeName) (V.zip (attributesVec attrs) tupVec)

31+

32+orderedTupleAssocs :: RelationTuple -> [(AttributeName, Atom)]

33+orderedTupleAssocs tup@(RelationTuple attrVec _) = map (\attr -> (attributeName attr, atomForAttr (attributeName attr))) oAttrs

34+ where

35+ oAttrs = orderedAttributes attrVec

36+ atomForAttr nam = case atomForAttributeName nam tup of

37+ Left _ -> TextAtom "<?>"

38+ Right val -> val

32-- return atoms in some arbitrary but consistent key order

40-- return atoms in some arbitrary but consistent key order

33tupleAtoms :: RelationTuple -> V.Vector Atom

41tupleAtoms :: RelationTuple -> V.Vector Atom

34tupleAtoms (RelationTuple _ tupVec) = tupVec

42tupleAtoms (RelationTuple _ tupVec) = tupVec

36atomForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom

44atomForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom

37−atomForAttributeName attrName (RelationTuple tupAttrs tupVec) = case V.findIndex (\attr -> attributeName attr == attrName) tupAttrs of

45+atomForAttributeName attrName (RelationTuple tupAttrs tupVec) = case V.findIndex (\attr -> attributeName attr == attrName) (attributesVec tupAttrs) of

38 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))

46 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))

39 Just index -> case tupVec V.!? index of

47 Just index -> case tupVec V.!? index of

40 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))

48 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))

41 Just atom -> Right atom

49 Just atom -> Right atom

43−{- -- resolve naming clash with Attribute and Relation later

44−atomTypeForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom

45−atomTypeForAttributeName attrName tup = do

46− atom <- atomForAttributeName attrName tup

47− return $ atomTypeForAtom atom

48−-}

49−

50atomsForAttributeNames :: V.Vector AttributeName -> RelationTuple -> Either RelationalError (V.Vector Atom)

51atomsForAttributeNames :: V.Vector AttributeName -> RelationTuple -> Either RelationalError (V.Vector Atom)

51−atomsForAttributeNames attrNames tuple = do

52+atomsForAttributeNames attrNames tuple =

52− vindices <- vectorIndicesForAttributeNames attrNames (tupleAttributes tuple)

53− return $ V.map (\index -> tupleAtoms tuple V.! index) vindices

53+ V.map (\index -> tupleAtoms tuple V.! index) <$> vectorIndicesForAttributeNames attrNames (tupleAttributes tuple)

55vectorIndicesForAttributeNames :: V.Vector AttributeName -> Attributes -> Either RelationalError (V.Vector Int)

56vectorIndicesForAttributeNames attrNameVec attrs = if not $ V.null unknownAttrNames then

@@ -59,7 +59,7 @@ vectorIndicesForAttributeNames attrNameVec attrs = if not $ V.null unknownAttrNa

59 Right $ V.map mapper attrNameVec

60 where

61 unknownAttrNames = V.filter (`V.notElem` attributeNames attrs) attrNameVec

62− mapper attrName = fromMaybe (error "logic failure in vectorIndicesForAttributeNames") (V.elemIndex attrName (V.map attributeName attrs))

62+ mapper attrName = fromMaybe (error "logic failure in vectorIndicesForAttributeNames") (V.elemIndex attrName (attributeNames attrs))

65relationForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Relation

@@ -86,10 +86,10 @@ mkRelationTuples attrs = map mapper

86 mapper = mkRelationTuple attrs

88mkRelationTupleFromMap :: M.Map AttributeName Atom -> RelationTuple

89−mkRelationTupleFromMap attrMap = RelationTuple attrs (V.map (\attrName -> attrMap M.! attrName) attrNames)

89+mkRelationTupleFromMap attrMap = RelationTuple (attributesFromList attrs) (V.map (attrMap M.!) (V.fromList attrNames))

90 where

91− attrNames = V.fromList (M.keys attrMap)

91+ attrNames = M.keys attrMap

92− attrs = V.map (\attrName -> Attribute attrName (atomTypeForAtom (attrMap M.! attrName))) attrNames

92+ attrs = map (\attrName -> Attribute attrName (atomTypeForAtom (attrMap M.! attrName))) attrNames

94--return error if attribute names match but their types do not

95singleTupleSetJoin :: Attributes -> RelationTuple -> RelationTupleSet -> Either RelationalError [RelationTuple]

@@ -120,8 +120,8 @@ singleTupleJoin joinedAttrs tup1@(RelationTuple tupAttrs1 _) tup2@(RelationTuple

120 return $ Just $ RelationTuple joinedAttrs newVec

121 where

122 keysIntersection = V.map attributeName attrsIntersection

123− attrsIntersection = V.filter (`V.elem` tupAttrs1) tupAttrs2

123+ attrsIntersection = V.filter (`V.elem` attributesVec tupAttrs1) (attributesVec tupAttrs2)

124− newVec = V.map (findAtomForAttributeName . attributeName) joinedAttrs

124+ newVec = V.map (findAtomForAttributeName . attributeName) (attributesVec joinedAttrs)

125 --search both tuples for the attribute

126 findAtomForAttributeName attrName = head $ rights $ fmap (atomForAttributeName attrName) [tup1, tup2]

127

@@ -138,27 +138,31 @@ vectorUnion v1 v2 = V.foldr folder v1 v2

138tupleExtend :: RelationTuple -> RelationTuple -> RelationTuple

139tupleExtend (RelationTuple tupAttrs1 tupVec1) (RelationTuple tupAttrs2 tupVec2) = RelationTuple newAttrs newVec

140 where

141− newAttrs = tupAttrs1 V.++ tupAttrs2

141+ newAttrs = tupAttrs1 <> tupAttrs2

142− newVec = tupVec1 V.++ tupVec2

142+ newVec = tupVec1 <> tupVec2

143

144tupleAtomExtend :: AttributeName -> Atom -> RelationTuple -> RelationTuple

145tupleAtomExtend newAttrName atom tupIn = tupleExtend tupIn newTup

146 where

147− newTup = RelationTuple (V.singleton $ Attribute newAttrName (atomTypeForAtom atom)) (V.singleton atom)

147+ newTup = RelationTuple (A.singleton $ Attribute newAttrName (atomTypeForAtom atom)) (V.singleton atom)

148

149−{- sort the associative list to match the header sorting -}

150−tupleSortedAssocs :: RelationTuple -> [(AttributeName, Atom)]

151−tupleSortedAssocs (RelationTuple tupAttrs tupVec) = V.toList $ V.map (\(index,attr) -> (attributeName attr, tupVec V.! index)) $ V.indexed tupAttrs

152−

153−--this could be cheaper- it may not be wortwhile to update all the tuples for projection, but then the attribute management must be slightly different- perhaps the attributes should be a vector of association tuples [(name, index)]

154−tupleProject :: S.Set AttributeName -> RelationTuple -> RelationTuple

149+{-tupleProject :: S.Set AttributeName -> RelationTuple -> RelationTuple

155tupleProject projectAttrs (RelationTuple attrs tupVec) = RelationTuple newAttrs newTupVec

150tupleProject projectAttrs (RelationTuple attrs tupVec) = RelationTuple newAttrs newTupVec

156 where

151 where

157− deleteIndices = V.findIndices (\attr -> S.notMember (attributeName attr) projectAttrs) attrs

152+ deleteIndices = V.findIndices (\attr -> S.notMember (attributeName attr) projectAttrs) (attributesVec attrs)

158 indexDeleter = V.ifilter (\index _ -> V.notElem index deleteIndices)

153 indexDeleter = V.ifilter (\index _ -> V.notElem index deleteIndices)

159− newAttrs = indexDeleter attrs

154+ newAttrs = case A.projectionAttributesForNames projectAttrs attrs of

155+ Left err -> error (show (err, projectAttrs, attrs))

156+ Right attrs' -> attrs'

160 newTupVec = indexDeleter tupVec

157 newTupVec = indexDeleter tupVec

161−

158+-}

159+-- remember that the attributes order matters

160+tupleProject :: Attributes -> RelationTuple -> Either RelationalError RelationTuple

161+tupleProject projectAttrs tup = do

162+ newTupVec <- foldM (\acc attr ->

163+ V.snoc acc <$> atomForAttributeName (attributeName attr) tup

164+ ) V.empty (attributesVec projectAttrs)

165+ pure $ reorderTuple projectAttrs (RelationTuple projectAttrs newTupVec)

162--return the attributes and atoms which are equal in both vectors

166--return the attributes and atoms which are equal in both vectors

163--semi-join

167--semi-join

164tupleIntersection :: RelationTuple -> RelationTuple -> RelationTuple

168tupleIntersection :: RelationTuple -> RelationTuple -> RelationTuple

@@ -166,12 +170,14 @@ tupleIntersection tuple1 tuple2 = RelationTuple newAttrs newTupVec

166 where

170 where

167 attrs1 = tupleAttributes tuple1

171 attrs1 = tupleAttributes tuple1

168 attrs2 = tupleAttributes tuple2

172 attrs2 = tupleAttributes tuple2

173+ intersectAttrs = A.intersection attrs1 attrs2

169− matchingIndices = V.findIndices (\attr -> V.elem attr attrs2 &&

174+ matchingIndices = V.findIndices (\attr -> A.member attr intersectAttrs &&

170− atomForAttributeName (attributeName attr) tuple1 ==

175+ atomForAttributeName (attributeName attr) tuple1 ==

171− atomForAttributeName (attributeName attr) tuple2

176+ atomForAttributeName (attributeName attr) tuple2) (attributesVec attrs1)

172− ) attrs1

173 indexFilter = V.ifilter (\index _ -> V.elem index matchingIndices)

177 indexFilter = V.ifilter (\index _ -> V.elem index matchingIndices)

174− newAttrs = indexFilter attrs1

178+ newAttrs = case A.projectionAttributesForNames (A.attributeNameSet intersectAttrs) attrs1 of

179+ Left _ -> mempty

180+ Right attrs' -> attrs'

175 newTupVec = indexFilter (tupleAtoms tuple1)

181 newTupVec = indexFilter (tupleAtoms tuple1)

176

182

177-- | An optimized form of tuple update which updates vectors efficiently.

183-- | An optimized form of tuple update which updates vectors efficiently.

@@ -179,19 +185,20 @@ updateTupleWithAtoms :: M.Map AttributeName Atom -> RelationTuple -> RelationTup

179updateTupleWithAtoms updateMap (RelationTuple attrs tupVec) = RelationTuple attrs newVec

185updateTupleWithAtoms updateMap (RelationTuple attrs tupVec) = RelationTuple attrs newVec

180 where

186 where

181 updateKeysSet = M.keysSet updateMap

187 updateKeysSet = M.keysSet updateMap

182− updateKeysIVec = V.filter (\(_,attr) -> S.member (attributeName attr) updateKeysSet) (V.indexed attrs)

188+ updateKeysIVec = V.filter (\(_,attr) -> S.member (attributeName attr) updateKeysSet) (V.indexed (attributesVec attrs))

183 newVec = V.update tupVec updateVec

189 newVec = V.update tupVec updateVec

184 updateVec = V.map (\(index, attr) -> (index, updateMap M.! attributeName attr)) updateKeysIVec

190 updateVec = V.map (\(index, attr) -> (index, updateMap M.! attributeName attr)) updateKeysIVec

185

191

186tupleToMap :: RelationTuple -> M.Map AttributeName Atom

192tupleToMap :: RelationTuple -> M.Map AttributeName Atom

187tupleToMap (RelationTuple attrs tupVec) = M.fromList assocList

193tupleToMap (RelationTuple attrs tupVec) = M.fromList assocList

188 where

194 where

189− assocList = V.toList $ V.map (\(index, attr) -> (attributeName attr, tupVec V.! index)) (V.indexed attrs)

195+ assocList = V.toList $ V.map (\(index, attr) -> (attributeName attr, tupVec V.! index)) (V.indexed (attributesVec attrs))

190

196

197+-- | Validate that the tuple has the correct attributes in the correct order

191verifyTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple

198verifyTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple

192−verifyTuple attrs tuple = let attrsTypes = V.map atomType attrs

199+verifyTuple attrs tuple = let attrsTypes = A.atomTypes attrs

193 tupleTypes = V.map atomTypeForAtom (tupleAtoms tuple) in

200 tupleTypes = V.map atomTypeForAtom (tupleAtoms tuple) in

194− if V.length attrs /= V.length tupleTypes then

201+ if A.arity attrs /= V.length tupleTypes then

195 Left $ TupleAttributeCountMismatchError 0

202 Left $ TupleAttributeCountMismatchError 0

196 else do

203 else do

197 mapM_ (uncurry atomTypeVerify) (V.zip attrsTypes tupleTypes)

204 mapM_ (uncurry atomTypeVerify) (V.zip attrsTypes tupleTypes)

@@ -200,15 +207,18 @@ verifyTuple attrs tuple = let attrsTypes = V.map atomType attrs

200--two tuples can be equal but the vectors of attributes could be out-of-order

207--two tuples can be equal but the vectors of attributes could be out-of-order

201--reorder if necessary- this is useful during relMogrify so that all the relation's tuples have identical atom/attribute ordering

208--reorder if necessary- this is useful during relMogrify so that all the relation's tuples have identical atom/attribute ordering

202reorderTuple :: Attributes -> RelationTuple -> RelationTuple

209reorderTuple :: Attributes -> RelationTuple -> RelationTuple

203−reorderTuple attrs tupIn = if tupleAttributes tupIn == attrs then

210+reorderTuple attrs tupIn = if attributesAndOrderEqual (tupleAttributes tupIn) attrs then

204 tupIn

211 tupIn

205 else

212 else

206− RelationTuple attrs (V.map mapper attrs)

213+ RelationTuple attrs (V.map mapper (attributesVec attrs))

207 where

214 where

208 mapper attr = case atomForAttributeName (attributeName attr) tupIn of

215 mapper attr = case atomForAttributeName (attributeName attr) tupIn of

209− Left _ -> error "logic failure in reorderTuple"

216+ Left err -> error ("logic bug in reorderTuple: " ++ show err <> show tupIn)

210 Right atom -> atom

217 Right atom -> atom

211

218

212--used in Generics derivation for ADTs without named attributes

219--used in Generics derivation for ADTs without named attributes

213trimTuple :: Int -> RelationTuple -> RelationTuple

220trimTuple :: Int -> RelationTuple -> RelationTuple

214−trimTuple index (RelationTuple attrs vals) = RelationTuple (V.drop index attrs) (V.drop index vals)

221+trimTuple index (RelationTuple attrs vals) =

222+ RelationTuple newAttrs (V.drop index vals)

223+ where

224+ newAttrs = A.drop index attrs

src/lib/ProjectM36/TupleSet.hs+7

@@ -31,3 +31,10 @@ mkTupleSet attrs tuples = verifyTupleSet attrs (RelationTupleSet tuples)

32mkTupleSetFromList :: Attributes -> [[Atom]] -> Either RelationalError RelationTupleSet

33mkTupleSetFromList attrs atomMatrix = mkTupleSet attrs $ map (mkRelationTuple attrs . V.fromList) atomMatrix

34+

35+

36+-- | Union two tuplesets while reordering their attribute/atom mapping properly.

37+tupleSetUnion :: Attributes -> RelationTupleSet -> RelationTupleSet -> RelationTupleSet

38+tupleSetUnion targetAttrs tupSet1 tupSet2 = RelationTupleSet $ HS.toList . HS.fromList $ reorder (asList tupSet1) ++ reorder (asList tupSet2)

39+ where

40+ reorder = map (reorderTuple targetAttrs)

src/lib/ProjectM36/Tupleable.hs+214−66