034ed44..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−

58−# EOF

Changelog.markdown+81

@@ -1,3 +1,84 @@

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+

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

73+

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

75+* allow notifications to return query results from before *and* after the commit which triggered the notification

76+* alert users in `tutd` console before a transaction graph expression is evaluated which would throw out their changes

77+* drastically-improved CSV import/export now supports all possible types except `RelationAtom`

78+* fix serious file handle leaks when using on-disk persistence

79+* fix case where invalid number of arguments to `ConstructedAtom` did not result in an error

80+* add support for `IntegerAtom` (previously, only `IntAtom` was supported)

81+

1# 2017-09-16 (v0.2)

82# 2017-09-16 (v0.2)

3* a new [simple client API](https://github.com/agentm/project-m36/blob/master/docs/simple_api.markdown) with a monadic transaction manager

84* a new [simple client API](https://github.com/agentm/project-m36/blob/master/docs/simple_api.markdown) with a monadic transaction manager

README.markdown+26−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,8 +44,9 @@ 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)

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

46## Documentation

51## Documentation

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

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

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

511. [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)

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

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

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

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

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

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

551. [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)

57### Database Comparisons

65### Database Comparisons

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

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

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

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

611. [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)

63### Advanced Features

72### Advanced Features

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

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

661. [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)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

761. [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)

78## Development

95## Development

80−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.

82## Related Projects

99## Related Projects

100

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

105

89## Suggested Reading

106## Suggested Reading

107

91−* [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.

92* [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

93* [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;

cbits/darwin_statfs.cnew file+23

@@ -0,0 +1,23 @@

1+#include <sys/param.h>

2+#include <sys/mount.h>

3+#include <stdio.h>

5+#ifndef _PROJECT_M36_STATFS_

6+#define _PROJECT_M36_STATFS_

7+#ifdef __APPLE__

8+int cDarwinFSJournaled(const char* path)

9+{

10+ struct statfs s = {0};

11+ int ret = statfs(path, &s);

12+ if(ret < 0)

13+ {

14+ /* error */

15+ return ret;

16+ }

17+ else

18+ {

19+ return s.f_flags & MNT_JOURNALED;

20+ }

21+}

22+#endif

23+#endif

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+3−3

@@ -103,9 +103,9 @@ The essential ```Atomable``` typeclass functions are:

103| -------- | ------- |

104| ```toAtom :: a -> Atom``` | convert a Haskell data type to a database atom |

105| ```fromAtom :: Atom -> a``` | convert a database atom to a Haskell data type |

106−| ```toAtomType :: a -> AtomType``` | generate a database AtomType for a Haskell datatype |

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

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

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+25−2

@@ -23,13 +23,36 @@ 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 :: (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 :: 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```

35 * converts a ```Tupleable``` value to a tuple for use in queries

58 * converts a ```Tupleable``` value to a tuple for use in queries

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+308−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" │

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 │

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 │

179−│Paris │Green│

227+│"Paris" │"S2" │"Jones" │10 │

180−└──────┴─────┘

228+│"Paris" │"S3" │"Blake" │30 │

229+└──────────┴────────┴───────────┴───────────────┘

230+```

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+└──────────┘

181```

266```

182

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.

@@ -282,29 +376,31 @@ The unary group operator groups the argument attributes into subrelations for ea

282

376

283Grouping is useful for aggregate operations (see below) or for summarizing data against a set of attributes; for example, "display all employees grouped by boss name".

377Grouping is useful for aggregate operations (see below) or for summarizing data against a set of attributes; for example, "display all employees grouped by boss name".

284

378

379+The group operator can also be used to emulate functionality similar to SQL's OUTER JOIN but without relying on overloading the meaning of NULL.

380+

285```

381```

286TutorialD (master/main): :showexpr s group ({sname,status,s#} as subrel)

382TutorialD (master/main): :showexpr s group ({sname,status,s#} as subrel)

287−┌──────┬─────────────────┐

383+┌──────────┬───────────────────────────────────────────────────────┐

288−│city │subrel │

384+│city::Text│subrel::relation {s#::Text,sname::Text,status::Integer}│

289−├──────┼─────────────────┤

385+├──────────┼───────────────────────────────────────────────────────┤

290−│Athens│┌──┬─────┬──────┐│

386+│"Athens" │┌────────┬───────────┬───────────────┐ │

291−│ ││s#│sname│status││

387+│ ││s#::Text│sname::Text│status::Integer│ │

292−│ │├──┼─────┼──────┤│

388+│ │├────────┼───────────┼───────────────┤ │

293−│ ││S5│Adams│30 ││

389+│ ││"S5" │"Adams" │30 │ │

294−│ │└──┴─────┴──────┘│

295−│London│┌──┬─────┬──────┐│

296−│ ││s#│sname│status││

297−│ │├──┼─────┼──────┤│

298−│ ││S1│Smith│20 ││

299−│ ││S4│Clark│20 ││

300−│ │└──┴─────┴──────┘│

390+│ │└────────┴───────────┴───────────────┘ │

301−│Paris │┌──┬─────┬──────┐│

391+│"Paris" │┌────────┬───────────┬───────────────┐ │

302−│ ││s#│sname│status││

392+│ ││s#::Text│sname::Text│status::Integer│ │

303−│ │├──┼─────┼──────┤│

393+│ │├────────┼───────────┼───────────────┤ │

304−│ ││S3│Blake│30 ││

305−│ ││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 │ │

306−│ │└──┴─────┴──────┘│

402+│ │└────────┴───────────┴───────────────┘ │

307−└──────┴─────────────────┘

403+└──────────┴───────────────────────────────────────────────────────┘

308```

404```

309

405

310#### Ungroup

406#### Ungroup

@@ -313,15 +409,15 @@ The unary ungroup operator "unwraps" subrelations in a relation-valued attribute

313

409

314```

410```

315TutorialD (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

316−┌──────┬──┬─────┬──────┐

412+┌──────────┬────────┬───────────┬───────────────┐

317−│city │s#│sname│status│

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

318−├──────┼──┼─────┼──────┤

414+├──────────┼────────┼───────────┼───────────────┤

415+│"Paris" │"S2" │"Jones" │10 │

319−│Paris │S3│Blake│30 │

416+│"Paris" │"S3" │"Blake" │30 │

320−│London│S4│Clark│20 │

417+│"London" │"S4" │"Clark" │20 │

418+│"London" │"S1" │"Smith" │20 │

321−│Athens│S5│Adams│30 │

419+│"Athens" │"S5" │"Adams" │30 │

322−│London│S1│Smith│20 │

323−│Paris │S2│Jones│10 │

324−└──────┴──┴─────┴──────┘

420+└──────────┴────────┴───────────┴───────────────┘

325```

421```

326

422

327#### Minus

423#### Minus

@@ -354,11 +450,11 @@ The relation variable assignment mentioned above certainly changes the state of

354```

450```

355TutorialD (master/main): newrelvar:=relation{tuple{age 3}}

451TutorialD (master/main): newrelvar:=relation{tuple{age 3}}

356TutorialD (master/main): :showexpr newrelvar

452TutorialD (master/main): :showexpr newrelvar

357−┌───┐

453+┌────────────┐

358−│age│

454+│age::Integer│

359−├───┤

455+├────────────┤

360−│3 │

456+│3 │

361−└───┘

457+└────────────┘

362```

458```

363

459

364All 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.

@@ -380,16 +476,16 @@ The insert operators accepts a relation variable and a relation of the same type

380```

476```

381TutorialD (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}}

382TutorialD (master/main): :showexpr s

478TutorialD (master/main): :showexpr s

383−┌──────┬───┬────────┬──────┐

479+┌──────────┬────────┬───────────┬───────────────┐

384−│city │s# │sname │status│

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

385−├──────┼───┼────────┼──────┤

481+├──────────┼────────┼───────────┼───────────────┤

386−│Paris │S3 │Blake │30 │

387−│London│S4 │Clark │20 │

388−│Athens│S5 │Adams │30 │

482+│"Athens" │"S5" │"Adams" │30 │

389−│London│S1 │Smith │20 │

390−│Paris │S2 │Jones │10 │

483+│"Paris" │"S2" │"Jones" │10 │

391−│Boston│S10│Gonzalez│10 │

484+│"Boston" │"S10" │"Gonzalez" │10 │

485+│"London" │"S4" │"Clark" │20 │

486+│"London" │"S1" │"Smith" │20 │

487+│"Paris" │"S3" │"Blake" │30 │

392−└──────┴───┴────────┴──────┘

488+└──────────┴────────┴───────────┴───────────────┘

393```

489```

394

490

395This insertion operation is equivalent to:

491This insertion operation is equivalent to:

@@ -404,15 +500,15 @@ The update operator accepts a relation argument and a predicate, optionally filt

404```

500```

405TutorialD (master/main): update s where status=20 (sname:="Mr. Twenty")

501TutorialD (master/main): update s where status=20 (sname:="Mr. Twenty")

406TutorialD (master/main): :showexpr s

502TutorialD (master/main): :showexpr s

407−┌──────┬──┬──────────┬──────┐

503+┌──────────┬────────┬────────────┬───────────────┐

408−│city │s#│sname │status│

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

409−├──────┼──┼──────────┼──────┤

505+├──────────┼────────┼────────────┼───────────────┤

506+│"Paris" │"S2" │"Jones" │10 │

507+│"London" │"S1" │"Mr. Twenty"│20 │

410−│Paris │S3│Blake │30 │

508+│"Paris" │"S3" │"Blake" │30 │

411−│London│S1│Mr. Twenty│20 │

509+│"London" │"S4" │"Mr. Twenty"│20 │

412−│Athens│S5│Adams │30 │

510+│"Athens" │"S5" │"Adams" │30 │

413−│Paris │S2│Jones │10 │

414−│London│S4│Mr. Twenty│20 │

415−└──────┴──┴──────────┴──────┘

511+└──────────┴────────┴────────────┴───────────────┘

416```

512```

417

513

418This is logically equivalent to:

514This is logically equivalent to:

@@ -420,15 +516,15 @@ This is logically equivalent to:

420```

516```

421TutorialD (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)

422TutorialD (master/main): :showexpr s

518TutorialD (master/main): :showexpr s

423−┌──────┬──┬──────────┬──────┐

519+┌──────────┬────────┬────────────┬───────────────┐

424−│city │s#│sname │status│

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

425−├──────┼──┼──────────┼──────┤

521+├──────────┼────────┼────────────┼───────────────┤

522+│"Paris" │"S2" │"Jones" │10 │

523+│"London" │"S1" │"Mr. Twenty"│20 │

426−│Paris │S3│Blake │30 │

524+│"Paris" │"S3" │"Blake" │30 │

427−│London│S1│Mr. Twenty│20 │

525+│"London" │"S4" │"Mr. Twenty"│20 │

428−│Athens│S5│Adams │30 │

526+│"Athens" │"S5" │"Adams" │30 │

429−│Paris │S2│Jones │10 │

430−│London│S4│Mr. Twenty│20 │

431−└──────┴──┴──────────┴──────┘

527+└──────────┴────────┴────────────┴───────────────┘

432```

528```

433

529

434This 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."

@@ -440,19 +536,19 @@ The delete operator accepts a relation argument and a filtering predicate, creat

440```

536```

441TutorialD (master/main): delete sp where s#="S4"

537TutorialD (master/main): delete sp where s#="S4"

442TutorialD (master/main): :showexpr sp

538TutorialD (master/main): :showexpr sp

443−┌──┬───┬──┐

539+┌────────┬────────────┬────────┐

444−│p#│QTY│s#│

540+│p#::Text│qty::Integer│s#::Text│

445−├──┼───┼──┤

541+├────────┼────────────┼────────┤

446−│P3│400│S1│

447−│P4│200│S1│

448−│P2│400│S2│

449−│P2│200│S1│

450−│P6│100│S1│

451−│P1│300│S1│

452−│P2│200│S3│

542+│"P2" │200 │"S3" │

543+│"P2" │400 │"S2" │

453−│P1│300│S2│

544+│"P1" │300 │"S1" │

454−│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" │

455−└──┴───┴──┘

551+└────────┴────────────┴────────┘

456```

552```

457

553

458This is logically equivalent to:

554This is logically equivalent to:

@@ -487,7 +583,7 @@ Foreign keys are constraints which require that certain values appearing in one

487TutorialD (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#}

488```

584```

489

585

490−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.

491

587

492#### Functional dependencies

588#### Functional dependencies

493

589

@@ -521,27 +617,27 @@ SQL supports aggregate queries using aggregate functions (SUM(), COUNT(), AVERAG

521

617

522```

618```

523TutorialD (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)}

524−┌──────┬─────────┬─────────────────┐

620+┌──────────┬──────────────────┬───────────────────────────────────────────────────────┐

525−│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│ │

526−├──────┼─────────┼─────────────────┤

625+│ │ │├────────┼───────────┼───────────────┤ │

626+│ │ ││"S5" │"Adams" │30 │ │

627+│ │ │└────────┴───────────┴───────────────┘ │

527−│Paris │2 │┌──┬─────┬──────┐│

628+│"Paris" │2 │┌────────┬───────────┬───────────────┐ │

528−│ │ ││s#│sname│status││

629+│ │ ││s#::Text│sname::Text│status::Integer│ │

529−│ │ │├──┼─────┼──────┤│

630+│ │ │├────────┼───────────┼───────────────┤ │

530−│ │ ││S3│Blake│30 ││

531−│ │ ││S2│Jones│10 ││

631+│ │ ││"S2" │"Jones" │10 │ │

632+│ │ ││"S3" │"Blake" │30 │ │

532−│ │ │└──┴─────┴──────┘│

633+│ │ │└────────┴───────────┴───────────────┘ │

533−│London│2 │┌──┬─────┬──────┐│

634+│"London" │2 │┌────────┬───────────┬───────────────┐ │

534−│ │ ││s#│sname│status││

635+│ │ ││s#::Text│sname::Text│status::Integer│ │

535−│ │ │├──┼─────┼──────┤│

636+│ │ │├────────┼───────────┼───────────────┤ │

637+│ │ ││"S4" │"Clark" │20 │ │

536−│ │ ││S1│Smith│20 ││

638+│ │ ││"S1" │"Smith" │20 │ │

537−│ │ ││S4│Clark│20 ││

538−│ │ │└──┴─────┴──────┘│

639+│ │ │└────────┴───────────┴───────────────┘ │

539−│Athens│1 │┌──┬─────┬──────┐│

540−│ │ ││s#│sname│status││

541−│ │ │├──┼─────┼──────┤│

542−│ │ ││S5│Adams│30 ││

543−│ │ │└──┴─────┴──────┘│

544−└──────┴─────────┴─────────────────┘

640+└──────────┴──────────────────┴───────────────────────────────────────────────────────┘

545```

641```

546

642

547In 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.

@@ -552,3 +648,28 @@ In this query result, we can simultaneously answer how many suppliers are locate

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

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

554|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/using_notifications.markdown+22−18

@@ -9,8 +9,9 @@ As an example, consider an email application. Users of the applications will wan

9A Project:M36 notification is comprised of three user-selected parts:

111. an arbitrary notification name: used to uniquely identify the notification in the server and client

12−2. a trigger relational expression: when the outcome of this relational expression changes between two transactions, the notification is fired

12+1. a trigger relational expression: when the outcome of this relational expression changes between two transactions, the notification is fired

13−3. a report relational expression: when the notification fires, the expression is evaluated and passed along

13+1. a report relational expression for the pre-change context: when the notification fires, the expression is evaluated in the old context and passed along

14+1. a report relational expression for the post-change context: when the notification fires, the expression is evaluated in the new context and passed along

15By separating the "trigger" and "report" expressions, database users control what kind of reporting they receive when the outcome of a relational expression changes.

16By separating the "trigger" and "report" expressions, database users control what kind of reporting they receive when the outcome of a relational expression changes.

@@ -21,7 +22,7 @@ Currently, notifications are sent to all connected clients and not only to the c

21Notifications can be created in the ```tutd``` TutorialD interpreter with the following syntax:

22Notifications can be created in the ```tutd``` TutorialD interpreter with the following syntax:

23```

24```

24−notify <notification name> <trigger relational expression> <report relational expression>

25+notify <notification name> <trigger relational expression> <report relational expression (pre-change)> <report relational expression (post-change)>

25```

26```

27## Deleting a Notification

28## Deleting a Notification

@@ -39,21 +40,23 @@ Consider the following ```person``` relation variable where "name" is a key:

39```

40```

40TutorialD (master/main): person:=relation{tuple{name "Steve",address "Main St."},tuple{name "John", address "Elm St."}}

41TutorialD (master/main): person:=relation{tuple{name "Steve",address "Main St."},tuple{name "John", address "Elm St."}}

41TutorialD (master/main): :showexpr person

42TutorialD (master/main): :showexpr person

42−┌────────┬─────┐

43+┌─────────────┬──────────┐

43−│address │name │

44+│address::Text│name::Text│

44−├────────┼─────┤

45+├─────────────┼──────────┤

46+│"Main St." │"Steve" │

45−│Elm St. │John │

47+│"Elm St." │"John" │

46−│Main St.│Steve│

47−└────────┴─────┘

48+└─────────────┴──────────┘

48```

49```

50If a remote application is currently the address in the tuple for "Steve", then it would install a notification for that tuple's key:

51If a remote application is currently the address in the tuple for "Steve", then it would install a notification for that tuple's key:

52```

53```

53−TutorialD (master/main): notify steve_change person where name="Steve" (person where name="Steve"){address}

54+TutorialD (master/main): notify steve_change person where name="Steve" true (person where name="Steve"){address}

54TutorialD (master/main): :commit

55TutorialD (master/main): :commit

55```

56```

58+In this case, we pass `true` as the old context report expression because we plan to ignore the result.

59+

57Then, when any client including the initiating client updates the "Steve" tuple, an asynchronous notification is fired:

60Then, when any client including the initiating client updates the "Steve" tuple, an asynchronous notification is fired:

59```

62```

@@ -62,16 +65,17 @@ TutorialD (master/main): :commit

62TutorialD (master/main): Notification received "steve_change": ...

65TutorialD (master/main): Notification received "steve_change": ...

63```

66```

65−The asynchronously-received notification contains the result from the evaluated report relational expression. The expression, in this case, is the result of the report expression evaluated against the parent transactoin

68+The asynchronously-received notification contains the result from the evaluated report relational expression. The expression, in this case, is the result of the report expression evaluated against the new transaction:

67```

70```

68TutorialD (master/main): Notification received "steve_change":

71TutorialD (master/main): Notification received "steve_change":

69Project (AttributeNames (fromList ["address"])) (Restrict (AttributeEqualityPredicate "name" (NakedAtomExpr Atom "Steve")) (RelationVariable "person"))

72Project (AttributeNames (fromList ["address"])) (Restrict (AttributeEqualityPredicate "name" (NakedAtomExpr Atom "Steve")) (RelationVariable "person"))

70−┌────────┐

73+┌─────────────┐

71−│address │

74+│address::Text│

72−├────────┤

75+├─────────────┤

73−│Main St.│

76+│"Grove St." │

74−└────────┘

77+└─────────────┘

78+

75```

79```

77## Notifications with ProjectM36.Client

81## Notifications with ProjectM36.Client

@@ -80,10 +84,10 @@ First, implement a ```NotificationCallback``` function to perform an IO action w

81Each ProjectM36 Connection can only have one callback and it cannot be changed after Connection creation.

85Each ProjectM36 Connection can only have one callback and it cannot be changed after Connection creation.

83−Then, create a DatabaseExpr using the AddNotification constructor:

87+Then, create a DatabaseContextExpr using the AddNotification constructor:

85```

89```

86−AddNotification <notification name::Text> <change expression::RelationalExpr> <report expression::RelationalExpr>

90+AddNotification <notification name::Text> <change expression::RelationalExpr> <report old context expression::RelationalExpr> <report new context expression::RelationalExpr>

87```

91```

89and execute it using ```executeDatabaseContextExpr```. In order for a notification to take effect, it must be committed as well.

93and execute it using ```executeDatabaseContextExpr```. In order for a notification to take effect, it must be committed as well.

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+139−21

@@ -1,22 +1,41 @@

1-- a simple example of a blog schema

2−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, OverloadedStrings #-}

2+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, OverloadedStrings, CPP, DerivingVia #-}

4import ProjectM36.Client

5+import ProjectM36.Base

5import ProjectM36.Relation

6import ProjectM36.Relation

6import ProjectM36.Tupleable

7import ProjectM36.Tupleable

8+import ProjectM36.Atom (relationForAtom)

9+import ProjectM36.Tuple (atomForAttributeName)

8import Data.Either

11import Data.Either

9import GHC.Generics

12import GHC.Generics

10−import Data.Binary

11import qualified Data.Text as T

13import qualified Data.Text as T

14+import qualified Data.Text.Lazy as TL

12import Data.Time.Clock

15import Data.Time.Clock

13import Data.Time.Calendar

16import Data.Time.Calendar

14import Control.DeepSeq

17import Control.DeepSeq

18+import Data.Proxy

19+#if __GLASGOW_HASKELL__ < 804

20+import Data.Monoid

21+#endif

22+import Data.List

23+import Control.Monad (when, forM_)

24+import Codec.Winery

25+

26+import Web.Scotty as S

27+import Text.Blaze.Html5 (h1, h2, h3, p, form, input, (!), toHtml, Html, a, toValue, hr, textarea)

28+import Text.Blaze.Html5.Attributes (name, href, type_, method, action, value)

29+import Text.Blaze.Html.Renderer.Text

30+import Control.Monad.IO.Class (liftIO)

31+import Network.HTTP.Types.Status

32+import Data.Time.Format

16--define your data types

34--define your data types

17data Blog = Blog {

35data Blog = Blog {

18 title :: T.Text,

36 title :: T.Text,

37+ entry :: T.Text,

19− stamp :: UTCTime,

38+ tstamp :: UTCTime,

20 category :: Category --note that this type is an algebraic data type

39 category :: Category --note that this type is an algebraic data type

21 }

40 }

22 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

@@ -33,7 +52,8 @@ data Comment = Comment {

33instance Tupleable Comment

52instance Tupleable Comment

35data 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

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

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

39handleIOError :: Show e => IO (Either e a) -> IO a

59handleIOError :: Show e => IO (Either e a) -> IO a

@@ -63,41 +83,139 @@ main = do

64 createSchema sessionId conn

84 createSchema sessionId conn

65 insertSampleData sessionId conn

85 insertSampleData sessionId conn

86+ --create the web routes

87+ scotty 3000 $ do

66− executeSampleQueries sessionId conn

88+ S.get "/" (listBlogs sessionId conn)

89+ S.get "/blog/:blogid" (showBlogEntry sessionId conn)

90+ S.post "/comment" (addComment sessionId conn)

68--define the schema with the new Category atom (data) type, blog relvar, a comment relvar, and a foreign key relationship between them

92--define the schema with the new Category atom (data) type, blog relvar, a comment relvar, and a foreign key relationship between them

69createSchema :: SessionId -> Connection -> IO ()

93createSchema :: SessionId -> Connection -> IO ()

70createSchema sessionId conn = do

94createSchema sessionId conn = do

71 _ <- handleIOErrors $ mapM (executeDatabaseContextExpr sessionId conn) [

95 _ <- handleIOErrors $ mapM (executeDatabaseContextExpr sessionId conn) [

72− toAddTypeExpr (undefined :: Category),

96+ toAddTypeExpr (Proxy :: Proxy Category),

73− toDefineExpr (undefined :: Blog) "blog",

97+ toDefineExpr (Proxy :: Proxy Blog) "blog",

74− toDefineExpr (undefined :: Comment) "comment",

98+ toDefineExpr (Proxy :: Proxy Comment) "comment",

75− databaseContextExprForForeignKey "blog_comment" ("comment", ["blogTitle"]) ("blog", ["title"]) ]

99+ databaseContextExprForForeignKey "blog_comment" ("comment", ["blogTitle"]) ("blog", ["title"]),

100+ databaseContextExprForUniqueKey "blog" ["title"]

101+ ]

76 pure ()

102 pure ()

103

78--create some sample values and insert them into the database's relation variables

104--create some sample values and insert them into the database's relation variables

79insertSampleData :: SessionId -> Connection -> IO ()

105insertSampleData :: SessionId -> Connection -> IO ()

80insertSampleData sessionId conn = do

106insertSampleData sessionId conn = do

81− let blogs = [Blog { title = "Eat More Tofu",

107+ let blogs = [Blog { title = "Haskell Lenses",

108+ entry = "I wear Haskell rose-colored lenses.",

82− stamp = UTCTime (fromGregorian 2017 5 8) (secondsToDiffTime 1000),

109+ tstamp = UTCTime (fromGregorian 2017 5 8) (secondsToDiffTime 1000),

83 category = Food },

110 category = Food },

84− Blog { title = "Cat Falls Off Table",

111+ Blog { title = "Haskell Monad Analogy",

112+ entry = "Monads are like burritos going through intestines.",

85− stamp = UTCTime (fromGregorian 2017 6 10) (secondsToDiffTime 2000),

113+ tstamp = UTCTime (fromGregorian 2017 6 10) (secondsToDiffTime 2000),

86 category = Cats }

114 category = Cats }

87 ]

115 ]

88− comments = [Comment { blogTitle = "Cat Falls Off Table",

116+ comments = [Comment { blogTitle = "Haskell Lenses",

89 commentTime = UTCTime (fromGregorian 2017 7 8) (secondsToDiffTime 3000),

117 commentTime = UTCTime (fromGregorian 2017 7 8) (secondsToDiffTime 3000),

90− contents = "more cats please" }]

118+ contents = "You suck!" },

119+ Comment {blogTitle = "Haskell Lenses",

120+ commentTime = UTCTime (fromGregorian 2017 7 9) (secondsToDiffTime 2000),

121+ contents = "I find your ideas intriguing and would like to subscribe to your newsletter."}

122+ ]

91 insertBlogsExpr <- handleError $ toInsertExpr blogs "blog"

123 insertBlogsExpr <- handleError $ toInsertExpr blogs "blog"

92 handleIOError $ executeDatabaseContextExpr sessionId conn insertBlogsExpr

124 handleIOError $ executeDatabaseContextExpr sessionId conn insertBlogsExpr

125

94 insertCommentsExpr <- handleError $ toInsertExpr comments "comment"

126 insertCommentsExpr <- handleError $ toInsertExpr comments "comment"

95 handleIOError $ executeDatabaseContextExpr sessionId conn insertCommentsExpr

127 handleIOError $ executeDatabaseContextExpr sessionId conn insertCommentsExpr

128

97−--issue a query and marshal the data back to the original data value

129+-- handle relational errors with scotty

130+handleWebError :: Either RelationalError a -> ActionM a

131+handleWebError (Left err) = render500 (toHtml (show err)) >> pure (error "bad")

132+handleWebError (Right v) = pure v

133+

134+-- show a page with all the blog entries

135+listBlogs :: SessionId -> Connection -> ActionM ()

136+listBlogs sessionId conn = do

137+ eRel <- liftIO $ executeRelationalExpr sessionId conn (RelationVariable "blog" ())

138+ case eRel of

139+ Left err -> render500 (toHtml (show err))

140+ Right blogRel -> do

141+ blogs <- liftIO (toList blogRel) >>= mapM (handleWebError . fromTuple) :: ActionM [Blog]

142+ let sortedBlogs = sortBy (\b1 b2 -> tstamp b1 `compare` tstamp b2) blogs

143+ html . renderHtml $ do

144+ h1 "Blog Posts"

145+ forM_ sortedBlogs $ \blog -> a ! href (toValue $ "/blog/" <> title blog) $ h2 (toHtml (title blog))

146+

147+render500 :: Html -> ActionM ()

148+render500 msg = do

149+ html . renderHtml $ do

150+ h1 "Internal Server Error"

151+ p msg

152+ status internalServerError500

153+

154+--display one blog post along with its comments

155+showBlogEntry :: SessionId -> Connection -> ActionM ()

156+showBlogEntry sessionId conn = do

157+ blogid <- param "blogid"

158+ --query the database to return the blog entry with a relation-valued attribute of the associated comments

159+ let blogRestrictionExpr = AttributeEqualityPredicate "title" (NakedAtomExpr (TextAtom blogid))

160+ extendExpr = AttributeExtendTupleExpr "comments" (RelationAtomExpr commentsRestriction)

161+ commentsRestriction = Restrict

162+ (AttributeEqualityPredicate "blogTitle" (AttributeAtomExpr "title"))

163+ (RelationVariable "comment" ())

164+ eRel <- liftIO $ executeRelationalExpr sessionId conn (Extend extendExpr

165+ (Restrict

166+ blogRestrictionExpr

167+ (RelationVariable "blog" ())))

168+ let render = html . renderHtml

169+ formatStamp = formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S"))

170+ case eRel of

171+ Left err -> render500 (toHtml (show err))

172+ --handle successful query execution

173+ Right rel -> case singletonTuple rel of

174+ Nothing -> do --no results for this blog id

175+ render (h1 "No such blog post")

176+ status status404

177+ Just blogTuple -> case fromTuple blogTuple of --just one blog post found- it's a match!

178+ Left err -> render500 (toHtml (show err))

179+ Right blog -> do

180+ --extract comments for the blog

181+ commentsAtom <- handleWebError (atomForAttributeName "comments" blogTuple)

182+ commentsRel <- handleWebError (relationForAtom commentsAtom)

183+ comments <- liftIO (toList commentsRel) >>= mapM (handleWebError . fromTuple) :: ActionM [Comment]

184+ let commentsSorted = sortBy (\c1 c2 -> commentTime c1 `compare` commentTime c2) comments

185+ render $ do

186+ --show blog details

187+ h1 (toHtml (title blog))

188+ p (toHtml ("Posted at " <> formatStamp (tstamp blog) <> " under " <> show (category blog)))

189+ p (toHtml (entry blog))

190+ hr

191+ h3 "Comments"

192+ --list the comments

193+ forM_ commentsSorted $ \comment -> do

194+ p (toHtml ("Commented at " <> formatStamp (commentTime comment)))

195+ p (toHtml (contents comment))

196+ when (null comments) (p "No comments.")

197+ --add a comment form

198+ h3 "Add a Comment"

199+ form ! method "POST" ! action "/comment" $ do

200+ input ! type_ "hidden" ! name "blogid" ! value (toValue blogid)

201+ textarea ! name "contents" $ ""

202+ input ! type_ "submit"

203+

204+--add a comment to a blog post

98−executeSampleQueries :: SessionId -> Connection -> IO ()

205+addComment :: SessionId -> Connection -> ActionM ()

99−executeSampleQueries sessionId conn = do

206+addComment sessionId conn = do

100− commentsRelation <- handleIOError $ executeRelationalExpr sessionId conn (RelationVariable "comment" ())

207+ blogid <- param "blogid"

208+ commentText <- param "contents"

209+ now <- liftIO getCurrentTime

101

210

102− comments <- toList commentsRelation >>= mapM (handleError . fromTuple) :: IO [Comment]

211+ case toInsertExpr [Comment {blogTitle = blogid,

103− print comments

212+ commentTime = now,

213+ contents = commentText }] "comment" of

214+ Left err -> handleWebError (Left err)

215+ Right insertExpr -> do

216+ eRet <- liftIO (withTransaction sessionId conn (executeDatabaseContextExpr sessionId conn insertExpr) (commit sessionId conn))

217+ case eRet of

218+ Left err -> handleWebError (Left err)

219+ Right _ ->

220+ redirect (TL.fromStrict ("/blog/" <> blogid))

221+

examples/hair.hs+11−7

@@ -1,15 +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

9+import Data.Proxy

10+import Codec.Winery

11data Hair = Bald | Brown | Blond | OtherColor Text

12data Hair = Bald | Brown | Blond | OtherColor Text

12− deriving (Generic, Show, Eq, Binary, NFData, Atomable)

13+ deriving (Generic, Show, Eq, NFData, Atomable)

14+ deriving Serialise via WineryVariant Hair

14main :: IO ()

16main :: IO ()

15main = do

17main = do

@@ -26,15 +28,17 @@ main = do

26 sessionId <- eCheck $ createSessionAtHead conn "master"

28 sessionId <- eCheck $ createSessionAtHead conn "master"

28 --create the data type in the database context

30 --create the data type in the database context

29− eCheck $ executeDatabaseContextExpr sessionId conn (toAddTypeExpr (undefined :: Hair))

31+ eCheck $ executeDatabaseContextExpr sessionId conn (toAddTypeExpr (Proxy :: Proxy Hair))

31 --create a relation with the new Hair AtomType

33 --create a relation with the new Hair AtomType

32 let blond = NakedAtomExpr (toAtom Blond)

34 let blond = NakedAtomExpr (toAtom Blond)

33− eCheck $ executeDatabaseContextExpr sessionId conn (Assign "people" (MakeRelationFromExprs Nothing [

35+ eCheck $ executeDatabaseContextExpr sessionId conn

36+ (Assign "people"

37+ (MakeRelationFromExprs Nothing $ TupleExprs () [

34− TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))

38+ TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))

36 let restrictionPredicate = AttributeEqualityPredicate "hair" blond

40 let restrictionPredicate = AttributeEqualityPredicate "hair" blond

37 peopleRel <- eCheck $ executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "people" ()))

41 peopleRel <- eCheck $ executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "people" ()))

39 TIO.putStrLn (showRelation peopleRel)

43 TIO.putStrLn (showRelation peopleRel)

40−

44+

examples/out_of_the_tarpit.hs+22−17

@@ -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,10 +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

13+import Data.Proxy

14+import Codec.Winery

15--create various database value (atom) types

16--create various database value (atom) types

16type Price = Double

17type Price = Double

@@ -20,16 +21,20 @@ type Name = T.Text

20type Address = T.Text

21type Address = T.Text

22data RoomType = Kitchen | Bathroom | LivingRoom

23data RoomType = Kitchen | Bathroom | LivingRoom

23− deriving (Generic, Atomable, Eq, Show, Binary, NFData)

24+ deriving (Generic, Atomable, Eq, Show, NFData)

25+ deriving Serialise via WineryVariant RoomType

25data PriceBand = Low | Medium | High | Premium

27data PriceBand = Low | Medium | High | Premium

26− deriving (Generic, Atomable, Eq, Show, Binary, NFData)

28+ deriving (Generic, Atomable, Eq, Show, NFData)

29+ deriving Serialise via WineryVariant PriceBand

28data AreaCode = City | Suburban | Rural

31data AreaCode = City | Suburban | Rural

29− deriving (Generic, Atomable, Eq, Show, Binary, NFData)

32+ deriving (Generic, Atomable, Eq, Show, NFData)

33+ deriving Serialise via WineryVariant AreaCode

31data SpeedBand = VeryFastBand | FastBand | MediumBand | SlowBand

35data SpeedBand = VeryFastBand | FastBand | MediumBand | SlowBand

32− deriving (Generic, Atomable, Eq, Show, Binary, NFData)

36+ deriving (Generic, Atomable, Eq, Show, NFData)

37+ deriving Serialise via WineryVariant SpeedBand

34main :: IO ()

39main :: IO ()

35main = do

40main = do

@@ -142,17 +147,17 @@ createSchema sessionId conn = do

142 ]

147 ]

143 incDepForeignKeys = map (\(n, a, b) -> databaseContextExprForForeignKey n a b) foreignKeys

148 incDepForeignKeys = map (\(n, a, b) -> databaseContextExprForForeignKey n a b) foreignKeys

144 --define the relvars

149 --define the relvars

145− rvExprs = [toDefineExpr (undefined :: Property) "property",

150+ rvExprs = [toDefineExpr (Proxy :: Proxy Property) "property",

146− toDefineExpr (undefined :: Offer) "offer",

151+ toDefineExpr (Proxy :: Proxy Offer) "offer",

147− toDefineExpr (undefined :: Decision) "decision",

152+ toDefineExpr (Proxy :: Proxy Decision) "decision",

148− toDefineExpr (undefined :: Room) "room",

153+ toDefineExpr (Proxy :: Proxy Room) "room",

149− toDefineExpr (undefined :: Floor) "floor",

154+ toDefineExpr (Proxy :: Proxy Floor) "floor",

150− toDefineExpr (undefined :: Commission) "commission"]

155+ toDefineExpr (Proxy :: Proxy Commission) "commission"]

151 --create the new algebraic data types

156 --create the new algebraic data types

152− new_adts = [toAddTypeExpr (undefined :: RoomType),

157+ new_adts = [toAddTypeExpr (Proxy :: Proxy RoomType),

153− toAddTypeExpr (undefined :: PriceBand),

158+ toAddTypeExpr (Proxy :: Proxy PriceBand),

154− toAddTypeExpr (undefined :: AreaCode),

159+ toAddTypeExpr (Proxy :: Proxy AreaCode),

155− toAddTypeExpr (undefined :: SpeedBand)]

160+ toAddTypeExpr (Proxy :: Proxy SpeedBand)]

156 --create the stored atom functions

161 --create the stored atom functions

157 priceBandScript = "(\\(DoubleAtom price:_) -> do\n let band = if price < 10000.0 then \"Low\" else if price < 20000.0 then \"Medium\" else if price < 30000.0 then \"High\" else \"Premium\"\n let aType = ConstructedAtomType \"PriceBand\" empty\n pure (ConstructedAtom band aType [])) :: [Atom] -> Either AtomFunctionError Atom"

162 priceBandScript = "(\\(DoubleAtom price:_) -> do\n let band = if price < 10000.0 then \"Low\" else if price < 20000.0 then \"Medium\" else if price < 30000.0 then \"High\" else \"Premium\"\n let aType = ConstructedAtomType \"PriceBand\" empty\n pure (ConstructedAtom band aType [])) :: [Atom] -> Either AtomFunctionError Atom"

158 areaCodeScript = "(\\(TextAtom address:_) -> let aType = ConstructedAtomType \"AreaCode\" empty in if address == \"90210\" then pure (ConstructedAtom \"City\" aType []) else pure (ConstructedAtom \"Rural\" aType [])) :: [Atom] -> Either AtomFunctionError Atom"

163 areaCodeScript = "(\\(TextAtom address:_) -> let aType = ConstructedAtomType \"AreaCode\" empty in if address == \"90210\" then pure (ConstructedAtom \"City\" aType []) else pure (ConstructedAtom \"Rural\" aType [])) :: [Atom] -> Either AtomFunctionError Atom"

@@ -256,4 +261,4 @@ handleIOErrors m = do

256 [] -> pure (rights eErrs)

261 [] -> pure (rights eErrs)

257 errs -> handleError (Left (someErrors errs))

262 errs -> handleError (Left (someErrors errs))

258

263

259−

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+225−217

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

1+Cabal-Version: 2.2

1Name: project-m36

2Name: project-m36

2−Version: 0.2

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,64 +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− ,directory

52− ,vector-binary-instances

53− ,temporary

54− ,stm

55− ,time

56− ,hashable-time

57− ,old-locale

58− ,attoparsec

59− ,either

60− ,base64-bytestring

61− ,data-interval

62− ,extended-reals

63− ,network-transport

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

65− ,aeson >= 1.1

66− ,path-pieces

67− ,conduit

68− ,resourcet

69− ,http-api-data

70−--needed for remote access

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

72− ,distributed-process >= 0.6.6

73− ,distributed-process-extras >= 0.3.2

74− ,distributed-process-async >= 0.2.4

75− ,network-transport-tcp

76− ,network-transport

77− ,list-t

78− ,stm-containers >= 0.2.15

79− ,optparse-applicative

80− ,Glob

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

82− ,cryptohash-sha256

83 Exposed-Modules: ProjectM36.Error,

47 Exposed-Modules: ProjectM36.Error,

84 ProjectM36.Transaction,

48 ProjectM36.Transaction,

85 ProjectM36.TransactionGraph,

49 ProjectM36.TransactionGraph,

@@ -88,6 +52,9 @@ Library

88 ProjectM36.TransactionGraph.Merge,

52 ProjectM36.TransactionGraph.Merge,

89 ProjectM36.TransGraphRelationalExpression,

53 ProjectM36.TransGraphRelationalExpression,

90 ProjectM36.Base,

54 ProjectM36.Base,

55+ ProjectM36.Serialise.Base,

56+ ProjectM36.Serialise.Error,

57+ ProjectM36.DataFrame,

91 ProjectM36.Attribute,

58 ProjectM36.Attribute,

92 ProjectM36.AttributeNames,

59 ProjectM36.AttributeNames,

93 ProjectM36.Tuple,

60 ProjectM36.Tuple,

@@ -96,6 +63,7 @@ Library

96 ProjectM36.AtomFunction,

63 ProjectM36.AtomFunction,

97 ProjectM36.AtomFunctionError,

64 ProjectM36.AtomFunctionError,

98 ProjectM36.ScriptSession,

65 ProjectM36.ScriptSession,

66+ ProjectM36.Shortcuts,

99 ProjectM36.DatabaseContextFunction,

67 ProjectM36.DatabaseContextFunction,

100 ProjectM36.DatabaseContextFunctionError,

68 ProjectM36.DatabaseContextFunctionError,

101 ProjectM36.DatabaseContextFunctionUtils,

69 ProjectM36.DatabaseContextFunctionUtils,

@@ -109,26 +77,32 @@ Library

109 ProjectM36.Relation.Show.HTML,

77 ProjectM36.Relation.Show.HTML,

110 ProjectM36.StaticOptimizer,

78 ProjectM36.StaticOptimizer,

111 ProjectM36.Relation.Show.Term,

79 ProjectM36.Relation.Show.Term,

80+ ProjectM36.WCWidth,

112 ProjectM36.Relation.Show.CSV,

81 ProjectM36.Relation.Show.CSV,

113 ProjectM36.Relation.Show.Gnuplot,

82 ProjectM36.Relation.Show.Gnuplot,

114 ProjectM36.Relation.Parse.CSV,

83 ProjectM36.Relation.Parse.CSV,

115 ProjectM36.IsomorphicSchema,

84 ProjectM36.IsomorphicSchema,

116 ProjectM36.InclusionDependency,

85 ProjectM36.InclusionDependency,

86+ ProjectM36.MerkleHash,

117 ProjectM36.Client,

87 ProjectM36.Client,

118 ProjectM36.Client.Simple,

88 ProjectM36.Client.Simple,

119 ProjectM36.Persist,

89 ProjectM36.Persist,

120 ProjectM36.AtomType,

90 ProjectM36.AtomType,

91+ ProjectM36.AttributeExpr,

121 ProjectM36.AtomFunctions.Basic,

92 ProjectM36.AtomFunctions.Basic,

122 ProjectM36.AtomFunctions.Primitive,

93 ProjectM36.AtomFunctions.Primitive,

123 ProjectM36.Atomable,

94 ProjectM36.Atomable,

124 ProjectM36.Tupleable,

95 ProjectM36.Tupleable,

96+ ProjectM36.Tupleable.Deriving,

125 ProjectM36.DataConstructorDef,

97 ProjectM36.DataConstructorDef,

126 ProjectM36.DataTypes.Basic,

98 ProjectM36.DataTypes.Basic,

99+ ProjectM36.DataTypes.Sorting,

127 ProjectM36.DataTypes.Day,

100 ProjectM36.DataTypes.Day,

128 ProjectM36.DataTypes.DateTime,

101 ProjectM36.DataTypes.DateTime,

129 ProjectM36.DataTypes.Either,

102 ProjectM36.DataTypes.Either,

130 ProjectM36.DataTypes.Maybe,

103 ProjectM36.DataTypes.Maybe,

131 ProjectM36.DataTypes.List,

104 ProjectM36.DataTypes.List,

105+ ProjectM36.DataTypes.NonEmptyList,

132 ProjectM36.DataTypes.Primitive,

106 ProjectM36.DataTypes.Primitive,

133 ProjectM36.DataTypes.Interval,

107 ProjectM36.DataTypes.Interval,

134 ProjectM36.DataTypes.ByteString,

108 ProjectM36.DataTypes.ByteString,

@@ -140,30 +114,42 @@ Library

140 ProjectM36.Server.EntryPoints,

114 ProjectM36.Server.EntryPoints,

141 ProjectM36.Server.ParseArgs,

115 ProjectM36.Server.ParseArgs,

142 ProjectM36.Server.RemoteCallTypes,

116 ProjectM36.Server.RemoteCallTypes,

117+ ProjectM36.Serialise.AtomFunctionError,

118+ ProjectM36.Serialise.DataFrame,

119+ ProjectM36.Serialise.DatabaseContextFunctionError,

120+ ProjectM36.Serialise.IsomorphicSchema,

143 ProjectM36.Session,

121 ProjectM36.Session,

144 ProjectM36.Sessions,

122 ProjectM36.Sessions,

145 ProjectM36.Transaction.Persist,

123 ProjectM36.Transaction.Persist,

146 ProjectM36.TypeConstructor,

124 ProjectM36.TypeConstructor,

147 ProjectM36.TypeConstructorDef,

125 ProjectM36.TypeConstructorDef,

148− ProjectM36.FileLock

126+ ProjectM36.FileLock,

127+ ProjectM36.FSType,

128+ ProjectM36.Arbitrary,

129+ ProjectM36.GraphRefRelationalExpr,

130+ ProjectM36.NormalizeExpr,

131+ ProjectM36.TransactionInfo,

132+ ProjectM36.WithNameExpr

149− GHC-Options: -Wall

133+ GHC-Options: -Wall -rdynamic

150 if os(windows)

134 if os(windows)

151− Build-Depends: Win32 >= 2.3

135+ Build-Depends: Win32 >= 2.5.4.1

152 Other-Modules: ProjectM36.Win32Handle

136 Other-Modules: ProjectM36.Win32Handle

153 else

137 else

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

139+ GHC-Options: -rdynamic -fexternal-interpreter

154− C-sources: cbits/DirectoryFsync.c

140+ C-sources: cbits/DirectoryFsync.c, cbits/darwin_statfs.c

155 Build-Depends: unix

141 Build-Depends: unix

156 CC-Options: -fPIC

142 CC-Options: -fPIC

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

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

158 Default-Language: Haskell2010

144 Default-Language: Haskell2010

159 Default-Extensions: OverloadedStrings, CPP

145 Default-Extensions: OverloadedStrings, CPP

160− if impl(ghc>= 8)

146+ if !flag(stack)

161− build-depends:

147+ Build-Depends: deferred-folds

162− ghc-boot

163

148

164Executable tutd

149Executable tutd

150+ if flag(haskell-scripting)

151+ Build-Depends: ghc >= 8.2 && < 8.11

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

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

166− ghc >= 7.8 && < 8.3,

167 ghc-paths,

153 ghc-paths,

168 project-m36,

154 project-m36,

169 containers,

155 containers,

@@ -177,13 +163,11 @@ Executable tutd

177 MonadRandom, MonadRandom,

163 MonadRandom, MonadRandom,

178 vector,

164 vector,

179 text,

165 text,

180− vector-binary-instances,

181 time,

166 time,

182 hashable-time,

167 hashable-time,

183 bytestring,

168 bytestring,

184 stm,

169 stm,

185 deepseq,

170 deepseq,

186− binary,

187 data-interval,

171 data-interval,

188 parallel,

172 parallel,

189 cassava,

173 cassava,

@@ -191,14 +175,23 @@ Executable tutd

191 directory,

175 directory,

192 filepath,

176 filepath,

193 temporary,

177 temporary,

194− megaparsec >= 5.2.0 && < 5.4,

178+ megaparsec >= 5.2.0 && < 10,

195 haskeline,

179 haskeline,

196 random, MonadRandom,

180 random, MonadRandom,

197 base64-bytestring,

181 base64-bytestring,

198 optparse-applicative,

182 optparse-applicative,

199 attoparsec,

183 attoparsec,

200− stm-containers,

184+ stm-containers >= 1.0.0,

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

202 Other-Modules: TutorialD.Interpreter,

195 Other-Modules: TutorialD.Interpreter,

203 TutorialD.Interpreter.Base,

196 TutorialD.Interpreter.Base,

204 TutorialD.Interpreter.DatabaseContextExpr,

197 TutorialD.Interpreter.DatabaseContextExpr,

@@ -217,27 +210,21 @@ Executable tutd

217 TutorialD.Interpreter.SchemaOperator,

210 TutorialD.Interpreter.SchemaOperator,

218 TutorialD.Interpreter.TransGraphRelationalOperator,

211 TutorialD.Interpreter.TransGraphRelationalOperator,

219 TutorialD.Interpreter.SchemaOperator

212 TutorialD.Interpreter.SchemaOperator

213+ TutorialD.Printer

220 main-is: TutorialD/tutd.hs

214 main-is: TutorialD/tutd.hs

221 CC-Options: -fPIC

215 CC-Options: -fPIC

222− GHC-Options: -Wall

216+ GHC-Options: -Wall -threaded

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

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

224 Default-Language: Haskell2010

218 Default-Language: Haskell2010

225 Default-Extensions: OverloadedStrings

219 Default-Extensions: OverloadedStrings

226−-- if os(windows)

227−-- Build-Depends: Win32 >= 2.3 && < 2.4

228−-- Other-Modules: ProjectM36.Win32Handle

229−-- else

230−-- C-sources: ProjectM36/DirectoryFsync.c

231−-- Build-Depends: unix

232−

233

220

234Executable project-m36-server

221Executable project-m36-server

222+ if flag(haskell-scripting)

223+ Build-Depends: ghc >= 8.2 && < 8.11

235 Build-Depends: base,

224 Build-Depends: base,

236− ghc >= 7.8 && < 8.3,

237 ghc-paths,

225 ghc-paths,

238− project-m36,

239− binary,

240 transformers,

226 transformers,

227+ project-m36,

241 temporary,

228 temporary,

242 data-interval,

229 data-interval,

243 deepseq,

230 deepseq,

@@ -250,7 +237,6 @@ Executable project-m36-server

250 optparse-applicative,

237 optparse-applicative,

251 hashable-time,

238 hashable-time,

252 time,

239 time,

253− vector-binary-instances,

254 text,

240 text,

255 deepseq-generics,

241 deepseq-generics,

256 mtl,

242 mtl,

@@ -272,7 +258,7 @@ Executable project-m36-server

272Executable bigrel

258Executable bigrel

273 Default-Language: Haskell2010

259 Default-Language: Haskell2010

274 Default-Extensions: OverloadedStrings

260 Default-Extensions: OverloadedStrings

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

276 Other-Modules: TutorialD.Interpreter.Base,

262 Other-Modules: TutorialD.Interpreter.Base,

277 TutorialD.Interpreter.DatabaseContextExpr,

263 TutorialD.Interpreter.DatabaseContextExpr,

278 TutorialD.Interpreter.RelationalExpr,

264 TutorialD.Interpreter.RelationalExpr,

@@ -283,224 +269,246 @@ Executable bigrel

283 if flag(profiler)

269 if flag(profiler)

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

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

285

271

286−Test-Suite test-tutoriald

272+Common commontest

287 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

288 Default-Extensions: OverloadedStrings

275 Default-Extensions: OverloadedStrings

289− type: exitcode-stdio-1.0

290− main-is: test/TutorialD/Interpreter.hs

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

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

293− GHC-Options: -Wall

276+ GHC-Options: -Wall -threaded

294− Hs-Source-Dirs: ./src/bin, ., test

277+ Hs-Source-Dirs: test, src/bin

295

278

296−Test-Suite test-tutoriald-atomfunctionscript

279+Benchmark basic-benchmark

297 Default-Language: Haskell2010

280 Default-Language: Haskell2010

298 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

299 type: exitcode-stdio-1.0

304 type: exitcode-stdio-1.0

305+ main-is: TutorialD/InterpreterTest.hs

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

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

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

308+

303− GHC-Options: -Wall

309+Test-Suite test-tutoriald-atomfunctionscript

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

305

314

306Test-Suite test-tutoriald-databasecontextfunctionscript

315Test-Suite test-tutoriald-databasecontextfunctionscript

307− Default-Language: Haskell2010

316+ import: commontest

308− Default-Extensions: OverloadedStrings

309 type: exitcode-stdio-1.0

317 type: exitcode-stdio-1.0

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

311− main-is: test/TutorialD/Interpreter/DatabaseContextFunctionScript.hs

319+ main-is: TutorialD/Interpreter/DatabaseContextFunctionScript.hs

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

313− GHC-Options: -Wall

314− Hs-Source-Dirs: ./src/bin, ./test, .

315

320

316Test-Suite test-relation

321Test-Suite test-relation

317− Default-Language: Haskell2010

322+ import: commontest

318− Default-Extensions: OverloadedStrings

319 type: exitcode-stdio-1.0

323 type: exitcode-stdio-1.0

320− main-is: test/Relation/Basic.hs

324+ main-is: Relation/Basic.hs

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

322− GHC-Options: -Wall

323

325

324Test-Suite test-static-optimizer

326Test-Suite test-static-optimizer

325− Default-Language: Haskell2010

327+ import: commontest

326− Default-Extensions: OverloadedStrings

327 type: exitcode-stdio-1.0

328 type: exitcode-stdio-1.0

328− main-is: test/Relation/StaticOptimizer.hs

329+ main-is: Relation/StaticOptimizer.hs

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

330− GHC-Options: -Wall

331

330

332Test-Suite test-transactiongraph-persist

331Test-Suite test-transactiongraph-persist

333− Default-Language: Haskell2010

332+ import: commontest

334− Default-Extensions: OverloadedStrings

335 type: exitcode-stdio-1.0

333 type: exitcode-stdio-1.0

336− main-is: test/TransactionGraph/Persist.hs

334+ main-is: TransactionGraph/Persist.hs

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

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

339− Hs-Source-Dirs: ., ./src/bin

340− GHC-Options: -Wall

341

336

342Test-Suite test-relation-import-csv

337Test-Suite test-relation-import-csv

343− Default-Language: Haskell2010

338+ import: commontest

344− Default-Extensions: OverloadedStrings

345 type: exitcode-stdio-1.0

339 type: exitcode-stdio-1.0

346− main-is: test/Relation/Import/CSV.hs

340+ main-is: Relation/Import/CSV.hs

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

348− GHC-Options: -Wall

349

341

350Test-Suite test-tutoriald-import-tutoriald

342Test-Suite test-tutoriald-import-tutoriald

351− Default-Language: Haskell2010

343+ import: commontest

352− Default-Extensions: OverloadedStrings

353 type: exitcode-stdio-1.0

344 type: exitcode-stdio-1.0

354− main-is: test/TutorialD/Interpreter/Import/TutorialD.hs

345+ main-is: TutorialD/Interpreter/Import/ImportTest.hs

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

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

357− GHC-Options: -Wall

358− Hs-Source-Dirs: ., ./src/bin

359

347

360Test-Suite test-relation-export-csv

348Test-Suite test-relation-export-csv

361− Default-Language: Haskell2010

349+ import: commontest

362− Default-Extensions: OverloadedStrings

363 type: exitcode-stdio-1.0

350 type: exitcode-stdio-1.0

364− main-is: test/Relation/Export/CSV.hs

351+ main-is: Relation/Export/CSV.hs

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

366− GHC-Options: -Wall

367

352

368Test-Suite test-transactiongraph-merge

353Test-Suite test-transactiongraph-merge

369− Default-Language: Haskell2010

354+ import: commontest

370− Default-Extensions: OverloadedStrings

355+ type: exitcode-stdio-1.0

356+ main-is: TransactionGraph/Merge.hs

357+

358+

359+Test-Suite test-prettyprinter

360+ import: commontest

371 type: exitcode-stdio-1.0

361 type: exitcode-stdio-1.0

372− main-is: test/TransactionGraph/Merge.hs

362+ main-is: TutorialD/PrinterTest.hs

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

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

374− GHC-Options: -Wall

375

364

376benchmark bench

365benchmark bench

377− Default-Language: Haskell2010

366+ import: commontest

378− Default-Extensions: OverloadedStrings

379 type: exitcode-stdio-1.0

367 type: exitcode-stdio-1.0

380 main-is: benchmark/Relation.hs

368 main-is: benchmark/Relation.hs

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

382− GHC-Options: -Wall -rtsopts

383− Hs-Source-Dirs: ./src/bin

384

369

385Test-Suite test-server

370Test-Suite test-server

386− Default-Language: Haskell2010

371+ import: commontest

387− Default-Extensions: OverloadedStrings

388 type: exitcode-stdio-1.0

372 type: exitcode-stdio-1.0

389− main-is: test/Server/Main.hs

373+ main-is: Server/Main.hs

390− 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+

391− HS-Source-Dirs: ., ./src/bin

392− GHC-Options: -Wall

393

375

394Executable Example-SimpleClient

376Executable Example-SimpleClient

395 Default-Language: Haskell2010

377 Default-Language: Haskell2010

396 Default-Extensions: OverloadedStrings

378 Default-Extensions: OverloadedStrings

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

398 Main-Is: examples/SimpleClient.hs

380 Main-Is: examples/SimpleClient.hs

399− GHC-Options: -Wall

381+ GHC-Options: -Wall -threaded

400

382

401Executable Example-OutOfTheTarpit

383Executable Example-OutOfTheTarpit

402 Default-Language: Haskell2010

384 Default-Language: Haskell2010

403 Default-Extensions: OverloadedStrings

385 Default-Extensions: OverloadedStrings

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

405 Main-Is: examples/out_of_the_tarpit.hs

387 Main-Is: examples/out_of_the_tarpit.hs

406− GHC-Options: -Wall

388+ GHC-Options: -Wall -threaded

407

389

408Executable Example-Blog

390Executable Example-Blog

409 Default-Language: Haskell2010

391 Default-Language: Haskell2010

410 Default-Extensions: OverloadedStrings

392 Default-Extensions: OverloadedStrings

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

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

412 Main-Is: examples/blog.hs

394 Main-Is: examples/blog.hs

413− GHC-Options: -Wall

395+ GHC-Options: -Wall -threaded

414−

415

396

416Executable Example-Hair

397Executable Example-Hair

417 Default-Language: Haskell2010

398 Default-Language: Haskell2010

418 Default-Extensions: OverloadedStrings

399 Default-Extensions: OverloadedStrings

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

420 Main-Is: examples/hair.hs

401 Main-Is: examples/hair.hs

421− GHC-Options: -Wall

402+ GHC-Options: -Wall -threaded

422

403

423−Test-Suite test-scripts

404+Executable Example-Plantfarm

424 Default-Language: Haskell2010

405 Default-Language: Haskell2010

425 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

426 type: exitcode-stdio-1.0

430 type: exitcode-stdio-1.0

427− main-is: test/scripts.hs

431+ main-is: scripts.hs

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

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

430− GHC-Options: -Wall

431− Hs-Source-Dirs: ., ./src/bin

432

433

433Executable project-m36-websocket-server

434Executable project-m36-websocket-server

434 Default-Language: Haskell2010

435 Default-Language: Haskell2010

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

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

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

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

438− GHC-Options: -Wall

439+ GHC-Options: -Wall -threaded

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

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

440 Default-Extensions: OverloadedStrings

441 Default-Extensions: OverloadedStrings

441

442

442Test-Suite test-websocket-server

443Test-Suite test-websocket-server

443− Default-Language: Haskell2010

444+ import: commontest

444 type: exitcode-stdio-1.0

445 type: exitcode-stdio-1.0

445− main-is: test/Server/WebSocket.hs

446+ main-is: Server/WebSocket.hs

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

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

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

448− Default-Extensions: OverloadedStrings

449− GHC-Options: -Wall

450− Hs-Source-Dirs: ./src/bin, .

451

448

452Test-Suite test-isomorphic-schemas

449Test-Suite test-isomorphic-schemas

453− Default-Language: Haskell2010

450+ import: commontest

454 type: exitcode-stdio-1.0

451 type: exitcode-stdio-1.0

455− main-is: test/IsomorphicSchema.hs

452+ main-is: IsomorphicSchema.hs

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

457− Default-Extensions: OverloadedStrings

458− GHC-Options: -Wall

459− Hs-Source-Dirs: ./src/bin, .

460

453

461Test-Suite test-atomable

454Test-Suite test-atomable

462− Default-Language: Haskell2010

455+ import: commontest

463 type: exitcode-stdio-1.0

456 type: exitcode-stdio-1.0

464− main-is: test/Relation/Atomable.hs

457+ main-is: Relation/Atomable.hs

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

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

467− Default-Extensions: OverloadedStrings

468− GHC-Options: -Wall

469− Hs-Source-Dirs: ./src/bin, ., test/

470

459

471Test-Suite test-multiprocess-access

460Test-Suite test-multiprocess-access

472− Default-Language: Haskell2010

461+ import: commontest

473 type: exitcode-stdio-1.0

462 type: exitcode-stdio-1.0

474− main-is: test/MultiProcessDatabaseAccess.hs

463+ main-is: MultiProcessDatabaseAccess.hs

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

476− Default-Extensions: OverloadedStrings

477− GHC-Options: -Wall

478− Hs-Source-Dirs: ./src/bin, ., test/

479

464

480Test-Suite test-transactiongraph-automerge

465Test-Suite test-transactiongraph-automerge

481− Default-Language: Haskell2010

466+ import: commontest

482 type: exitcode-stdio-1.0

467 type: exitcode-stdio-1.0

483− main-is: test/TransactionGraph/Automerge.hs

468+ main-is: TransactionGraph/Automerge.hs

484− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, 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

485− Default-Extensions: OverloadedStrings

486− GHC-Options: -Wall

487− Hs-Source-Dirs: ./src/bin, ., test/

488

470

489Test-Suite test-tupleable

471Test-Suite test-tupleable

490− Default-Language: Haskell2010

472+ import: commontest

491 type: exitcode-stdio-1.0

473 type: exitcode-stdio-1.0

492− main-is: test/Relation/Tupleable.hs

474+ main-is: Relation/Tupleable.hs

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

494− Default-Extensions: OverloadedStrings

495− GHC-Options: -Wall

496− Hs-Source-Dirs: ./src/bin, ., test/

497

475

498Test-Suite test-client-simple

476Test-Suite test-client-simple

499− Default-Language: Haskell2010

477+ import: commontest

500− Main-Is: test/Client/Simple.hs

478+ Main-Is: Client/Simple.hs

501 type: exitcode-stdio-1.0

479 type: exitcode-stdio-1.0

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

480+

481+-- test for file handle leaks

482+Executable handles

483+ Default-Language: Haskell2010

503 Default-Extensions: OverloadedStrings

484 Default-Extensions: OverloadedStrings

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

486+ main-is: benchmark/Handles.hs

487+ Other-Modules: TutorialD.Interpreter,

488+ TutorialD.Interpreter.Base,

489+ TutorialD.Interpreter.DatabaseContextExpr,

490+ TutorialD.Interpreter.DatabaseContextIOOperator,

491+ TutorialD.Interpreter.Export.Base,

492+ TutorialD.Interpreter.Export.CSV,

493+ TutorialD.Interpreter.Import.Base,

494+ TutorialD.Interpreter.Import.BasicExamples,

495+ TutorialD.Interpreter.Import.CSV,

496+ TutorialD.Interpreter.Import.TutorialD,

497+ TutorialD.Interpreter.InformationOperator,

498+ TutorialD.Interpreter.RODatabaseContextOperator,

499+ TutorialD.Interpreter.RelationalExpr,

500+ TutorialD.Interpreter.SchemaOperator,

501+ TutorialD.Interpreter.TransGraphRelationalOperator,

502+ TutorialD.Interpreter.TransactionGraphOperator,

503+ TutorialD.Interpreter.Types

504+ TutorialD.Printer

504− GHC-Options: -Wall

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

505− Hs-Source-Dirs: ./src/bin, ., test/

506+ HS-Source-Dirs: ./src/bin

507+ if flag(profiler)

508+ GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall

506

509

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+55−8

@@ -10,7 +10,7 @@

10* @param {promptCallback} promptCallback - A function called whenever prompt information such as the current schema name and current branch name (if any).

11* @param {closeCallback} closeCallback - A function called once the connection is closed.

12*/

13−var ProjectM36Connection = function (protocol, host, port, path, dbname, openCallback, errorCallback, statusCallback, promptCallback, closeCallback) {

13+var ProjectM36Connection = function (protocol, host, port, path, dbname, openCallback, errorCallback, statusCallback, promptCallback, notificationCallback, closeCallback) {

14 this.protocol = protocol;

15 this.host = host;

16 this.port = port;

@@ -44,6 +44,7 @@ var ProjectM36Connection = function (protocol, host, port, path, dbname, openCal

44 };

45 this.statuscallback = statusCallback;

46 this.promptcallback = promptCallback;

47+ this.notificationcallback = notificationCallback;

47 this.socket = socket;

48 this.socket = socket;

48}

49}

@@ -54,9 +55,10 @@ var ProjectM36Connection = function (protocol, host, port, path, dbname, openCal

54* @param {Object} acknowledgementresult - The status update containing an acknowledgement that the query was executed or null.

55* @param {Object} acknowledgementresult - The status update containing an acknowledgement that the query was executed or null.

55* @param {Object} errorResult - The status update containing the error information or null.

56* @param {Object} errorResult - The status update containing the error information or null.

56*/

57*/

57−var ProjectM36Status = function (relationResult, acknowledgementResult, errorResult)

58+var ProjectM36Status = function (relationResult, dataFrameResult, acknowledgementResult, errorResult)

58{

59{

59 this.relation = relationResult;

60 this.relation = relationResult;

61+ this.dataframe = dataFrameResult;

60 this.acknowledgement = acknowledgementResult;

62 this.acknowledgement = acknowledgementResult;

61 this.error = errorResult;

63 this.error = errorResult;

62}

64}

@@ -74,18 +76,25 @@ ProjectM36Connection.prototype.readyState = function()

74ProjectM36Connection.prototype.handleResponse = function(message)

76ProjectM36Connection.prototype.handleResponse = function(message)

75{

77{

76 var relation = message["displayrelation"];

78 var relation = message["displayrelation"];

79+ var dataframe = message["displaydataframe"];

77 var acknowledged = message["acknowledged"];

80 var acknowledged = message["acknowledged"];

78 var error = message["displayerror"];

81 var error = message["displayerror"];

79 var prompt = message["promptInfo"];

82 var prompt = message["promptInfo"];

83+ var notification = message["notificationname"]

81 if(relation)

85 if(relation)

82 {

86 {

83− 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));

84 }

93 }

86 if(acknowledged)

95 if(acknowledged)

87 {

96 {

88− this.statuscallback(new ProjectM36Status(null, true, null));

97+ this.statuscallback(new ProjectM36Status(null, null, true, null));

89 }

98 }

91 if(error)

100 if(error)

@@ -94,13 +103,19 @@ ProjectM36Connection.prototype.handleResponse = function(message)

94 {

103 {

95 error=error.tag; // for error objects

104 error=error.tag; // for error objects

96 }

105 }

97− this.statuscallback(new ProjectM36Status(null, null, error));

106+ this.statuscallback(new ProjectM36Status(null, null, null, error['json']));

98 }

107 }

108

100 if(prompt)

109 if(prompt)

101 {

110 {

102 this.promptcallback(prompt["headname"], prompt["schemaname"]);

111 this.promptcallback(prompt["headname"], prompt["schemaname"]);

103 }

112 }

113+

114+ if(notification)

115+ {

116+ var evaldnotif = message.evaldnotification;

117+ this.notificationcallback(message.notificationname, evaldnotif);

118+ }

104}

119}

105

120

106/**

121/**

@@ -109,7 +124,7 @@ ProjectM36Connection.prototype.handleResponse = function(message)

109*/

124*/

110ProjectM36Connection.prototype.executeTutorialD = function(tutd)

125ProjectM36Connection.prototype.executeTutorialD = function(tutd)

111{

126{

112− this.socket.send("executetutd:" + tutd);

127+ this.socket.send("executetutd/json:" + tutd);

113}

128}

114

129

115/**

130/**

@@ -153,6 +168,7 @@ ProjectM36Connection.prototype.generateAtomType = function(attr)

153{

168{

154 var atomType = attr[1]["tag"];

169 var atomType = attr[1]["tag"];

155 var attrName = attr[0];

170 var attrName = attr[0];

171+ var accessory = attr[2];

156 var element = document.createElement("span");

172 var element = document.createElement("span");

157 element.textContent = attrName + "::";

173 element.textContent = attrName + "::";

158 if (atomType == "RelationAtomType")

174 if (atomType == "RelationAtomType")

@@ -177,7 +193,11 @@ ProjectM36Connection.prototype.generateAtomType = function(attr)

177 var readableType = atomType.slice(0,-8);

193 var readableType = atomType.slice(0,-8);

178 element.textContent += readableType;

194 element.textContent += readableType;

179 }

195 }

196+ if(accessory)

197+ {

198+ element.textContent += accessory;

199+ }

180− return element

200+ return element;

181}

201}

182

202

183ProjectM36Connection.prototype.generateRelationBody = function (body)

203ProjectM36Connection.prototype.generateRelationBody = function (body)

@@ -222,6 +242,33 @@ ProjectM36Connection.prototype.generateAtom = function(atom)

222 return element;

242 return element;

223}

243}

224

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+

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

226function mungeEmptyRows()

273function mungeEmptyRows()

227{

274{

@@ -241,4 +288,4 @@ function mungeEmptyRows()

241 empty.appendChild(dudHeader);

288 empty.appendChild(dudHeader);

242 }

289 }

243 }

290 }

244−}

291+}

src/bin/ProjectM36/Server/WebSocket/websocket-client.html+3−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"/>

@@ -123,9 +123,10 @@ margin-bottom: 5pt;

123 <span>Try our <a href="https://github.com/agentm/project-m36/blob/master/docs/15_minute_tutorial.markdown">15 minute TutorialD Tutorial</a> or click these sample queries below:</span>

124</span>

125 <ul id="samples">

126+ <li>:showrelvars</li>

126 <li>:showexpr true</li>

127 <li>:showexpr true</li>

127 <li>:showexpr false</li>

128 <li>:showexpr false</li>

128− <li>:importexample date</li>

129+ <li>:importexample cjdate</li>

129 <li>:showexpr s join sp</li>

130 <li>:showexpr s join sp</li>

130 <li>update s where city="Paris" (status:=10)</li>

131 <li>update s where city="Paris" (status:=10)</li>

131 <li>:showexpr s</li>

132 <li>:showexpr s</li>

src/bin/ProjectM36/Server/WebSocket/websocket-client.js+50−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");

@@ -49,6 +55,48 @@ function promptUpdate(headName, schemaName)

49 document.getElementById("promptinfo").textContent = "Current Branch: (" + headName + ") Schema: (" + schemaName + ")";

55 document.getElementById("promptinfo").textContent = "Current Branch: (" + headName + ") Schema: (" + schemaName + ")";

50}

56}

58+function relationErrorAsString(errObj)

59+{

60+ return errObj.tag + " " + errObj.contents;

61+}

62+

63+function notificationUpdate(notificationName, evaldNotif)

64+{

65+ //generate two tables for display

66+ var notifDiv = document.createElement('div');

67+ var oldInfo = document.createElement('div');

68+ oldInfo.textContent = "Pre-change info: ";

69+ var newInfo = document.createElement('div');

70+ newInfo.textContent = "Post-change info: ";

71+ var status = "Notification received: " + notificationName;

72+

73+ if(evaldNotif.reportOldRelation.Left)

74+ {

75+ var errOld = evaldNotif.reportOldRelation.Left;

76+ oldInfo.textContent += relationErrorAsString(errOld);

77+ }

78+ else if(evaldNotif.reportOldRelation.Right)

79+ {

80+ oldInfo.appendChild(conn.generateRelation(evaldNotif.reportOldRelation.Right));

81+ }

82+

83+ if(evaldNotif.reportNewRelation.Left)

84+ {

85+ var errNew = evaldNotif.reportNewRelation.Left;

86+ newInfo.textContent += relationErrorAsString(errNew);

87+ }

88+ else if(evaldNotif.reportNewRelation.Right)

89+ {

90+ newInfo.appendChild(conn.generateRelation(evaldNotif.reportNewRelation.Right));

91+ }

92+

93+ notifDiv.appendChild(oldInfo);

94+ notifDiv.appendChild(document.createElement('br'));

95+ notifDiv.appendChild(newInfo);

96+ appendResult(status,notifDiv);

97+ mungeEmptyRows();

98+}

99+

52var conn;

100var conn;

101

54function connectOrDisconnect(form)

102function connectOrDisconnect(form)

@@ -82,6 +130,7 @@ function connectOrDisconnect(form)

82 connectionError,

130 connectionError,

83 updateStatus,

131 updateStatus,

84 promptUpdate,

132 promptUpdate,

133+ notificationUpdate,

85 connectionClosed);

134 connectionClosed);

86 toggleConnectionFields(form, false, "Connecting...");

135 toggleConnectionFields(form, false, "Connecting...");

87 }

136 }

@@ -210,4 +259,4 @@ function pageload()

210{

259{

211 installSampleHandlers();

260 installSampleHandlers();

212 setupDefaultConfig();

261 setupDefaultConfig();

213−}

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+101−49

@@ -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,14 +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

34+import Data.List (isPrefixOf)

34import Control.Exception

35import Control.Exception

36+import System.Exit

37+import Data.Either (fromRight)

36{-

39{-

37context 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)

@@ -59,7 +62,7 @@ interpreterParserP = safeInterpreterParserP <|>

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

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

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

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

61 fmap DatabaseContextIOExprOp (dbContextIOExprP <* eof)

64 fmap DatabaseContextIOExprOp (dbContextIOExprP <* eof)

62−

65+

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

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

64safeInterpreterParserP :: Parser ParsedOperation

67safeInterpreterParserP :: Parser ParsedOperation

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

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

@@ -75,50 +78,86 @@ safeInterpreterParserP = fmap RODatabaseContextOp (roDatabaseContextOperatorP <*

75promptText :: Either RelationalError HeadName -> Either RelationalError SchemaName -> StringType

78promptText :: Either RelationalError HeadName -> Either RelationalError SchemaName -> StringType

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

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

77 where

80 where

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

81+ transInfo = fromRight "<unknown>" eHeadName <> "/" <> fromRight "<no schema>" eSchemaName

79−

82+

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

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

81parseTutorialD = parse interpreterParserP ""

84parseTutorialD = parse interpreterParserP ""

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

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

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

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

85safeParseTutorialD = parse safeInterpreterParserP ""

88safeParseTutorialD = parse safeInterpreterParserP ""

87data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)

90data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)

89−--execute the operation and display result

92+type InteractiveConsole = Bool

93+

90evalTutorialD :: C.SessionId -> C.Connection -> SafeEvaluationFlag -> ParsedOperation -> IO TutorialDOperatorResult

94evalTutorialD :: C.SessionId -> C.Connection -> SafeEvaluationFlag -> ParsedOperation -> IO TutorialDOperatorResult

91−evalTutorialD sessionId conn safe expr = case expr of

95+evalTutorialD sessionId conn safe = evalTutorialDInteractive sessionId conn safe False

96+

97+--execute the operation and display result

98+evalTutorialDInteractive :: C.SessionId -> C.Connection -> SafeEvaluationFlag -> InteractiveConsole -> ParsedOperation -> IO TutorialDOperatorResult

99+evalTutorialDInteractive sessionId conn safe interactive expr = case expr of

92 --this does not pass through the ProjectM36.Client library because the operations

100 --this does not pass through the ProjectM36.Client library because the operations

93 --are specific to the interpreter, though some operations may be of general use in the future

101 --are specific to the interpreter, though some operations may be of general use in the future

94− (RODatabaseContextOp execOp) ->

102+ (RODatabaseContextOp execOp) -> do

95− evalRODatabaseContextOp sessionId conn execOp

103+ res <- evalRODatabaseContextOp sessionId conn execOp

96−

104+ case res of

105+ QuitResult -> if safe == UnsafeEvaluation && interactive then

106+ putStrLn "Goodbye." >> exitSuccess

107+ else

108+ pure res

109+ _ -> pure res

110+

97− (DatabaseContextExprOp execOp) ->

111+ (DatabaseContextExprOp execOp) ->

98− eHandler $ C.executeDatabaseContextExpr sessionId conn execOp

112+ eHandler $ C.executeDatabaseContextExpr sessionId conn execOp

99−

113+

100− (DatabaseContextIOExprOp execOp) ->

114+ (DatabaseContextIOExprOp execOp) ->

101 if needsSafe then

115 if needsSafe then

102 unsafeError

116 unsafeError

103 else

117 else

104 eHandler $ C.executeDatabaseContextIOExpr sessionId conn execOp

118 eHandler $ C.executeDatabaseContextIOExpr sessionId conn execOp

105−

119+

106− (GraphOp execOp) ->

120+ (GraphOp execOp) -> do

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

122+ eIsDirty <- C.disconnectedTransactionIsDirty sessionId conn

107− eHandler $ C.executeGraphExpr sessionId conn execOp

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

108−

124+ settings = Settings {complete = noCompletion,

125+ historyFile = Nothing,

126+ autoAddHistory = False}

127+ case eIsDirty of

128+ Left err -> barf err

129+ Right False -> runGraphOp

130+ Right True -> do

131+ cancel <- runInputT settings $ do

132+ let promptDiscardChanges = do

133+ isatty <- haveTerminalUI

134+ if isatty && interactive && execOp /= Commit && execOp /= Rollback then do

135+ mYesOrNo <- getInputLine "The current transaction has uncommitted changes. If you continue, the changes will be lost. Continue? (Y/n): "

136+ case mYesOrNo of

137+ Nothing -> promptDiscardChanges

138+ Just "" -> promptDiscardChanges

139+ Just yesOrNo -> pure (not ("Y" `isPrefixOf` yesOrNo))

140+ else

141+ pure False

142+ promptDiscardChanges

143+ if cancel then

144+ pure (DisplayErrorResult "Graph operation cancelled.")

145+ else

146+ runGraphOp

147+

109 (ConvenienceGraphOp execOp) ->

148 (ConvenienceGraphOp execOp) ->

110 eHandler $ evalConvenienceGraphOp sessionId conn execOp

149 eHandler $ evalConvenienceGraphOp sessionId conn execOp

111

150

112 (ROGraphOp execOp) -> do

151 (ROGraphOp execOp) -> do

113 opResult <- evalROGraphOp sessionId conn execOp

152 opResult <- evalROGraphOp sessionId conn execOp

114− case opResult of

153+ case opResult of

115 Left err -> barf err

154 Left err -> barf err

116 Right rel -> pure (DisplayRelationResult rel)

155 Right rel -> pure (DisplayRelationResult rel)

117−

156+

118 (SchemaOp execOp) ->

157 (SchemaOp execOp) ->

119 eHandler $ evalSchemaOperator sessionId conn execOp

158 eHandler $ evalSchemaOperator sessionId conn execOp

120−

159+

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

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

122 if needsSafe then

161 if needsSafe then

123 unsafeError

162 unsafeError

124 else do

163 else do

@@ -128,12 +167,16 @@ evalTutorialD sessionId conn safe expr = case expr of

128 case eImportType of

167 case eImportType of

129 Left err -> barf err

168 Left err -> barf err

130 Right importType -> do

169 Right importType -> do

131− exprErr <- evalRelVarDataImportOperator execOp (attributes importType)

170+ eTConsMap <- C.typeConstructorMapping sessionId conn

132− case exprErr of

171+ case eTConsMap of

133 Left err -> barf err

172 Left err -> barf err

173+ Right tConsMap -> do

174+ exprErr <- evalRelVarDataImportOperator execOp tConsMap (attributes importType)

175+ case exprErr of

176+ Left err -> barf err

134− Right dbexpr -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexpr)

177+ Right dbexpr -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexpr)

135−

178+

136− (ImportDBContextOp execOp) ->

179+ (ImportDBContextOp execOp) ->

137 if needsSafe then

180 if needsSafe then

138 unsafeError

181 unsafeError

139 else do

182 else do

@@ -141,15 +184,15 @@ evalTutorialD sessionId conn safe expr = case expr of

141 case eErr of

184 case eErr of

142 Left err -> barf err

185 Left err -> barf err

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

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

144−

187+

145− (InfoOp execOp) ->

188+ (InfoOp execOp) ->

146 if needsSafe then

189 if needsSafe then

147 unsafeError

190 unsafeError

148 else

191 else

149 case evalInformationOperator execOp of

192 case evalInformationOperator execOp of

150 Left err -> pure (DisplayErrorResult err)

193 Left err -> pure (DisplayErrorResult err)

151 Right info -> pure (DisplayResult info)

194 Right info -> pure (DisplayResult info)

152−

195+

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

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

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

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

155 if needsSafe then

198 if needsSafe then

@@ -173,26 +216,29 @@ evalTutorialD sessionId conn safe expr = case expr of

173 unsafeError = pure $ DisplayErrorResult "File I/O operation prohibited."

216 unsafeError = pure $ DisplayErrorResult "File I/O operation prohibited."

174 barf :: RelationalError -> IO TutorialDOperatorResult

217 barf :: RelationalError -> IO TutorialDOperatorResult

175 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)

176 barf err = return $ DisplayErrorResult (T.pack (show err))

220 barf err = return $ DisplayErrorResult (T.pack (show err))

177 eHandler io = do

221 eHandler io = do

178 eErr <- io

222 eErr <- io

179 case eErr of

223 case eErr of

180 Left err -> barf err

224 Left err -> barf err

181 Right () -> return QuietSuccessResult

225 Right () -> return QuietSuccessResult

182−

226+

183−type GhcPkgPath = String

227+type GhcPkgPath = String

184type TutorialDExec = String

228type TutorialDExec = String

185−

229+type CheckFS = Bool

230+

186−data InterpreterConfig = LocalInterpreterConfig PersistenceStrategy HeadName (Maybe TutorialDExec) [GhcPkgPath] |

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

187− RemoteInterpreterConfig C.NodeId C.DatabaseName HeadName (Maybe TutorialDExec)

232+ RemoteInterpreterConfig C.Hostname C.Port C.DatabaseName HeadName (Maybe TutorialDExec) CheckFS

188

233

189outputNotificationCallback :: C.NotificationCallback

234outputNotificationCallback :: C.NotificationCallback

190−outputNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received " ++ show notName ++ ":\n" ++ show (reportExpr (C.notification evaldNot)) ++ "\n" ++ prettyEvaluatedNotification evaldNot

235+outputNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received " ++ show notName ++ ":\n" ++ "\n" ++ prettyEvaluatedNotification evaldNot

191

236

192prettyEvaluatedNotification :: C.EvaluatedNotification -> String

237prettyEvaluatedNotification :: C.EvaluatedNotification -> String

193−prettyEvaluatedNotification eNotif = case C.reportRelation eNotif of

238+prettyEvaluatedNotification eNotif = let eRelShow eRel = case eRel of

194− Left err -> show err

239+ Left err -> show err

195− Right reportRel -> T.unpack (showRelation reportRel)

240+ Right reportRel -> T.unpack (showRelation reportRel) in

241+ eRelShow (C.reportOldRelation eNotif) <> "\n" <> eRelShow (C.reportNewRelation eNotif)

196

242

197reprLoop :: InterpreterConfig -> C.SessionId -> C.Connection -> IO ()

243reprLoop :: InterpreterConfig -> C.SessionId -> C.Connection -> IO ()

198reprLoop config sessionId conn = do

244reprLoop config sessionId conn = do

@@ -201,20 +247,26 @@ reprLoop config sessionId conn = do

201 eHeadName <- C.headName sessionId conn

247 eHeadName <- C.headName sessionId conn

202 eSchemaName <- C.currentSchemaName sessionId conn

248 eSchemaName <- C.currentSchemaName sessionId conn

203 let prompt = promptText eHeadName eSchemaName

249 let prompt = promptText eHeadName eSchemaName

250+ catchInterrupt = handleJust (\case

251+ UserInterrupt -> Just Nothing

252+ _ -> Nothing) (\_ -> do

253+ hPutStrLn stderr "Statement cancelled. Use \":quit\" to exit tutd."

254+ pure (Just ""))

204− maybeLine <- runInputT settings $ getInputLine (T.unpack prompt)

255+ maybeLine <- catchInterrupt $ runInputT settings $ getInputLine (T.unpack prompt)

205 case maybeLine of

256 case maybeLine of

206 Nothing -> return ()

257 Nothing -> return ()

207 Just line -> do

258 Just line -> do

208− runTutorialD sessionId conn (T.pack line)

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

209 reprLoop config sessionId conn

260 reprLoop config sessionId conn

210

261

262+

211−runTutorialD :: C.SessionId -> C.Connection -> T.Text -> IO ()

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

212−runTutorialD sessionId conn tutd = do

264+runTutorialD sessionId conn mPromptLength tutd =

213 case parseTutorialD tutd of

265 case parseTutorialD tutd of

214− Left err ->

266+ Left err ->

215− displayOpResult $ DisplayParseErrorResult 0 err

267+ displayOpResult $ DisplayParseErrorResult mPromptLength err

216 Right parsed ->

268 Right parsed ->

217 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

218− evald <- evalTutorialD sessionId conn UnsafeEvaluation parsed

270+ evald <- evalTutorialDInteractive sessionId conn UnsafeEvaluation True parsed

219 displayOpResult evald)

271 displayOpResult evald)

220 (\_ -> displayOpResult (DisplayErrorResult "Request timed out."))

272 (\_ -> displayOpResult (DisplayErrorResult "Request timed out."))

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

@@ -1,56 +1,99 @@

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

34 gen <- newStdGen

62 gen <- newStdGen

35 let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen

63 let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen

36 TIO.putStrLn (showRelation randomlySortedRel)

64 TIO.putStrLn (showRelation randomlySortedRel)

37−displayOpResult (DisplayParseErrorResult promptLength err) = TIO.putStrLn pointyString >> TIO.putStr ("ERR:" <> errString)

65+displayOpResult (DisplayParseErrorResult mPromptLength err) = do

38− where

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

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

39− errString = T.pack (parseErrorPretty err)

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

69+#else

40− errorIndent = unPos (sourceColumn (NE.head (errorPos err)))

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

71+ errString = T.pack (parseErrorPretty err)

72+#endif

41− pointyString = T.justifyRight (promptLength + fromIntegral errorIndent) '_' "^"

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

42−

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

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

76+displayOpResult (DisplayDataFrameResult dFrame) = TIO.putStrLn (showDataFrame dFrame)

77+

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

43spaceConsumer :: Parser ()

86spaceConsumer :: Parser ()

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

87+spaceConsumer = Lex.space space1 (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")

45−

88+

46opChar :: Parser Char

89opChar :: Parser Char

47opChar = 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

49−reserved :: String -> Parser ()

92+reserved :: ParseStr -> Parser ()

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

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

52−reservedOp :: String -> Parser ()

95+reservedOp :: ParseStr -> Parser ()

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

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

55parens :: Parser a -> Parser a

98parens :: Parser a -> Parser a

56parens = between (symbol "(") (symbol ")")

99parens = between (symbol "(") (symbol ")")

@@ -61,12 +104,20 @@ braces = between (symbol "{") (symbol "}")

61identifier :: Parser Text

104identifier :: Parser Text

62identifier = do

105identifier = do

63 istart <- letterChar <|> char '_'

106 istart <- letterChar <|> char '_'

107+ identifierRemainder istart

108+

109+identifierRemainder :: Char -> Parser Text

110+identifierRemainder c = do

64− irest <- many (alphaNumChar <|> char '_' <|> char '#')

111+ rest <- many (alphaNumChar <|> char '_' <|> char '#')

65 spaceConsumer

112 spaceConsumer

66− pure (pack (istart:irest))

113+ pure (pack (c:rest))

114

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

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

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

120+#endif

121

71comma :: Parser Text

122comma :: Parser Text

72comma = symbol ","

123comma = symbol ","

@@ -86,65 +137,80 @@ arrow = symbol "->"

86semi :: Parser Text

137semi :: Parser Text

87semi = symbol ";"

138semi = symbol ";"

139

89−{-

140+nline :: Parser Text

90−whiteSpace :: Parser ()

141+nline = (T.singleton <$> newline) <|> crlf

91−whiteSpace = Token.whiteSpace lexer

92−-}

142

94integer :: Parser Integer

143integer :: Parser Integer

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

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

146+#else

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

97float :: Parser Double

157float :: Parser Double

98−float = Lex.float

158+float = Lex.float <* spaceConsumer

159

100capitalizedIdentifier :: Parser Text

160capitalizedIdentifier :: Parser Text

101−capitalizedIdentifier = do

161+capitalizedIdentifier =

102− fletter <- upperChar

162+ upperChar >>= identifierRemainder

103− restOfIdentifier_ fletter

163+

104−

105−restOfIdentifier_ :: Char -> Parser Text

106−restOfIdentifier_ fletter = do

107− rest <- option "" identifier

108− spaceConsumer

109− pure (T.cons fletter rest)

110−

111uncapitalizedIdentifier :: Parser Text

164uncapitalizedIdentifier :: Parser Text

112−uncapitalizedIdentifier = do

165+uncapitalizedIdentifier =

113− fletter <- lowerChar

166+ lowerChar >>= identifierRemainder

114− restOfIdentifier_ fletter

115

167

116showRelationAttributes :: Attributes -> Text

168showRelationAttributes :: Attributes -> Text

117showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ L.map showAttribute attrsL) <> "}"

169showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ L.map showAttribute attrsL) <> "}"

118 where

170 where

119− showAttribute (Attribute name atomType) = name <> " " <> prettyAtomType atomType

171+ showAttribute (Attribute name atomType') = name <> " " <> prettyAtomType atomType'

120− attrsL = V.toList attrs

172+ attrsL = A.toList attrs

173+

174+type PromptLength = Int

175+

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

121

183

122data TutorialDOperatorResult = QuitResult |

184data TutorialDOperatorResult = QuitResult |

123 DisplayResult StringType |

185 DisplayResult StringType |

124 DisplayIOResult (IO ()) |

186 DisplayIOResult (IO ()) |

125 DisplayRelationResult Relation |

187 DisplayRelationResult Relation |

188+ DisplayDataFrameResult DataFrame |

126 DisplayErrorResult StringType |

189 DisplayErrorResult StringType |

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

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

128 QuietSuccessResult

191 QuietSuccessResult

129 deriving (Generic)

192 deriving (Generic)

130−

193+

131type TransactionGraphWasUpdated = Bool

194type TransactionGraphWasUpdated = Bool

132

195

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

134tripleQuotedString :: Parser Text

197tripleQuotedString :: Parser Text

135tripleQuotedString = do

198tripleQuotedString = do

136 _ <- tripleQuote

199 _ <- tripleQuote

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

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

138−

201+

139normalQuotedString :: Parser Text

202normalQuotedString :: Parser Text

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

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

141

204

142quotedString :: Parser Text

205quotedString :: Parser Text

143quotedString = try tripleQuotedString <|> normalQuotedString

206quotedString = try tripleQuotedString <|> normalQuotedString

144

207

208+quoted :: Parser a -> Parser a

209+quoted = between quote quote

210+

145uuidP :: Parser U.UUID

211uuidP :: Parser U.UUID

146uuidP = do

212uuidP = do

147− uuidStart <- count 8 hexDigitChar

213+ uuidStart <- count 8 hexDigitChar

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

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

149 uuidMid1 <- count 4 hexDigitChar

215 uuidMid1 <- count 4 hexDigitChar

150 _ <- char '-'

216 _ <- char '-'

@@ -163,5 +229,17 @@ utcTimeP = do

163 timeStr <- quotedString

229 timeStr <- quotedString

164 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

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

166− 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'))

167

245

src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs+36−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

@@ -153,14 +147,13 @@ addNotificationP = do

153 reserved "notify"

147 reserved "notify"

154 notName <- identifier

148 notName <- identifier

155 triggerExpr <- relExprP

149 triggerExpr <- relExprP

156− resultExpr <- relExprP

150+ resultOldExpr <- relExprP

157− pure $ AddNotification notName triggerExpr resultExpr

151+ AddNotification notName triggerExpr resultOldExpr <$> relExprP

158

152

159removeNotificationP :: Parser DatabaseContextExpr

153removeNotificationP :: Parser DatabaseContextExpr

160removeNotificationP = do

154removeNotificationP = do

161 reserved "unnotify"

155 reserved "unnotify"

162− notName <- identifier

156+ RemoveNotification <$> identifier

163− pure $ RemoveNotification notName

164

157

165-- | data Hair = Bald | Color Text

158-- | data Hair = Bald | Color Text

166addTypeConstructorP :: Parser DatabaseContextExpr

159addTypeConstructorP :: Parser DatabaseContextExpr

@@ -174,7 +167,7 @@ addTypeConstructorP = do

174removeTypeConstructorP :: Parser DatabaseContextExpr

167removeTypeConstructorP :: Parser DatabaseContextExpr

175removeTypeConstructorP = do

168removeTypeConstructorP = do

176 reserved "undata"

169 reserved "undata"

177− RemoveTypeConstructor <$> identifier

170+ RemoveTypeConstructor <$> typeConstructorNameP

178

171

179removeAtomFunctionP :: Parser DatabaseContextExpr

172removeAtomFunctionP :: Parser DatabaseContextExpr

180removeAtomFunctionP = do

173removeAtomFunctionP = do

@@ -186,28 +179,35 @@ removeDatabaseContextFunctionP = do

186 reserved "removedatabasecontextfunction"

179 reserved "removedatabasecontextfunction"

187 RemoveDatabaseContextFunction <$> quotedString

180 RemoveDatabaseContextFunction <$> quotedString

188

181

182+functionNameP :: Parser AtomFunctionName

183+functionNameP = uncapitalizedIdentifier

184+

189executeDatabaseContextFunctionP :: Parser DatabaseContextExpr

185executeDatabaseContextFunctionP :: Parser DatabaseContextExpr

190executeDatabaseContextFunctionP = do

186executeDatabaseContextFunctionP = do

191 reserved "execute"

187 reserved "execute"

192− funcName <- identifier

188+ funcName <- functionNameP

193 args <- parens (sepBy atomExprP comma)

189 args <- parens (sepBy atomExprP comma)

194 pure (ExecuteDatabaseContextFunction funcName args)

190 pure (ExecuteDatabaseContextFunction funcName args)

195

191

196databaseExprOpP :: Parser DatabaseContextExpr

192databaseExprOpP :: Parser DatabaseContextExpr

197databaseExprOpP = multipleDatabaseContextExprP

193databaseExprOpP = multipleDatabaseContextExprP

198

194

195+{-

199evalDatabaseContextExpr :: Bool -> DatabaseContext -> DatabaseContextExpr -> Either RelationalError DatabaseContext

196evalDatabaseContextExpr :: Bool -> DatabaseContext -> DatabaseContextExpr -> Either RelationalError DatabaseContext

200evalDatabaseContextExpr useOptimizer context expr = do

197evalDatabaseContextExpr useOptimizer context expr = do

201 optimizedExpr <- evalState (applyStaticDatabaseOptimization expr) (RE.freshDatabaseState context)

198 optimizedExpr <- evalState (applyStaticDatabaseOptimization expr) (RE.freshDatabaseState context)

202 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

203− (Nothing, (context',_, _)) -> Right context'

200+ (Right (), (context',_, _)) -> Right context'

204− (Just err, _) -> Left err

201+ (Left err, _) -> Left err

205−

202+-}

206

203

207−interpretDatabaseContextExpr :: DatabaseContext -> T.Text -> Either RelationalError DatabaseContext

204+interpretDatabaseContextExpr :: DatabaseContext -> TransactionId -> TransactionGraph -> T.Text -> Either RelationalError DatabaseContext

208−interpretDatabaseContextExpr context tutdstring = case parse databaseExprOpP "" tutdstring of

205+interpretDatabaseContextExpr context transId graph tutdstring =

206+ case parse databaseExprOpP "" tutdstring of

209− Left err -> Left $ PM36E.ParseError (T.pack (show err))

207+ Left err -> Left $ PM36E.ParseError (T.pack (show err))

210− 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)

211

212{-

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+14−6

@@ -1,24 +1,32 @@

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

7−data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr))

12+data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> TypeConstructorMapping -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr))

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

20−evalRelVarDataImportOperator :: RelVarDataImportOperator -> Attributes -> IO (Either RelationalError DatabaseContextExpr)

28+evalRelVarDataImportOperator :: RelVarDataImportOperator -> TypeConstructorMapping -> Attributes -> IO (Either RelationalError DatabaseContextExpr)

21−evalRelVarDataImportOperator (RelVarDataImportOperator relVarName path importFunc) attrs = importFunc relVarName attrs path

29+evalRelVarDataImportOperator (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+9−9

@@ -1,23 +1,23 @@

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

4import ProjectM36.Error

5import ProjectM36.Error

5−import ProjectM36.Relation.Parse.CSV

6+import 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

12−importCSVRelation :: RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr)

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

13−importCSVRelation relVarName attrs pathIn = do

13+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 csvData' attrs of

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+112−74

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

@@ -150,26 +176,23 @@ restrictionPredicateP = makeExprParser predicateTerm predicateOperators

150 predicateTerm = try (parens restrictionPredicateP)

176 predicateTerm = try (parens restrictionPredicateP)

151 <|> try restrictionAtomExprP

177 <|> try restrictionAtomExprP

152 <|> try restrictionAttributeEqualityP

178 <|> try restrictionAttributeEqualityP

153− <|> try relationalBooleanExprP

179+ <|> relationalBooleanExprP

154−

155

180

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

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

157−relationalBooleanExprP = do

182+relationalBooleanExprP =

158− relexpr <- parens relExprP <|> relTerm

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

160− return $ RelationalExprPredicate relexpr

184+ RelationalExprPredicate <$> (parens relExprP <|> relTerm)

161−

185+

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

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

163restrictionAttributeEqualityP = do

187restrictionAttributeEqualityP = do

164− attributeName <- identifier

188+ attributeName <- attributeNameP

165 reservedOp "="

189 reservedOp "="

166− atomexpr <- atomExprP

167− return $ AttributeEqualityPredicate attributeName atomexpr

190+ AttributeEqualityPredicate attributeName <$> atomExprP

168

191

169restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"

192restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"

170restrictionAtomExprP = do

193restrictionAtomExprP = do

171 _ <- char '^' -- not ideal, but allows me to continue to use a context-free grammar

194 _ <- char '^' -- not ideal, but allows me to continue to use a context-free grammar

172− AtomExprPredicate <$> atomExprP

195+ (try (char 't') >> pure TruePredicate) <|> (try (char 'f') >> pure (NotPredicate TruePredicate)) <|> AtomExprPredicate <$> atomExprP

173

196

174multiTupleExpressionP :: RelationalMarkerExpr a => Parser [ExtendTupleExprBase a]

197multiTupleExpressionP :: RelationalMarkerExpr a => Parser [ExtendTupleExprBase a]

175multiTupleExpressionP = sepBy extendTupleExpressionP comma

198multiTupleExpressionP = sepBy extendTupleExpressionP comma

@@ -179,10 +202,9 @@ extendTupleExpressionP = attributeExtendTupleExpressionP

179

202

180attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)

203attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)

181attributeExtendTupleExpressionP = do

204attributeExtendTupleExpressionP = do

182− newAttr <- identifier

205+ newAttr <- attributeNameP

183 reservedOp ":="

206 reservedOp ":="

184− atom <- atomExprP

185− return $ AttributeExtendTupleExpr newAttr atom

207+ AttributeExtendTupleExpr newAttr <$> atomExprP

186

208

187atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

209atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

188atomExprP = consumeAtomExprP True

210atomExprP = consumeAtomExprP True

@@ -192,38 +214,34 @@ consumeAtomExprP consume = try functionAtomExprP <|>

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

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

193 constructedAtomExprP consume <|>

215 constructedAtomExprP consume <|>

194 attributeAtomExprP <|>

216 attributeAtomExprP <|>

195− nakedAtomExprP <|>

217+ try nakedAtomExprP <|>

196 relationalAtomExprP

218 relationalAtomExprP

219+

197

220

198attributeAtomExprP :: Parser (AtomExprBase a)

221attributeAtomExprP :: Parser (AtomExprBase a)

199attributeAtomExprP = do

222attributeAtomExprP = do

200 _ <- string "@"

223 _ <- string "@"

201− attrName <- identifier

224+ AttributeAtomExpr <$> attributeNameP

202− return $ AttributeAtomExpr attrName

203

225

204nakedAtomExprP :: Parser (AtomExprBase a)

226nakedAtomExprP :: Parser (AtomExprBase a)

205nakedAtomExprP = NakedAtomExpr <$> atomP

227nakedAtomExprP = NakedAtomExpr <$> atomP

206

228

207constructedAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)

229constructedAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)

208constructedAtomExprP consume = do

230constructedAtomExprP consume = do

209− dConsName <- capitalizedIdentifier

231+ dConsName <- dataConstructorNameP

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

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

211− marker <- parseMarkerP

212− pure $ ConstructedAtomExpr dConsName dConsArgs marker

233+ ConstructedAtomExpr dConsName dConsArgs <$> parseMarkerP

213−

234+

214-- used only for primitive type parsing ?

235-- used only for primitive type parsing ?

215atomP :: Parser Atom

236atomP :: Parser Atom

216−atomP = stringAtomP <|>

237+atomP = stringAtomP <|>

217− doubleAtomP <|>

238+ try doubleAtomP <|>

218− integerAtomP <|>

239+ integerAtomP <|>

219 boolAtomP

240 boolAtomP

220−

241+

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

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

222−functionAtomExprP = do

243+functionAtomExprP =

223− funcName <- identifier

224− argList <- parens (sepBy atomExprP comma)

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

225− marker <- parseMarkerP

226− return $ FunctionAtomExpr funcName argList marker

227

245

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

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

229relationalAtomExprP = RelationAtomExpr <$> relExprP

247relationalAtomExprP = RelationAtomExpr <$> relExprP

@@ -231,16 +249,36 @@ relationalAtomExprP = RelationAtomExpr <$> relExprP

231stringAtomP :: Parser Atom

249stringAtomP :: Parser Atom

232stringAtomP = TextAtom <$> quotedString

250stringAtomP = TextAtom <$> quotedString

233

251

234−doubleAtomP :: Parser Atom

252+doubleAtomP :: Parser Atom

235−doubleAtomP = DoubleAtom <$> try float

253+doubleAtomP = DoubleAtom <$> float

236

254

237integerAtomP :: Parser Atom

255integerAtomP :: Parser Atom

238integerAtomP = IntegerAtom <$> integer

256integerAtomP = IntegerAtom <$> integer

239

257

240boolAtomP :: Parser Atom

258boolAtomP :: Parser Atom

241boolAtomP = do

259boolAtomP = do

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

260+ v <- identifier

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

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

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

244−

263+ else

264+ fail "invalid boolAtom"

265+

266+

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

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

246relationAtomExprP = 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+59−66

@@ -2,83 +2,65 @@

2import TutorialD.Interpreter

3import ProjectM36.Base

4import ProjectM36.Client

5+import ProjectM36.Server.ParseArgs

6+import ProjectM36.Server

5import System.IO

7import System.IO

8+import GHC.IO.Encoding

6import Options.Applicative

9import Options.Applicative

7import System.Exit

10import System.Exit

11+import Control.Monad

12+#if __GLASGOW_HASKELL__ < 804

8import Data.Monoid

13import Data.Monoid

14+#endif

15+import Data.Maybe

9import 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+

11parseArgs :: Parser InterpreterConfig

23parseArgs :: Parser InterpreterConfig

12−parseArgs = LocalInterpreterConfig <$> parsePersistenceStrategy <*> parseHeadName <*> parseTutDExec <*> parseGhcPkgPaths <|>

24+parseArgs = LocalInterpreterConfig <$> parsePersistenceStrategy <*> parseHeadName <*> parseTutDExec <*> many parseGhcPkgPath <*> parseCheckFS <|>

13− RemoteInterpreterConfig <$> parseNodeId <*> parseDatabaseName <*> parseHeadName <*> parseTutDExec

25+ RemoteInterpreterConfig <$> parseHostname "127.0.0.1" <*> parsePort defaultServerPort <*> parseDatabaseName <*> parseHeadName <*> parseTutDExec <*> parseCheckFS

15−parsePersistenceStrategy :: Parser PersistenceStrategy

16−parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>

17− MinimalPersistence <$> dbdirOpt <|>

18− pure NoPersistence

19− where

20− dbdirOpt = strOption (short 'd' <>

21− long "database-directory" <>

22− metavar "DIRECTORY" <>

23− showDefaultWith show

24− )

25− fsyncOpt = switch (short 'f' <>

26− long "fsync" <>

27− help "Fsync all new transactions.")

28−

29parseHeadName :: Parser HeadName

27parseHeadName :: Parser HeadName

30parseHeadName = option auto (long "head" <>

28parseHeadName = option auto (long "head" <>

31 help "Start session at head name." <>

29 help "Start session at head name." <>

30+ metavar "GRAPH HEAD NAME" <>

32 value "master"

31 value "master"

33 )

32 )

34−

33+

35−parseDatabaseName :: Parser DatabaseName

36−parseDatabaseName = strOption (long "database" <>

37− short 'n' <>

38− help "Remote database name")

39−

40−parseNodeId :: Parser NodeId

41−parseNodeId = createNodeId <$>

42− strOption (long "host" <>

43− short 'h' <>

44− help "Remote host name" <>

45− value "127.0.0.1") <*>

46− option auto (long "port" <>

47− short 'p' <>

48− help "Remote port" <>

49− value defaultServerPort)

50−

51--just execute some tutd and exit

34--just execute some tutd and exit

52parseTutDExec :: Parser (Maybe TutorialDExec)

35parseTutDExec :: Parser (Maybe TutorialDExec)

53parseTutDExec = optional $ strOption (long "exec-tutd" <>

36parseTutDExec = optional $ strOption (long "exec-tutd" <>

54 short 'e' <>

37 short 'e' <>

38+ metavar "TUTORIALD" <>

55 help "Execute TutorialD expression and exit"

39 help "Execute TutorialD expression and exit"

56 )

40 )

57−

58−parseGhcPkgPaths :: Parser [GhcPkgPath]

59−parseGhcPkgPaths = many (strOption (long "ghc-pkg-dir" <>

60− metavar "GHC_PACKAGE_DIRECTORY"))

62opts :: ParserInfo InterpreterConfig

42opts :: ParserInfo InterpreterConfig

63−opts = info parseArgs idm

43+opts = info (parseArgs <**> helpOption) idm

65connectionInfoForConfig :: InterpreterConfig -> ConnectionInfo

45connectionInfoForConfig :: InterpreterConfig -> ConnectionInfo

66−connectionInfoForConfig (LocalInterpreterConfig pStrategy _ _ ghcPkgPaths) = InProcessConnectionInfo pStrategy outputNotificationCallback ghcPkgPaths

46+connectionInfoForConfig (LocalInterpreterConfig pStrategy _ _ ghcPkgPaths _) = InProcessConnectionInfo pStrategy outputNotificationCallback ghcPkgPaths

67−connectionInfoForConfig (RemoteInterpreterConfig remoteNodeId remoteDBName _ _) = RemoteProcessConnectionInfo remoteDBName remoteNodeId outputNotificationCallback

47+connectionInfoForConfig (RemoteInterpreterConfig remoteHost remotePort remoteDBName _ _ _) = RemoteConnectionInfo remoteDBName remoteHost (show remotePort) outputNotificationCallback

69headNameForConfig :: InterpreterConfig -> HeadName

49headNameForConfig :: InterpreterConfig -> HeadName

70−headNameForConfig (LocalInterpreterConfig _ headn _ _) = headn

50+headNameForConfig (LocalInterpreterConfig _ headn _ _ _) = headn

71−headNameForConfig (RemoteInterpreterConfig _ _ headn _) = headn

51+headNameForConfig (RemoteInterpreterConfig _ _ _ headn _ _) = headn

73execTutDForConfig :: InterpreterConfig -> Maybe String

53execTutDForConfig :: InterpreterConfig -> Maybe String

74−execTutDForConfig (LocalInterpreterConfig _ _ t _) = t

54+execTutDForConfig (LocalInterpreterConfig _ _ t _ _) = t

75−execTutDForConfig (RemoteInterpreterConfig _ _ _ t) = t

55+execTutDForConfig (RemoteInterpreterConfig _ _ _ _ t _) = t

56+

57+checkFSForConfig :: InterpreterConfig -> Bool

58+checkFSForConfig (LocalInterpreterConfig _ _ _ _ c) = c

59+checkFSForConfig (RemoteInterpreterConfig _ _ _ _ _ c) = c

77−{-

61+persistenceStrategyForConfig :: InterpreterConfig -> Maybe PersistenceStrategy

78−ghcPkgPathsForConfig :: InterpreterConfig -> [GhcPkgPath]

62+persistenceStrategyForConfig (LocalInterpreterConfig strat _ _ _ _) = Just strat

79−ghcPkgPathsForConfig (LocalInterpreterConfig _ _ paths) = paths

63+persistenceStrategyForConfig RemoteInterpreterConfig{} = Nothing

80−ghcPkgPathsForConfig _ = error "Clients cannot configure remote ghc package paths."

81−-}

83errDie :: String -> IO ()

65errDie :: String -> IO ()

84errDie err = hPutStrLn stderr err >> exitFailure

66errDie err = hPutStrLn stderr err >> exitFailure

@@ -93,25 +75,36 @@ printWelcome = do

93 putStrLn "A full tutorial is available at:"

75 putStrLn "A full tutorial is available at:"

94 putStrLn "https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown"

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+

96main :: IO ()

84main :: IO ()

97main = do

85main = do

86+ setLocaleIfNecessary

98 interpreterConfig <- execParser opts

87 interpreterConfig <- execParser opts

99 let connInfo = connectionInfoForConfig interpreterConfig

88 let connInfo = connectionInfoForConfig interpreterConfig

89+ fscheck <- checkFSType (checkFSForConfig interpreterConfig) (fromMaybe NoPersistence (persistenceStrategyForConfig interpreterConfig))

90+ if not fscheck then

91+ errDie checkFSErrorMsg

92+ else do

100− dbconn <- connectProjectM36 connInfo

93+ dbconn <- connectProjectM36 connInfo

101− case dbconn of

94+ case dbconn of

102− Left err ->

95+ Left err ->

103− errDie ("Failed to create database connection: " ++ show err)

96+ errDie ("Failed to create database connection: " ++ show err)

104− Right conn -> do

97+ Right conn -> do

105− let connHeadName = headNameForConfig interpreterConfig

98+ let connHeadName = headNameForConfig interpreterConfig

106− eSessionId <- createSessionAtHead conn connHeadName

99+ eSessionId <- createSessionAtHead conn connHeadName

107− case eSessionId of

100+ case eSessionId of

108− Left err -> errDie ("Failed to create database session at \"" ++ show connHeadName ++ "\": " ++ show err)

101+ Left err -> errDie ("Failed to create database session at \"" ++ show connHeadName ++ "\": " ++ show err)

109− Right sessionId -> do

102+ Right sessionId ->

110− case execTutDForConfig interpreterConfig of

103+ case execTutDForConfig interpreterConfig of

111− Nothing -> do

104+ Nothing -> do

112− printWelcome

105+ printWelcome

113− _ <- reprLoop interpreterConfig sessionId conn

106+ _ <- reprLoop interpreterConfig sessionId conn

114− pure ()

107+ pure ()

115− Just tutdStr -> do

108+ Just tutdStr ->

116− runTutorialD sessionId conn (T.pack tutdStr)

109+ runTutorialD sessionId conn Nothing (T.pack tutdStr)

117

110

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.hsnew file+97

@@ -0,0 +1,97 @@

1+{-# LANGUAGE CPP #-}

2+--benchmark test for file handle leaks

3+import ProjectM36.Client

4+import ProjectM36.Persist

5+import Options.Applicative

6+import TutorialD.Interpreter

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

8+import qualified Data.Text as T

9+#if __GLASGOW_HASKELL__ < 804

10+import Data.Monoid

11+#endif

12+import Control.Monad

13+

14+data HandlesArgs = HandlesArgs {

15+ openCloseCount :: Int,

16+ transactionCount :: Int,

17+ dbdir :: FilePath,

18+ tutdSetup :: String,

19+ tutdIterate :: String

20+ }

21+

22+parseArgs :: Parser HandlesArgs

23+parseArgs = HandlesArgs <$> parseOpenAndCloseCount <*> parseTransactionCount <*> parseDbDir <*> parseTutdSetup <*> parseTutdIterate

24+

25+parseOpenAndCloseCount :: Parser Int

26+parseOpenAndCloseCount = option auto (short 'o' <> long "open-close-count")

27+

28+parseTransactionCount :: Parser Int

29+parseTransactionCount = option auto (short 't' <> long "transaction-count")

30+

31+parseDbDir :: Parser FilePath

32+parseDbDir = strOption (short 'd' <> long "dbdir")

33+

34+parseTutdSetup :: Parser String

35+parseTutdSetup = strOption (short 's' <> long "setup-tutd" <> value "x:=relation{tuple{v t}}")

36+

37+parseTutdIterate :: Parser String

38+parseTutdIterate = strOption (short 'i' <> long "iterate-tutd" <> value "update x (v:=not(@v))")

39+

40+main :: IO ()

41+main = do

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

43+ replicateM_ (openCloseCount args) (runOpenClose

44+ (T.pack (tutdSetup args))

45+ (T.pack (tutdIterate args))

46+ (transactionCount args)

47+ (dbdir args))

48+

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

50+runOpenClose tutdSetup' tutdIterate' tCount dbdir' = do

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

52+ eConn <- connectProjectM36 connInfo

53+ case eConn of

54+ Left err -> error (show err)

55+ Right conn -> do

56+ eSess <- createSessionAtHead conn "master"

57+ case eSess of

58+ Left err -> error (show err)

59+ Right session ->

60+ --database setup

61+ case parseTutorialD tutdSetup' of

62+ Left err -> error (show err)

63+ Right parsed -> do

64+ res <- evalTutorialD session conn UnsafeEvaluation parsed

65+ case res of

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

67+ DisplayParseErrorResult _ err ->

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

69+ error (errorBundlePretty err)

70+#else

71+ error (parseErrorPretty err)

72+#endif

73+ _ -> do

74+ replicateM_ tCount (runTransaction tutdIterate' session conn)

75+ close conn

76+ printFdCount

77+

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

79+runTransaction tutdIterate' sess conn =

80+ --run tutd on every iteration

81+ case parseTutorialD tutdIterate' of

82+ Left err -> error (show err)

83+ Right parsed -> do

84+ res <- evalTutorialD sess conn UnsafeEvaluation parsed

85+ case res of

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

87+ DisplayParseErrorResult _ err ->

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

89+ error (errorBundlePretty err)

90+#else

91+ error (parseErrorPretty err)

92+#endif

93+ _ -> do

94+ eErr <- commit sess conn

95+ case eErr of

96+ Left err -> error (show err)

97+ Right _ -> printFdCount

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+23−21

@@ -1,44 +1,46 @@

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)

8−import Text.Read

9import Data.Monoid

7import Data.Monoid

8+#endif

11relationForAtom :: Atom -> Either RelationalError Relation

10relationForAtom :: Atom -> Either RelationalError Relation

12relationForAtom (RelationAtom rel) = Right rel

11relationForAtom (RelationAtom rel) = Right rel

13relationForAtom _ = Left $ AttributeIsNotRelationValuedError ""

12relationForAtom _ = Left $ AttributeIsNotRelationValuedError ""

15−makeAtomFromText :: AttributeName -> AtomType -> T.Text -> Either RelationalError Atom

16−makeAtomFromText _ IntAtomType textIn = maybe ((Left . ParseError) textIn) (Right . IntAtom) (readMaybe (T.unpack textIn))

17−makeAtomFromText _ DoubleAtomType textIn = maybe ((Left . ParseError) textIn) (Right . DoubleAtom) (readMaybe (T.unpack textIn))

18−makeAtomFromText _ TextAtomType textIn = maybe ((Left . ParseError) textIn) (Right . TextAtom) (readMaybe (T.unpack textIn))

19−makeAtomFromText _ DayAtomType textIn = maybe ((Left . ParseError) textIn) (Right . DayAtom) (readMaybe (T.unpack textIn))

20−makeAtomFromText _ DateTimeAtomType textIn = maybe ((Left . ParseError) textIn) (Right . DateTimeAtom) (readMaybe (T.unpack textIn))

21−makeAtomFromText _ ByteStringAtomType textIn = maybe ((Left . ParseError) textIn) (Right . ByteStringAtom) (readMaybe (T.unpack textIn))

22−makeAtomFromText _ BoolAtomType textIn = maybe ((Left . ParseError) textIn) (Right . BoolAtom) (readMaybe (T.unpack textIn))

23−makeAtomFromText attrName _ _ = Left $ AtomTypeNotSupported attrName

24−

25atomToText :: Atom -> T.Text

14atomToText :: Atom -> T.Text

26atomToText (IntegerAtom i) = (T.pack . show) i

15atomToText (IntegerAtom i) = (T.pack . show) i

27atomToText (IntAtom i) = (T.pack . show) i

16atomToText (IntAtom i) = (T.pack . show) i

28atomToText (DoubleAtom i) = (T.pack . show) i

17atomToText (DoubleAtom i) = (T.pack . show) i

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

30atomToText (DayAtom i) = (T.pack . show) i

19atomToText (DayAtom i) = (T.pack . show) i

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

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

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

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

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

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

34−atomToText (IntervalAtom b e bo be) = beginp <> begin <> "," <> end <> endp

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

35− where beginp = if bo then "(" else "["

36− begin = atomToText b

37− end = atomToText e

38− endp = if be then ")" else "]"

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

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

41−atomToText (ConstructedAtom dConsName _ atoms) = dConsName `T.append` T.intercalate " " (map atomToText atoms)

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

36+ where

37+ parensAtomToText a@(ConstructedAtom _ _ []) = atomToText a

38+ parensAtomToText a@ConstructedAtom{} = "(" <> atomToText a <> ")"

39+ parensAtomToText a = atomToText a

40+

41+ dConsArgs = case atoms of

42+ [] -> ""

43+ args -> " " <> T.intercalate " " (map parensAtomToText args)

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+239−76

@@ -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+-}

44−atomTypeForDataConstructorDefArg :: DataConstructorDefArg -> AtomType -> TypeConstructorMapping -> Either RelationalError AtomType

49+atomTypeForDataConstructorDefArg :: 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,23 +62,33 @@ 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

75−resolveDataConstructorTypeVars dCons aTypeArgs tConss = do

74+resolveDataConstructorTypeVars dCons@(DataConstructorDef _ defArgs) aTypeArgs tConss = do

75+ let defCount = length defArgs

76+ argCount = length aTypeArgs

77+ if defCount /= argCount then

78+ Left (ConstructedAtomArgumentCountMismatchError defCount argCount)

79+ else do

76− maps <- mapM (\(dCons',aTypeArg) -> resolveDataConstructorArgTypeVars dCons' aTypeArg tConss) (zip (DCD.fields dCons) aTypeArgs)

80+ maps <- mapM (\(dCons',aTypeArg) -> resolveDataConstructorArgTypeVars dCons' aTypeArg tConss) (zip (DCD.fields dCons) aTypeArgs)

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

78− let typeVarMapFolder valMap acc = case acc of

82+ let typeVarMapFolder valMap acc = case acc of

79− Left err -> Left err

83+ Left err -> Left err

80− Right accMap -> if accMap `M.isSubmapOf` valMap then

84+ Right accMap ->

81− Right (M.union accMap valMap)

85+ case resolveAtomTypesInTypeVarMap valMap accMap of

82− else

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

84− case foldr typeVarMapFolder (Right M.empty) maps of

89+ case foldr typeVarMapFolder (Right M.empty) maps of

85− Left err -> Left err

90+ Left err -> Left err

86− Right typeVarMaps -> pure typeVarMaps

91+ Right typeVarMaps -> pure typeVarMaps

87 --if the data constructor cannot complete a type constructor variables (ex. "Nothing" could be Maybe Int or Maybe Text, etc.), then fill that space with TypeVar which is resolved when the relation is constructed- the relation must contain all resolved atom types.

92 --if the data constructor cannot complete a type constructor variables (ex. "Nothing" could be Maybe Int or Maybe Text, etc.), then fill that space with TypeVar which is resolved when the relation is constructed- the relation must contain all resolved atom types.

@@ -111,34 +116,103 @@ resolveTypeConstructorTypeVars (ADTypeConstructor tConsName _) (ConstructedAtomT

111 Right pVarMap'

116 Right pVarMap'

112 else

117 else

113 Left (TypeConstructorTypeVarsMismatch expectedPVarNames (M.keysSet pVarMap'))

118 Left (TypeConstructorTypeVarsMismatch expectedPVarNames (M.keysSet pVarMap'))

114−resolveTypeConstructorTypeVars (TypeVariable tvName) typ _ = Right (M.singleton tvName typ)

119+resolveTypeConstructorTypeVars (TypeVariable tvName) typ _ = case typ of

115−resolveTypeConstructorTypeVars x y _ = error $ "Unhandled type vars:" ++ show x ++ show y

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+

126+resolveTypeConstructorTypeVars (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

116

139

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

118-- check that the data constructor names are unique

141-- check that the data constructor names are unique

119−validateTypeConstructorDef :: TypeConstructorDef -> [DataConstructorDef] -> [RelationalError]

142+validateTypeConstructorDef :: TypeConstructorDef -> [DataConstructorDef] -> TypeConstructorMapping -> Either RelationalError ()

120−validateTypeConstructorDef tConsDef dConsList = execWriter $ do

143+validateTypeConstructorDef tConsDef dConsList tConsMap = do

121 let duplicateDConsNames = dupes (L.sort (map DCD.name dConsList))

144 let duplicateDConsNames = dupes (L.sort (map DCD.name dConsList))

122− mapM_ tell [map DataConstructorNameInUseError duplicateDConsNames]

145+ unless (null duplicateDConsNames) (Left (someErrors (map DataConstructorNameInUseError duplicateDConsNames)))

123 let leftSideVars = S.fromList (TCD.typeVars tConsDef)

146 let leftSideVars = S.fromList (TCD.typeVars tConsDef)

124 rightSideVars = S.unions (map DCD.typeVars dConsList)

147 rightSideVars = S.unions (map DCD.typeVars dConsList)

125 varsDiff = S.difference leftSideVars rightSideVars

148 varsDiff = S.difference leftSideVars rightSideVars

126− mapM_ tell [map DataConstructorUsesUndeclaredTypeVariable (S.toList varsDiff)]

149+ when (S.size varsDiff > 0) (Left (someErrors (map DataConstructorUsesUndeclaredTypeVariable (S.toList varsDiff))))

127− pure ()

150+ mapM_ (\dConsDef -> validateDataConstructorDef dConsDef tConsDef tConsMap) dConsList

128−

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

129

176

130-- | Create an atom type iff all type variables are provided.

177-- | Create an atom type iff all type variables are provided.

131-- Either Int Text -> ConstructedAtomType "Either" {Int , Text}

178-- Either Int Text -> ConstructedAtomType "Either" {Int , Text}

132−atomTypeForTypeConstructor :: TypeConstructor -> TypeConstructorMapping -> Either RelationalError AtomType

179+atomTypeForTypeConstructorValidate :: Bool -> TypeConstructor -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType

133−atomTypeForTypeConstructor (PrimitiveTypeConstructor _ aType) _ = Right aType

180+atomTypeForTypeConstructorValidate _ (PrimitiveTypeConstructor _ aType) _ _ = Right aType

181+atomTypeForTypeConstructorValidate validate (TypeVariable tvname) _ tvMap = case M.lookup tvname tvMap of

182+ Nothing -> if validate then

183+ Left (TypeConstructorTypeVarMissing tvname)

184+ else

134−atomTypeForTypeConstructor (TypeVariable tvname) _ = Right (TypeVariableType tvname)

185+ pure (TypeVariableType tvname)

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

135−atomTypeForTypeConstructor tCons tConss = case findTypeConstructor (TC.name tCons) tConss of

191+atomTypeForTypeConstructorValidate val tCons tConss tvMap = case findTypeConstructor (TC.name tCons) tConss of

136 Nothing -> Left (NoSuchTypeConstructorError (TC.name tCons))

192 Nothing -> Left (NoSuchTypeConstructorError (TC.name tCons))

193+ Just (PrimitiveTypeConstructorDef _ aType, _) -> Right aType

137 Just (tConsDef, _) -> do

194 Just (tConsDef, _) -> do

138− tConsArgTypes <- mapM (`atomTypeForTypeConstructor` tConss) (TC.arguments tCons)

195+ tConsArgTypes <- mapM (\tConsArg -> atomTypeForTypeConstructorValidate val tConsArg tConss tvMap) (TC.arguments tCons)

139− let pVarNames = TCD.typeVars tConsDef

196+ let pVarNames = TCD.typeVars tConsDef

140− tConsArgs = M.fromList (zip pVarNames tConsArgTypes)

197+ tConsArgs = M.fromList (zip pVarNames tConsArgTypes)

141− 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))

142

216

143findTypeConstructor :: TypeConstructorName -> TypeConstructorMapping -> Maybe (TypeConstructorDef, [DataConstructorDef])

217findTypeConstructor :: TypeConstructorName -> TypeConstructorMapping -> Maybe (TypeConstructorDef, [DataConstructorDef])

144findTypeConstructor name = foldr tConsFolder Nothing

218findTypeConstructor name = foldr tConsFolder Nothing

@@ -147,17 +221,30 @@ findTypeConstructor name = foldr tConsFolder Nothing

147 Just (tCons, dConsList)

221 Just (tCons, dConsList)

148 else

222 else

149 accum

223 accum

150−

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

151resolveAtomType :: AtomType -> AtomType -> Either RelationalError AtomType

233resolveAtomType :: AtomType -> AtomType -> Either RelationalError AtomType

152−resolveAtomType (ConstructedAtomType tConsName resolvedTypeVarMap) (ConstructedAtomType _ unresolvedTypeVarMap) = do

234+resolveAtomType (ConstructedAtomType tConsName resolvedTypeVarMap) (ConstructedAtomType _ unresolvedTypeVarMap) =

153− tVarMap <- resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap

235+ ConstructedAtomType tConsName <$> resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap

154− pure (ConstructedAtomType tConsName tVarMap)

155resolveAtomType typeFromRelation unresolvedType = if typeFromRelation == unresolvedType then

236resolveAtomType typeFromRelation unresolvedType = if typeFromRelation == unresolvedType then

156 Right typeFromRelation

237 Right typeFromRelation

157 else

238 else

158 Left (AtomTypeMismatchError typeFromRelation unresolvedType)

239 Left (AtomTypeMismatchError typeFromRelation unresolvedType)

159

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

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

161resolveAtomTypesInTypeVarMap :: TypeVarMap -> TypeVarMap -> Either RelationalError TypeVarMap

248resolveAtomTypesInTypeVarMap :: TypeVarMap -> TypeVarMap -> Either RelationalError TypeVarMap

162resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do

249resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do

163 {-

250 {-

@@ -173,29 +260,42 @@ resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do

173 let resolveTypePair resKey resType =

260 let resolveTypePair resKey resType =

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

175 case M.lookup resKey unresolvedTypeMap of

262 case M.lookup resKey unresolvedTypeMap of

176− Just unresType -> case unresType of

263+ Just unresType -> case unresType of

177 --do we need to recurse for RelationAtomType?

264 --do we need to recurse for RelationAtomType?

178 subType@(ConstructedAtomType _ _) -> do

265 subType@(ConstructedAtomType _ _) -> do

179 resSubType <- resolveAtomType resType subType

266 resSubType <- resolveAtomType resType subType

180 pure (resKey, resSubType)

267 pure (resKey, resSubType)

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

182 Nothing ->

273 Nothing ->

183 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

184 tVarList <- mapM (uncurry resolveTypePair) (M.toList resolvedTypeMap)

275 tVarList <- mapM (uncurry resolveTypePair) (M.toList resolvedTypeMap)

185 pure (M.fromList tVarList)

276 pure (M.fromList tVarList)

186

277

187-- | See notes at `resolveTypesInTuple`. The typeFromRelation must not include any wildcards.

278-- | See notes at `resolveTypesInTuple`. The typeFromRelation must not include any wildcards.

188−resolveTypeInAtom :: AtomType -> Atom -> Either RelationalError Atom

279+resolveTypeInAtom :: AtomType -> Atom -> TypeConstructorMapping -> Either RelationalError Atom

189−resolveTypeInAtom typeFromRelation atomIn@(ConstructedAtom dConsName _ args) = do

280+resolveTypeInAtom typeFromRelation@(ConstructedAtomType _ tvMap) atomIn@(ConstructedAtom dConsName _ args) tConss = do

190 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)

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

192−resolveTypeInAtom _ atom = Right atom

292+resolveTypeInAtom _ atom _ = Right atom

193

293

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

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

196−resolveTypesInTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple

296+resolveTypesInTuple :: Attributes -> TypeConstructorMapping -> RelationTuple -> Either RelationalError RelationTuple

197−resolveTypesInTuple resolvedAttrs (RelationTuple _ tupAtoms) = do

297+resolveTypesInTuple resolvedAttrs tConss (RelationTuple _ tupAtoms) = do

198− 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)

199 Right (RelationTuple resolvedAttrs (V.fromList newAtoms))

299 Right (RelationTuple resolvedAttrs (V.fromList newAtoms))

200

300

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

@@ -210,12 +310,38 @@ validateAtomType typ@(ConstructedAtomType tConsName tVarMap) tConss =

210 if not (S.null diff) then

310 if not (S.null diff) then

211 Left $ TypeConstructorTypeVarsMismatch expectedTyVarNames actualTyVarNames

311 Left $ TypeConstructorTypeVarsMismatch expectedTyVarNames actualTyVarNames

212 else

312 else

213− Right ()

313+ validateTypeVarMap tVarMap tConss

214− _ -> Right ()

314+ _ -> Right ()

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

216

333

217validateTuple :: RelationTuple -> TypeConstructorMapping -> Either RelationalError ()

334validateTuple :: RelationTuple -> TypeConstructorMapping -> Either RelationalError ()

218−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+

219

345

220-- | 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).

221atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType

347atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType

@@ -227,35 +353,40 @@ atomTypeVerify x@(ConstructedAtomType tConsNameA tVarMapA) (ConstructedAtomType

227 | otherwise = Right x

353 | otherwise = Right x

228

354

229atomTypeVerify x@(RelationAtomType attrs1) y@(RelationAtomType attrs2) = do

355atomTypeVerify x@(RelationAtomType attrs1) y@(RelationAtomType attrs2) = do

230− _ <- mapM (\(attr1,attr2) -> let name1 = A.attributeName attr1

356+ mapM_ (\(attr1,attr2) -> let name1 = A.attributeName attr1

231− name2 = A.attributeName attr2 in

357+ name2 = A.attributeName attr2 in

232 if notElem "_" [name1, name2] && name1 /= name2 then

358 if notElem "_" [name1, name2] && name1 /= name2 then

233 Left $ AtomTypeMismatchError x y

359 Left $ AtomTypeMismatchError x y

234 else

360 else

235− 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))

236 return x

362 return x

237−atomTypeVerify (IntervalAtomType typA) (IntervalAtomType typB) = atomTypeVerify typA typB

238atomTypeVerify x y = if x == y then

363atomTypeVerify x y = if x == y then

239 Right x

364 Right x

240 else

365 else

241 Left $ AtomTypeMismatchError x y

366 Left $ AtomTypeMismatchError x y

242

367

243−-- | Determine if two typeVar

368+-- | Determine if two typeVars are logically compatible.

244typeVarMapsVerify :: TypeVarMap -> TypeVarMap -> Bool

369typeVarMapsVerify :: TypeVarMap -> TypeVarMap -> Bool

245−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)

246

376

247prettyAtomType :: AtomType -> T.Text

377prettyAtomType :: AtomType -> T.Text

248−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` "}"

249prettyAtomType (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))

250 where

380 where

381+ showTypeVars (_, TypeVariableType x) = " " <> x

251 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` ")"

252-- 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?)

253−prettyAtomType (TypeVariableType x) = "?TypeVariableType " <> x <> "?"

384+prettyAtomType (TypeVariableType x) = x

254−prettyAtomType (IntervalAtomType tv) = "Interval (" <> prettyAtomType tv <> ")"

255prettyAtomType aType = T.take (T.length fullName - T.length "AtomType") fullName

385prettyAtomType aType = T.take (T.length fullName - T.length "AtomType") fullName

256 where fullName = (T.pack . show) aType

386 where fullName = (T.pack . show) aType

257

387

258prettyAttribute :: Attribute -> T.Text

388prettyAttribute :: Attribute -> T.Text

389+prettyAttribute (Attribute _ (TypeVariableType x)) = x

259prettyAttribute 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)

260

391

261resolveTypeVariables :: [AtomType] -> [AtomType] -> Either RelationalError TypeVarMap

392resolveTypeVariables :: [AtomType] -> [AtomType] -> Either RelationalError TypeVarMap

@@ -275,7 +406,6 @@ resolveTypeVariables expectedArgTypes actualArgTypes = do

275

406

276resolveTypeVariable :: AtomType -> AtomType -> TypeVarMap

407resolveTypeVariable :: AtomType -> AtomType -> TypeVarMap

277resolveTypeVariable (TypeVariableType tv) typ = M.singleton tv typ

408resolveTypeVariable (TypeVariableType tv) typ = M.singleton tv typ

278−resolveTypeVariable (IntervalAtomType ityp) typ = resolveTypeVariable ityp typ

279resolveTypeVariable (ConstructedAtomType _ _) (ConstructedAtomType _ actualTvMap) = actualTvMap

409resolveTypeVariable (ConstructedAtomType _ _) (ConstructedAtomType _ actualTvMap) = actualTvMap

280resolveTypeVariable _ _ = M.empty

410resolveTypeVariable _ _ = M.empty

281

411

@@ -286,8 +416,41 @@ resolveFunctionReturnValue funcName tvMap (ConstructedAtomType tCons retMap) = d

286 pure (ConstructedAtomType tCons (M.intersection tvMap retMap))

416 pure (ConstructedAtomType tCons (M.intersection tvMap retMap))

287 else

417 else

288 Left (AtomFunctionTypeVariableResolutionError funcName (fst (head (M.toList diff))))

418 Left (AtomFunctionTypeVariableResolutionError funcName (fst (head (M.toList diff))))

289−resolveFunctionReturnValue funcName tvMap (IntervalAtomType tv) = IntervalAtomType <$> resolveFunctionReturnValue funcName tvMap tv

290resolveFunctionReturnValue funcName tvMap (TypeVariableType tvName) = case M.lookup tvName tvMap of

419resolveFunctionReturnValue funcName tvMap (TypeVariableType tvName) = case M.lookup tvName tvMap of

291 Nothing -> Left (AtomFunctionTypeVariableResolutionError funcName tvName)

420 Nothing -> Left (AtomFunctionTypeVariableResolutionError funcName tvName)

292 Just typ -> pure typ

421 Just typ -> pure typ

293−resolveFunctionReturnValue _ _ typ = pure typ

422+resolveFunctionReturnValue _ _ typ = pure typ

423+

424+-- convert a typevarmap and data constructor definition into a list of atomtypes which represent the arguments-- no type variables are allowed to remain

425+resolvedAtomTypesForDataConstructorDefArgs :: TypeConstructorMapping -> TypeVarMap -> DataConstructorDef -> Either RelationalError [AtomType]

426+resolvedAtomTypesForDataConstructorDefArgs tConsMap tvMap (DataConstructorDef _ args) = mapM (resolvedAtomTypeForDataConstructorDefArg tConsMap tvMap) args

427+

428+resolvedAtomTypeForDataConstructorDefArg :: TypeConstructorMapping -> TypeVarMap -> DataConstructorDefArg -> Either RelationalError AtomType

429+resolvedAtomTypeForDataConstructorDefArg tConsMap tvMap (DataConstructorDefTypeConstructorArg typCons) = atomTypeForTypeConstructor typCons tConsMap tvMap

430+resolvedAtomTypeForDataConstructorDefArg _ tvMap (DataConstructorDefTypeVarNameArg tvName) = case M.lookup tvName tvMap of

431+ Nothing -> Left (DataConstructorUsesUndeclaredTypeVariable tvName)

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+85−71

@@ -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.Relation

7−import ProjectM36.DataTypes.Primitive

8import ProjectM36.DataTypes.List

7import ProjectM36.DataTypes.List

8+import ProjectM36.DataTypes.NonEmptyList

9import ProjectM36.DataTypes.Maybe

10import ProjectM36.DataTypes.Either

11import GHC.Generics

12import qualified Data.Map as M

13import qualified Data.Text as T

14+import qualified Data.Vector as V

14import Control.DeepSeq (NFData)

15import Control.DeepSeq (NFData)

15−import Data.Binary

16import Control.Applicative

17import Data.Time.Calendar

18import Data.ByteString (ByteString)

19import Data.Time.Clock

20−import Data.Maybe

20+import 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))

@@ -47,14 +36,14 @@ class (Eq a, NFData a, Binary a, Show a) => Atomable a where

47 Nothing -> error "no fromAtomG for Atom found"

36 Nothing -> error "no fromAtomG for Atom found"

48 Just x -> to x

37 Just x -> to x

50− toAtomType :: a -> AtomType

39+ toAtomType :: proxy a -> AtomType

51− default toAtomType :: (Generic a, AtomableG (Rep a)) => a -> AtomType

40+ default toAtomType :: (Generic a, AtomableG (Rep a)) => proxy a -> AtomType

52− toAtomType v = toAtomTypeG (from v)

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 :: a -> DatabaseContextExpr

44+ toAddTypeExpr :: proxy a -> DatabaseContextExpr

56− default toAddTypeExpr :: (Generic a, AtomableG (Rep a)) => a -> DatabaseContextExpr

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

57− toAddTypeExpr v = toAddTypeExprG (from v) (toAtomType v)

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

@@ -112,6 +101,7 @@ instance Atomable Bool where

112 toAtomType _ = BoolAtomType

101 toAtomType _ = BoolAtomType

113 toAddTypeExpr _ = NoOperation

102 toAddTypeExpr _ = NoOperation

114

103

104+{-

115instance Atomable Relation where

105instance Atomable Relation where

116 toAtom = RelationAtom

106 toAtom = RelationAtom

117 fromAtom (RelationAtom r) = r

107 fromAtom (RelationAtom r) = r

@@ -119,23 +109,24 @@ instance Atomable Relation where

119 --warning: cannot be used with undefined "Relation"

109 --warning: cannot be used with undefined "Relation"

120 toAtomType rel = RelationAtomType (attributes rel)

110 toAtomType rel = RelationAtomType (attributes rel)

121 toAddTypeExpr _ = NoOperation

111 toAddTypeExpr _ = NoOperation

112+-}

122

113

123instance Atomable a => Atomable (Maybe a) where

114instance Atomable a => Atomable (Maybe a) where

124− toAtom (Just v) = ConstructedAtom "Just" (maybeAtomType (toAtomType v)) [toAtom v]

115+ toAtom (Just v) = ConstructedAtom "Just" (maybeAtomType (toAtomType (Proxy :: Proxy a))) [toAtom v]

125− toAtom Nothing = ConstructedAtom "Nothing" (maybeAtomType (toAtomType (undefined :: a))) []

116+ toAtom Nothing = ConstructedAtom "Nothing" (maybeAtomType (toAtomType (Proxy :: Proxy a))) []

126

117

127 fromAtom (ConstructedAtom "Just" _ [val]) = Just (fromAtom val)

118 fromAtom (ConstructedAtom "Just" _ [val]) = Just (fromAtom val)

128 fromAtom (ConstructedAtom "Nothing" _ []) = Nothing

119 fromAtom (ConstructedAtom "Nothing" _ []) = Nothing

129 fromAtom _ = error "improper fromAtom (Maybe a)"

120 fromAtom _ = error "improper fromAtom (Maybe a)"

130

121

131− toAtomType _ = ConstructedAtomType "Maybe" (M.singleton "a" (toAtomType (undefined :: a)))

122+ toAtomType _ = ConstructedAtomType "Maybe" (M.singleton "a" (toAtomType (Proxy :: Proxy a)))

132 toAddTypeExpr _ = NoOperation

123 toAddTypeExpr _ = NoOperation

133

124

134instance (Atomable a, Atomable b) => Atomable (Either a b) where

125instance (Atomable a, Atomable b) => Atomable (Either a b) where

135− toAtom (Left l) = ConstructedAtom "Left" (eitherAtomType (toAtomType (undefined :: a))

126+ toAtom (Left l) = ConstructedAtom "Left" (eitherAtomType (toAtomType (Proxy :: Proxy a))

136− (toAtomType (undefined :: b))) [toAtom l]

127+ (toAtomType (Proxy :: Proxy b))) [toAtom l]

137− toAtom (Right r) = ConstructedAtom "Right" (eitherAtomType (toAtomType (undefined :: a))

128+ toAtom (Right r) = ConstructedAtom "Right" (eitherAtomType (toAtomType (Proxy :: Proxy a))

138− (toAtomType (undefined :: b))) [toAtom r]

129+ (toAtomType (Proxy :: Proxy b))) [toAtom r]

139

130

140 fromAtom (ConstructedAtom "Left" _ [val]) = Left (fromAtom val)

131 fromAtom (ConstructedAtom "Left" _ [val]) = Left (fromAtom val)

141 fromAtom (ConstructedAtom "Right" _ [val]) = Right (fromAtom val)

132 fromAtom (ConstructedAtom "Right" _ [val]) = Right (fromAtom val)

@@ -143,14 +134,22 @@ instance (Atomable a, Atomable b) => Atomable (Either a b) where

143

134

144--convert to ADT list

135--convert to ADT list

145instance Atomable a => Atomable [a] where

136instance Atomable a => Atomable [a] where

146− toAtom [] = ConstructedAtom "Empty" (listAtomType (toAtomType (undefined :: a))) []

137+ toAtom [] = ConstructedAtom "Empty" (listAtomType (toAtomType (Proxy :: Proxy a))) []

147− toAtom (x:xs) = ConstructedAtom "Cons" (listAtomType (toAtomType x)) (map toAtom (x:xs))

138+ toAtom (x:xs) = ConstructedAtom "Cons" (listAtomType (toAtomType (Proxy :: Proxy a))) (toAtom x: [toAtom xs])

148

139

149 fromAtom (ConstructedAtom "Empty" _ _) = []

140 fromAtom (ConstructedAtom "Empty" _ _) = []

150− fromAtom (ConstructedAtom "Cons" _ (x:xs)) = fromAtom x:map fromAtom xs

141+ fromAtom (ConstructedAtom "Cons" _ [x,y]) = fromAtom x:fromAtom y

151 fromAtom _ = error "improper fromAtom [a]"

142 fromAtom _ = error "improper fromAtom [a]"

152

143

153− toAtomType _ = ConstructedAtomType "List" (M.singleton "a" (toAtomType (undefined :: a)))

144+ toAtomType _ = ConstructedAtomType "List" (M.singleton "a" (toAtomType (Proxy :: Proxy a)))

145+ toAddTypeExpr _ = NoOperation

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

154 toAddTypeExpr _ = NoOperation

153 toAddTypeExpr _ = NoOperation

155

154

156-- Generics

155-- Generics

@@ -168,17 +167,17 @@ class AtomableG g where

168instance (Datatype c, AtomableG a) => AtomableG (M1 D c a) where

167instance (Datatype c, AtomableG a) => AtomableG (M1 D c a) where

169 toAtomG (M1 v) = toAtomG v

168 toAtomG (M1 v) = toAtomG v

170 fromAtomG atom args = M1 <$> fromAtomG atom args

169 fromAtomG atom args = M1 <$> fromAtomG atom args

171− toAtomsG = undefined

170+ toAtomsG = error "invalid toAtomsG in M1 D"

172 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?

173 where

172 where

174 typeName = datatypeName (undefined :: M1 D c a x)

173 typeName = datatypeName (undefined :: M1 D c a x)

175− toAddTypeExprG (M1 v) (ConstructedAtomType tcName _) = AddTypeConstructor tcDef dataConstructors

174+ toAddTypeExprG ~(M1 v) (ConstructedAtomType tcName _) = AddTypeConstructor tcDef dataConstructors

176 where

175 where

177 tcDef = ADTypeConstructorDef tcName []

176 tcDef = ADTypeConstructorDef tcName []

178 dataConstructors = getConstructorsG v

177 dataConstructors = getConstructorsG v

179 toAddTypeExprG _ _ = NoOperation

178 toAddTypeExprG _ _ = NoOperation

180− getConstructorsG (M1 v) = getConstructorsG v

179+ getConstructorsG ~(M1 v) = getConstructorsG v

181− getConstructorArgsG = undefined

180+ getConstructorArgsG = error "invalid getConstructorArgsG in M1 D"

182

181

183--constructor metadata

182--constructor metadata

184instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where

183instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where

@@ -193,11 +192,11 @@ instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where

193 Nothing

192 Nothing

194 where

193 where

195 dName = T.pack (conName (undefined :: M1 C c a x))

194 dName = T.pack (conName (undefined :: M1 C c a x))

196− fromAtomG _ _ = error "unsupported generic traversal"

195+ fromAtomG _ _ = error "invalid fromAtomG in M1 C"

197− toAtomsG = undefined

196+ toAtomsG = error "invalid toAtomsG in M1 C"

198− toAtomTypeG = undefined

197+ toAtomTypeG = error "invalid toAtomTypeG in M1 C"

199− toAddTypeExprG = undefined

198+ toAddTypeExprG = error "invalid toAddTypeExprG in M1 C"

200− getConstructorsG (M1 v) = [DataConstructorDef (T.pack dName) dArgs]

199+ getConstructorsG ~(M1 v) = [DataConstructorDef (T.pack dName) dArgs]

201 where

200 where

202 dName = conName (undefined :: M1 C c a x)

201 dName = conName (undefined :: M1 C c a x)

203 dArgs = getConstructorArgsG v

202 dArgs = getConstructorArgsG v

@@ -209,9 +208,9 @@ instance (Selector c, AtomableG a) => AtomableG (M1 S c a) where

209 fromAtomG atom args = M1 <$> fromAtomG atom args

208 fromAtomG atom args = M1 <$> fromAtomG atom args

210 toAtomsG (M1 v) = toAtomsG v

209 toAtomsG (M1 v) = toAtomsG v

211 toAtomTypeG (M1 v) = toAtomTypeG v

210 toAtomTypeG (M1 v) = toAtomTypeG v

212− toAddTypeExprG _ _ = undefined

211+ toAddTypeExprG = error "invalid toAddTypeExprG in M1 S"

213− getConstructorsG = undefined

212+ getConstructorsG = error "invalid getConstructorsG in M1 S"

214− getConstructorArgsG (M1 v) = getConstructorArgsG v

213+ getConstructorArgsG ~(M1 v) = getConstructorArgsG v

215

214

216-- field data metadata

215-- field data metadata

217instance (Atomable a) => AtomableG (K1 c a) where

216instance (Atomable a) => AtomableG (K1 c a) where

@@ -220,49 +219,64 @@ instance (Atomable a) => AtomableG (K1 c a) where

220 where headatom (x:_) = x

219 where headatom (x:_) = x

221 headatom [] = error "no more atoms for constructor!"

220 headatom [] = error "no more atoms for constructor!"

222 toAtomsG (K1 v) = [toAtom v]

221 toAtomsG (K1 v) = [toAtom v]

223− toAtomTypeG _ = toAtomType (undefined :: a)

222+ toAtomTypeG _ = toAtomType (Proxy :: Proxy a)

224− toAddTypeExprG _ _ = undefined

223+ toAddTypeExprG = error "invalid toAddTypeExprG in K1"

225− getConstructorsG = undefined

224+ getConstructorsG = error "invalid getConstructorsG in K1"

226− getConstructorArgsG (K1 v) = [DataConstructorDefTypeConstructorArg tCons]

225+ getConstructorArgsG ~(K1 _) = [DataConstructorDefTypeConstructorArg tCons]

227 where

226 where

228− tCons = PrimitiveTypeConstructor primitiveATypeName primitiveAType

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

229− primitiveAType = toAtomType v

228+

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

229+typeToTypeConstructor :: AtomType -> TypeConstructor

231−

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+

232instance AtomableG U1 where

247instance AtomableG U1 where

233− toAtomG = undefined

248+ toAtomG = error "invalid toAtomG in U1"

234 fromAtomG _ _ = pure U1

249 fromAtomG _ _ = pure U1

235 toAtomsG _ = []

250 toAtomsG _ = []

236− toAtomTypeG = undefined

251+ toAtomTypeG = error "invalid toAtomTypeG in U1"

237− toAddTypeExprG = undefined

252+ toAddTypeExprG = error "invalid toAddTypeExprG in U1"

238− getConstructorsG = undefined

253+ getConstructorsG = error "invalid getConstructorsG in U1"

239 getConstructorArgsG _ = []

254 getConstructorArgsG _ = []

240

255

241-- product types

256-- product types

242instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where

257instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where

243 toAtomG = undefined

258 toAtomG = undefined

244− fromAtomG atom args = (:*:) <$> fromAtomG atom [headatom args] <*> fromAtomG atom (tailatoms args)

259+ fromAtomG atom args = (:*:) <$> fromAtomG atom splitargs1 <*> fromAtomG atom splitargs2

245− where headatom (x:_) = x

260+ where splitargs1 = take splitpoint args

246− headatom [] = error "no more atoms in head for product!"

261+ splitargs2 = drop splitpoint args

247− tailatoms (_:xs) = xs

262+ splitpoint = length args `div` 2

248− tailatoms [] = error "no more atoms in tail for product!"

263+ toAtomTypeG = error "invalid toAtomTypeG in :*:"

249− toAtomTypeG = undefined

250 toAtomsG (x :*: y) = toAtomsG x ++ toAtomsG y

264 toAtomsG (x :*: y) = toAtomsG x ++ toAtomsG y

251− toAddTypeExprG _ _ = undefined

265+ toAddTypeExprG = error "invalid toAddTypeExprG in :*:"

252− getConstructorsG = undefined

266+ getConstructorsG = error "invalid getConstructorsG in :*:"

253− getConstructorArgsG (x :*: y) = getConstructorArgsG x ++ getConstructorArgsG y

267+ getConstructorArgsG ~(x :*: y) = getConstructorArgsG x ++ getConstructorArgsG y

254

268

255-- sum types

269-- sum types

256instance (AtomableG a, AtomableG b) => AtomableG (a :+: b) where

270instance (AtomableG a, AtomableG b) => AtomableG (a :+: b) where

257 toAtomG (L1 x) = toAtomG x

271 toAtomG (L1 x) = toAtomG x

258 toAtomG (R1 x) = toAtomG x

272 toAtomG (R1 x) = toAtomG x

259 fromAtomG atom args = (L1 <$> fromAtomG atom args) <|> (R1 <$> fromAtomG atom args)

273 fromAtomG atom args = (L1 <$> fromAtomG atom args) <|> (R1 <$> fromAtomG atom args)

260− toAtomTypeG = undefined

274+ toAtomTypeG = error "invalid toAtomTypeG in :+:"

261 toAtomsG (L1 x) = toAtomsG x

275 toAtomsG (L1 x) = toAtomsG x

262 toAtomsG (R1 x) = toAtomsG x

276 toAtomsG (R1 x) = toAtomsG x

263− toAddTypeExprG _ _ = undefined

277+ toAddTypeExprG = error "invalid toAddTypeExprG in :+:"

264 getConstructorsG _ = getConstructorsG (undefined :: a x) ++ getConstructorsG (undefined :: b x)

278 getConstructorsG _ = getConstructorsG (undefined :: a x) ++ getConstructorsG (undefined :: b x)

265− getConstructorArgsG = undefined

279+ getConstructorArgsG = error "invalid getConstructorArgsG in :+:"

266

280

267--this represents the unimplemented generics traversals which should never be called

281--this represents the unimplemented generics traversals which should never be called

268{-

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+246−122

@@ -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,34 +219,46 @@ 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

227-- | When the changeExpr returns a different result in the database context, then the reportExpr is triggered and sent asynchronously to all clients.

240-- | When the changeExpr returns a different result in the database context, then the reportExpr is triggered and sent asynchronously to all clients.

228data Notification = Notification {

241data Notification = Notification {

229 changeExpr :: RelationalExpr,

242 changeExpr :: RelationalExpr,

230− reportExpr :: RelationalExpr

243+ reportOldExpr :: RelationalExpr, --run the expression in the pre-change context

244+ reportNewExpr :: RelationalExpr --run the expression in the post-change context

231 }

245 }

232− deriving (Show, Eq, Binary, Generic, NFData)

246+ deriving (Show, Eq, Generic, NFData)

233

247

234type TypeVarName = StringType

248type TypeVarName = StringType

235

249

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

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

237data TypeConstructorDef = ADTypeConstructorDef TypeConstructorName [TypeVarName] |

251data TypeConstructorDef = ADTypeConstructorDef TypeConstructorName [TypeVarName] |

238 PrimitiveTypeConstructorDef TypeConstructorName AtomType

252 PrimitiveTypeConstructorDef TypeConstructorName AtomType

239− deriving (Show, Generic, Binary, Eq, NFData)

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

240

254

241-- | 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 ()

242−data TypeConstructor = ADTypeConstructor TypeConstructorName [TypeConstructor] |

257+data TypeConstructorBase a = ADTypeConstructor TypeConstructorName [TypeConstructor] |

243− PrimitiveTypeConstructor TypeConstructorName AtomType |

258+ PrimitiveTypeConstructor TypeConstructorName AtomType |

259+ RelationAtomTypeConstructor [AttributeExprBase a] |

244− TypeVariable TypeVarName

260+ TypeVariable TypeVarName

245− deriving (Show, Generic, Binary, Eq, NFData)

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

246

262

247type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)]

263type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)]

248

264

@@ -252,16 +268,23 @@ type DataConstructorName = StringType

252type AtomTypeName = StringType

268type AtomTypeName = StringType

253

269

254-- | 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@

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

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

256

272

257type DataConstructorDefs = [DataConstructorDef]

273type DataConstructorDefs = [DataConstructorDef]

258

274

259data DataConstructorDefArg = DataConstructorDefTypeConstructorArg TypeConstructor |

275data DataConstructorDefArg = DataConstructorDefTypeConstructorArg TypeConstructor |

260 DataConstructorDefTypeVarNameArg TypeVarName

276 DataConstructorDefTypeVarNameArg TypeVarName

261− deriving (Show, Generic, Binary, Eq, NFData)

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

262

278

263type InclusionDependencies = M.Map IncDepName InclusionDependency

279type InclusionDependencies = M.Map IncDepName InclusionDependency

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

265

288

266type SchemaName = StringType

289type SchemaName = StringType

267

290

@@ -269,17 +292,18 @@ type Subschemas = M.Map SchemaName Schema

269

292

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

271data Schemas = Schemas DatabaseContext Subschemas

294data Schemas = Schemas DatabaseContext Subschemas

295+ deriving (Generic)

272

296

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

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

275newtype Schema = Schema SchemaIsomorphs

299newtype Schema = Schema SchemaIsomorphs

276− deriving (Generic, Binary)

300+ deriving (Generic)

277

301

278data SchemaIsomorph = IsoRestrict RelVarName RestrictionPredicateExpr (RelVarName, RelVarName) |

302data SchemaIsomorph = IsoRestrict RelVarName RestrictionPredicateExpr (RelVarName, RelVarName) |

279 IsoRename RelVarName RelVarName |

303 IsoRename RelVarName RelVarName |

280 IsoUnion (RelVarName, RelVarName) RestrictionPredicateExpr RelVarName --maps two relvars to one relvar

304 IsoUnion (RelVarName, RelVarName) RestrictionPredicateExpr RelVarName --maps two relvars to one relvar

281 -- IsoTypeConstructor in morphAttrExpr

305 -- IsoTypeConstructor in morphAttrExpr

282− deriving (Generic, Binary, Show)

306+ deriving (Generic, Show)

283

307

284type SchemaIsomorphs = [SchemaIsomorph]

308type SchemaIsomorphs = [SchemaIsomorph]

285

309

@@ -295,29 +319,33 @@ data DatabaseContext = DatabaseContext {

295type IncDepName = StringType

319type IncDepName = StringType

296

320

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

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

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

299−

300−instance Binary InclusionDependency

301

323

302type AttributeNameAtomExprMap = M.Map AttributeName AtomExpr

324type AttributeNameAtomExprMap = M.Map AttributeName AtomExpr

303

325

304--used for returning information about individual expressions

326--used for returning information about individual expressions

305type DatabaseContextExprName = StringType

327type DatabaseContextExprName = StringType

306

328

329+type DatabaseContextExpr = DatabaseContextExprBase ()

330+

331+instance Hashable DatabaseContextExpr

332+

333+type GraphRefDatabaseContextExpr = DatabaseContextExprBase GraphRefTransactionMarker

334+

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

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

308−data DatabaseContextExpr =

336+data DatabaseContextExprBase a =

309 NoOperation |

337 NoOperation |

310− Define RelVarName [AttributeExpr] |

338+ Define RelVarName [AttributeExprBase a] |

311 Undefine RelVarName | --forget existence of relvar X

339 Undefine RelVarName | --forget existence of relvar X

312− Assign RelVarName RelationalExpr |

340+ Assign RelVarName (RelationalExprBase a) |

313− Insert RelVarName RelationalExpr |

341+ Insert RelVarName (RelationalExprBase a) |

314− Delete RelVarName RestrictionPredicateExpr |

342+ Delete RelVarName (RestrictionPredicateExprBase a) |

315− Update RelVarName AttributeNameAtomExprMap RestrictionPredicateExpr |

343+ Update RelVarName AttributeNameAtomExprMap (RestrictionPredicateExprBase a) |

316

344

317 AddInclusionDependency IncDepName InclusionDependency |

345 AddInclusionDependency IncDepName InclusionDependency |

318 RemoveInclusionDependency IncDepName |

346 RemoveInclusionDependency IncDepName |

319

347

320− AddNotification NotificationName RelationalExpr RelationalExpr |

348+ AddNotification NotificationName RelationalExpr RelationalExpr RelationalExpr |

321 RemoveNotification NotificationName |

349 RemoveNotification NotificationName |

322

350

323 AddTypeConstructor TypeConstructorDef [DataConstructorDef] |

351 AddTypeConstructor TypeConstructorDef [DataConstructorDef] |

@@ -328,19 +356,36 @@ data DatabaseContextExpr =

328

356

329 RemoveDatabaseContextFunction DatabaseContextFunctionName |

357 RemoveDatabaseContextFunction DatabaseContextFunctionName |

330

358

331− ExecuteDatabaseContextFunction DatabaseContextFunctionName [AtomExpr] |

359+ ExecuteDatabaseContextFunction DatabaseContextFunctionName [AtomExprBase a] |

332

360

333− MultipleExpr [DatabaseContextExpr]

361+ MultipleExpr [DatabaseContextExprBase a]

334− deriving (Show, Eq, Binary, Generic)

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

335

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)

336-- | 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 =

337−data DatabaseContextIOExpr = AddAtomFunction AtomFunctionName [TypeConstructor] AtomFunctionBodyScript |

372+ AddAtomFunction AtomFunctionName [TypeConstructor] AtomFunctionBodyScript |

373+ LoadAtomFunctions ObjModuleName ObjFunctionName FilePath |

338− AddDatabaseContextFunction DatabaseContextFunctionName [TypeConstructor] DatabaseContextFunctionBodyScript

374+ AddDatabaseContextFunction DatabaseContextFunctionName [TypeConstructor] DatabaseContextFunctionBodyScript |

375+ LoadDatabaseContextFunctions ObjModuleName ObjFunctionName FilePath |

376+ CreateArbitraryRelation RelVarName [AttributeExprBase a] Range

339− deriving (Show, Eq, Generic, Binary)

377+ deriving (Show, Eq, Generic)

378+

379+type GraphRefDatabaseContextIOExpr = DatabaseContextIOExprBase GraphRefTransactionMarker

340

380

381+type DatabaseContextIOExpr = DatabaseContextIOExprBase ()

341

382

342type RestrictionPredicateExpr = RestrictionPredicateExprBase ()

383type RestrictionPredicateExpr = RestrictionPredicateExprBase ()

343

384

385+instance Hashable RestrictionPredicateExpr

386+

387+type GraphRefRestrictionPredicateExpr = RestrictionPredicateExprBase GraphRefTransactionMarker

388+

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

345data RestrictionPredicateExprBase a =

390data RestrictionPredicateExprBase a =

346 TruePredicate |

391 TruePredicate |

@@ -350,9 +395,7 @@ data RestrictionPredicateExprBase a =

350 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)

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

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

352 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

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

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

354−

355−instance Binary RestrictionPredicateExpr

356

399

357-- child + parent links

400-- child + parent links

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

@@ -362,32 +405,42 @@ type TransactionHeads = M.Map HeadName Transaction

362

405

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

364data TransactionGraph = TransactionGraph TransactionHeads (S.Set Transaction)

407data TransactionGraph = TransactionGraph TransactionHeads (S.Set Transaction)

365−

408+ deriving Generic

366−transactionsForGraph :: TransactionGraph -> S.Set Transaction

367−transactionsForGraph (TransactionGraph _ t) = t

368

409

369transactionHeadsForGraph :: TransactionGraph -> TransactionHeads

410transactionHeadsForGraph :: TransactionGraph -> TransactionHeads

370−transactionHeadsForGraph (TransactionGraph heads _) = heads

411+transactionHeadsForGraph (TransactionGraph hs _) = hs

412+

413+transactionsForGraph :: TransactionGraph -> S.Set Transaction

414+transactionsForGraph (TransactionGraph _ ts) = ts

371

415

372-- | 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).

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

374− MergeTransactionInfo TransactionId TransactionId (S.Set TransactionId) UTCTime -- 2 parents, n children

427+ MergeTransactionInfo TransactionId TransactionId TransactionDiffs UTCTime -- 2 parents, n children

375− deriving(Show, Generic)

428+ deriving (Show, Generic)

376−

429+-}

377−instance Binary TransactionInfo

378

430

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

380type TransactionId = UUID

432type TransactionId = UUID

381

433

382data Transaction = Transaction TransactionId TransactionInfo Schemas

434data Transaction = Transaction TransactionId TransactionInfo Schemas

435+ deriving Generic

383

436

384−--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.

385−

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+

386type DirtyFlag = Bool

441type DirtyFlag = Bool

387

442

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

389−data DisconnectedTransaction = DisconnectedTransaction TransactionId Schemas DirtyFlag --parentID, context- the context here represents the singular concrete context from the schema

390−--the dirty flag indicates that the database context has diverged from its parent's context

391

444

392transactionId :: Transaction -> TransactionId

445transactionId :: Transaction -> TransactionId

393transactionId (Transaction tid _ _) = tid

446transactionId (Transaction tid _ _) = tid

@@ -403,24 +456,28 @@ instance Ord Transaction where

403

456

404type AtomExpr = AtomExprBase ()

457type AtomExpr = AtomExprBase ()

405

458

459+instance Hashable AtomExpr

460+

461+type GraphRefAtomExpr = AtomExprBase GraphRefTransactionMarker

462+

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

407data AtomExprBase a = AttributeAtomExpr AttributeName |

464data AtomExprBase a = AttributeAtomExpr AttributeName |

408 NakedAtomExpr Atom |

465 NakedAtomExpr Atom |

409 FunctionAtomExpr AtomFunctionName [AtomExprBase a] a |

466 FunctionAtomExpr AtomFunctionName [AtomExprBase a] a |

410 RelationAtomExpr (RelationalExprBase a) |

467 RelationAtomExpr (RelationalExprBase a) |

411 ConstructedAtomExpr DataConstructorName [AtomExprBase a] a

468 ConstructedAtomExpr DataConstructorName [AtomExprBase a] a

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

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

413

470

414−instance Binary AtomExpr

415−

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

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

417data ExtendTupleExprBase a = AttributeExtendTupleExpr AttributeName (AtomExprBase a)

472data ExtendTupleExprBase a = AttributeExtendTupleExpr AttributeName (AtomExprBase a)

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

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

419

474

420−type ExtendTupleExpr = ExtendTupleExprBase ()

475+type ExtendTupleExpr = ExtendTupleExprBase ()

476+

477+instance Hashable ExtendTupleExpr

478+

479+type GraphRefExtendTupleExpr = ExtendTupleExprBase GraphRefTransactionMarker

421

480

422−instance Binary ExtendTupleExpr

423−

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

425type AtomFunctions = HS.HashSet AtomFunction

482type AtomFunctions = HS.HashSet AtomFunction

426

483

@@ -431,6 +488,7 @@ type AtomFunctionBodyScript = StringType

431type AtomFunctionBodyType = [Atom] -> Either AtomFunctionError Atom

488type AtomFunctionBodyType = [Atom] -> Either AtomFunctionError Atom

432

489

433data AtomFunctionBody = AtomFunctionBody (Maybe AtomFunctionBodyScript) AtomFunctionBodyType

490data AtomFunctionBody = AtomFunctionBody (Maybe AtomFunctionBodyScript) AtomFunctionBodyType

491+ deriving Generic

434

492

435instance NFData AtomFunctionBody where

493instance NFData AtomFunctionBody where

436 rnf (AtomFunctionBody mScript _) = rnf mScript

494 rnf (AtomFunctionBody mScript _) = rnf mScript

@@ -460,12 +518,22 @@ instance Show AtomFunction where

460 showArgTypes = L.intercalate "->" (map show (atomFuncType aFunc))

518 showArgTypes = L.intercalate "->" (map show (atomFuncType aFunc))

461

519

462-- | 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").

463−data AttributeNames = AttributeNames (S.Set AttributeName) |

521+data AttributeNamesBase a = AttributeNames (S.Set AttributeName) |

464− InvertedAttributeNames (S.Set AttributeName) |

522+ InvertedAttributeNames (S.Set AttributeName) |

465− UnionAttributeNames AttributeNames AttributeNames |

523+ UnionAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |

466− IntersectAttributeNames AttributeNames AttributeNames

524+ IntersectAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |

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

467− deriving (Eq, Show, Generic, Binary, NFData)

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

468−

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+

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

470data PersistenceStrategy = NoPersistence | -- ^ no filesystem persistence/memory-only database

538data PersistenceStrategy = NoPersistence | -- ^ no filesystem persistence/memory-only database

471 MinimalPersistence FilePath | -- ^ fsync off, not crash-safe

539 MinimalPersistence FilePath | -- ^ fsync off, not crash-safe

@@ -473,19 +541,31 @@ data PersistenceStrategy = NoPersistence | -- ^ no filesystem persistence/memory

473 deriving (Show, Read)

541 deriving (Show, Read)

474

542

475type AttributeExpr = AttributeExprBase ()

543type AttributeExpr = AttributeExprBase ()

544+type GraphRefAttributeExpr = AttributeExprBase GraphRefTransactionMarker

476

545

477-- | Create attributes dynamically.

546-- | Create attributes dynamically.

478data AttributeExprBase a = AttributeAndTypeNameExpr AttributeName TypeConstructor a |

547data AttributeExprBase a = AttributeAndTypeNameExpr AttributeName TypeConstructor a |

479 NakedAttributeExpr Attribute

548 NakedAttributeExpr Attribute

480− deriving (Eq, Show, Generic, Binary, NFData)

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

481

550

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

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

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

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

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

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

485−

554+

486−instance Binary TupleExpr

555+instance Hashable TupleExpr

487−

556+

488−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 ()

489

569

490data MergeStrategy =

570data MergeStrategy =

491 -- | 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)

@@ -494,7 +574,7 @@ data MergeStrategy =

494 UnionPreferMergeStrategy HeadName |

574 UnionPreferMergeStrategy HeadName |

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

496 SelectedBranchMergeStrategy HeadName

576 SelectedBranchMergeStrategy HeadName

497− deriving (Eq, Show, Binary, Generic, NFData)

577+ deriving (Eq, Show, Generic, NFData)

498

578

499type DatabaseContextFunctionName = StringType

579type DatabaseContextFunctionName = StringType

500

580

@@ -520,3 +600,47 @@ instance Hashable DatabaseContextFunction where

520

600

521instance Eq DatabaseContextFunction where

601instance Eq DatabaseContextFunction where

522 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+405−367

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

@@ -24,6 +26,8 @@ module ProjectM36.Client

24 rollback,

26 rollback,

25 typeForRelationalExpr,

27 typeForRelationalExpr,

26 inclusionDependencies,

28 inclusionDependencies,

29+ ProjectM36.Client.typeConstructorMapping,

30+ ProjectM36.Client.databaseContextFunctionsAsRelation,

27 planForDatabaseContextExpr,

31 planForDatabaseContextExpr,

28 currentSchemaName,

32 currentSchemaName,

29 SchemaName,

33 SchemaName,

@@ -31,6 +35,7 @@ module ProjectM36.Client

31 setCurrentSchemaName,

35 setCurrentSchemaName,

32 transactionGraphAsRelation,

36 transactionGraphAsRelation,

33 relationVariablesAsRelation,

37 relationVariablesAsRelation,

38+ ProjectM36.Client.atomFunctionsAsRelation,

34 disconnectedTransactionIsDirty,

39 disconnectedTransactionIsDirty,

35 headName,

40 headName,

36 remoteDBLookupName,

41 remoteDBLookupName,

@@ -39,19 +44,20 @@ module ProjectM36.Client

39 defaultDatabaseName,

44 defaultDatabaseName,

40 defaultRemoteConnectionInfo,

45 defaultRemoteConnectionInfo,

41 defaultHeadName,

46 defaultHeadName,

47+ addClientNode,

42 PersistenceStrategy(..),

48 PersistenceStrategy(..),

43 RelationalExpr,

49 RelationalExpr,

44 RelationalExprBase(..),

50 RelationalExprBase(..),

51+ DatabaseContextExprBase(..),

45− DatabaseContextExpr(..),

52+ DatabaseContextExpr,

53+ DatabaseContextIOExprBase(..),

46− DatabaseContextIOExpr(..),

54+ DatabaseContextIOExpr,

47 Attribute(..),

55 Attribute(..),

48 MergeStrategy(..),

56 MergeStrategy(..),

49 attributesFromList,

57 attributesFromList,

50− createNodeId,

51 createSessionAtCommit,

58 createSessionAtCommit,

52 createSessionAtHead,

59 createSessionAtHead,

53 closeSession,

60 closeSession,

54− addClientNode,

55 callTestTimeout_,

61 callTestTimeout_,

56 RelationCardinality(..),

62 RelationCardinality(..),

57 TransactionGraphOperator(..),

63 TransactionGraphOperator(..),

@@ -61,7 +67,6 @@ module ProjectM36.Client

61 TransGraphRelationalExpr,

67 TransGraphRelationalExpr,

62 TransactionIdLookup(..),

68 TransactionIdLookup(..),

63 TransactionIdHeadBacktrack(..),

69 TransactionIdHeadBacktrack(..),

64− NodeId(..),

65 Atom(..),

70 Atom(..),

66 Session,

71 Session,

67 SessionId,

72 SessionId,

@@ -74,86 +79,95 @@ module ProjectM36.Client

74 databaseContextExprForUniqueKey,

79 databaseContextExprForUniqueKey,

75 databaseContextExprForForeignKey,

80 databaseContextExprForForeignKey,

76 createScriptedAtomFunction,

81 createScriptedAtomFunction,

82+ ProjectM36.Client.validateMerkleHashes,

77 AttributeExprBase(..),

83 AttributeExprBase(..),

78− TypeConstructor(..),

84+ TypeConstructorBase(..),

79 TypeConstructorDef(..),

85 TypeConstructorDef(..),

80 DataConstructorDef(..),

86 DataConstructorDef(..),

81− AttributeNames(..),

87+ AttributeNamesBase(..),

82 RelVarName,

88 RelVarName,

83 IncDepName,

89 IncDepName,

84 InclusionDependency(..),

90 InclusionDependency(..),

85 AttributeName,

91 AttributeName,

92+ DF.DataFrame,

93+ DF.DataFrameExpr,

94+ DF.AttributeOrderExpr,

95+ DF.Order(..),

86 RelationalError(..),

96 RelationalError(..),

87 RequestTimeoutException(..),

97 RequestTimeoutException(..),

88 RemoteProcessDiedException(..),

98 RemoteProcessDiedException(..),

89 AtomType(..),

99 AtomType(..),

90 Atomable(..),

100 Atomable(..),

91 TupleExprBase(..),

101 TupleExprBase(..),

102+ TupleExprsBase(..),

92 AtomExprBase(..),

103 AtomExprBase(..),

93 RestrictionPredicateExprBase(..),

104 RestrictionPredicateExprBase(..),

94 withTransaction

105 withTransaction

95 ) where

106 ) where

96import ProjectM36.Base hiding (inclusionDependencies) --defined in this module as well

107import ProjectM36.Base hiding (inclusionDependencies) --defined in this module as well

97import qualified ProjectM36.Base as B

108import qualified ProjectM36.Base as B

109+import ProjectM36.Serialise.Error ()

98import ProjectM36.Error

110import ProjectM36.Error

99import ProjectM36.Atomable

111import ProjectM36.Atomable

100−import ProjectM36.AtomFunction

112+import ProjectM36.AtomFunction as AF

101import ProjectM36.StaticOptimizer

113import ProjectM36.StaticOptimizer

102import ProjectM36.Key

114import ProjectM36.Key

115+import qualified ProjectM36.DataFrame as DF

116+import ProjectM36.DatabaseContextFunction as DCF

103import qualified ProjectM36.IsomorphicSchema as Schema

117import qualified ProjectM36.IsomorphicSchema as Schema

104import Control.Monad.State

118import Control.Monad.State

105−import Control.Monad.Trans.Reader

106import qualified ProjectM36.RelationalExpression as RE

119import qualified ProjectM36.RelationalExpression as RE

107import ProjectM36.DatabaseContext (basicDatabaseContext)

120import ProjectM36.DatabaseContext (basicDatabaseContext)

108import qualified ProjectM36.TransactionGraph as Graph

121import qualified ProjectM36.TransactionGraph as Graph

109−import ProjectM36.TransactionGraph

122+import ProjectM36.TransactionGraph as TG

110import qualified ProjectM36.Transaction as Trans

123import qualified ProjectM36.Transaction as Trans

111import ProjectM36.TransactionGraph.Persist

124import ProjectM36.TransactionGraph.Persist

112−import ProjectM36.Attribute hiding (atomTypes)

125+import ProjectM36.Attribute

113−import ProjectM36.TransGraphRelationalExpression (TransGraphRelationalExpr, evalTransGraphRelationalExpr)

126+import ProjectM36.TransGraphRelationalExpression as TGRE (TransGraphRelationalExpr)

114import ProjectM36.Persist (DiskSync(..))

127import ProjectM36.Persist (DiskSync(..))

115import ProjectM36.FileLock

128import ProjectM36.FileLock

129+import ProjectM36.NormalizeExpr

116import ProjectM36.Notifications

130import ProjectM36.Notifications

117import ProjectM36.Server.RemoteCallTypes

131import ProjectM36.Server.RemoteCallTypes

118import qualified ProjectM36.DisconnectedTransaction as Discon

132import qualified ProjectM36.DisconnectedTransaction as Discon

119import ProjectM36.Relation (typesAsRelation)

133import ProjectM36.Relation (typesAsRelation)

120import ProjectM36.ScriptSession (initScriptSession, ScriptSession)

134import ProjectM36.ScriptSession (initScriptSession, ScriptSession)

121import qualified ProjectM36.Relation as R

135import qualified ProjectM36.Relation as R

122−import qualified ProjectM36.DatabaseContext as DBC

123import Control.Exception.Base

136import Control.Exception.Base

124−import GHC.Conc.Sync

137+import Control.Concurrent.STM

138+import Control.Concurrent.Async

125

139

126−import Network.Transport (Transport(closeTransport))

127−import Network.Transport.TCP (createTransport, defaultTCPParameters, encodeEndPointAddress)

128−import Control.Distributed.Process.Node (newLocalNode, initRemoteTable, runProcess, LocalNode, forkProcess, closeLocalNode)

129−import Control.Distributed.Process.Extras.Internal.Types (whereisRemote)

130−import Control.Distributed.Process.ManagedProcess.Client (call, safeCall)

131import Data.Either (isRight)

140import Data.Either (isRight)

132import Data.UUID.V4 (nextRandom)

141import Data.UUID.V4 (nextRandom)

133import Data.Word

142import Data.Word

134−import Control.Distributed.Process (ProcessId, Process, receiveWait, send, match, NodeId(..), reconnect)

143+import Data.Hashable

135import Control.Exception (IOException, handle, AsyncException, throwIO, fromException, Exception)

144import Control.Exception (IOException, handle, AsyncException, throwIO, fromException, Exception)

136import Control.Concurrent.MVar

145import Control.Concurrent.MVar

146+import Codec.Winery hiding (Schema, schema)

137import qualified Data.Map as M

147import qualified Data.Map as M

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

139−import qualified STMContainers.Map as STMMap

152+import qualified STMContainers.Map as StmMap

140−import qualified STMContainers.Set as STMSet

153+import qualified STMContainers.Set as StmSet

154+#endif

141import qualified ProjectM36.Session as Sess

155import qualified ProjectM36.Session as Sess

142import ProjectM36.Session

156import ProjectM36.Session

143import ProjectM36.Sessions

157import ProjectM36.Sessions

144−import ListT

145−import Data.Binary (Binary)

146import GHC.Generics (Generic)

158import GHC.Generics (Generic)

147import Control.DeepSeq (force)

159import Control.DeepSeq (force)

148import System.IO

160import System.IO

149import 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)

150

166

151type Hostname = String

167type Hostname = String

152

168

153type Port = Word16

169type Port = Word16

154

170

155−type DatabaseName = String

156−

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

158type NotificationCallback = NotificationName -> EvaluatedNotification -> IO ()

172type NotificationCallback = NotificationName -> EvaluatedNotification -> IO ()

159

173

@@ -173,28 +187,27 @@ data RequestTimeoutException = RequestTimeoutException

173

187

174instance Exception RequestTimeoutException

188instance Exception RequestTimeoutException

175

189

176−-- | 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.

177−data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy NotificationCallback [GhcPkgPath]|

191+data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy NotificationCallback [GhcPkgPath] |

178− RemoteProcessConnectionInfo DatabaseName NodeId NotificationCallback

192+ RemoteConnectionInfo DatabaseName Hostname ServiceName NotificationCallback

179

193

180type EvaluatedNotifications = M.Map NotificationName EvaluatedNotification

194type EvaluatedNotifications = M.Map NotificationName EvaluatedNotification

181

195

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

183newtype NotificationMessage = NotificationMessage EvaluatedNotifications

197newtype NotificationMessage = NotificationMessage EvaluatedNotifications

184− deriving (Binary, Eq, Show, Generic)

198+ deriving (Eq, Show, Generic)

199+ deriving Serialise via WineryVariant NotificationMessage

185

200

186−-- | When a notification is fired, the 'reportExpr' is evaluated in the commit's context, so that is 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.

187data EvaluatedNotification = EvaluatedNotification {

202data EvaluatedNotification = EvaluatedNotification {

188 notification :: Notification,

203 notification :: Notification,

204+ reportOldRelation :: Either RelationalError Relation,

189− reportRelation :: Either RelationalError Relation

205+ reportNewRelation :: Either RelationalError Relation

190 }

206 }

191− deriving(Binary, Eq, Show, Generic)

207+ deriving (Eq, Show, Generic)

208+ deriving Serialise via WineryRecord EvaluatedNotification

192

209

193

210

194−-- | Create a 'NodeId' for use in connecting to a remote server using distributed-process.

195−createNodeId :: Hostname -> Port -> NodeId

196−createNodeId host port = NodeId $ encodeEndPointAddress host (show port) 1

197−

198-- | Use this for connecting to remote servers on the default port.

211-- | Use this for connecting to remote servers on the default port.

199defaultServerPort :: Port

212defaultServerPort :: Port

200defaultServerPort = 6543

213defaultServerPort = 6543

@@ -209,129 +222,107 @@ defaultHeadName = "master"

209

222

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

211defaultRemoteConnectionInfo :: ConnectionInfo

224defaultRemoteConnectionInfo :: ConnectionInfo

225+defaultRemoteConnectionInfo =

212−defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (createNodeId "127.0.0.1" defaultServerPort) emptyNotificationCallback

226+ RemoteConnectionInfo defaultDatabaseName defaultServerHostname (show defaultServerPort) emptyNotificationCallback

213

227

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

228+defaultServerHostname :: Hostname

215−type ClientNodes = STMSet.Set ProcessId

229+defaultServerHostname = "localhost"

216−

217−type TransactionGraphLockHandle = Handle

218−

219−-- internal structure specific to in-process connections

220−data InProcessConnectionConf = InProcessConnectionConf {

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 (TransactionGraphLockHandle, 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,37 +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)

413+

419-- | '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.

420close :: Connection -> IO ()

415close :: Connection -> IO ()

421close (InProcessConnection conf) = do

416close (InProcessConnection conf) = do

417+ cancel (ipCallbackAsync conf)

422 atomically $ do

418 atomically $ do

423 let sessions = ipSessions conf

419 let sessions = ipSessions conf

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

421+ StmMap.reset sessions

422+#else

424− STMMap.deleteAll sessions

423+ StmMap.deleteAll sessions

424+#endif

425 pure ()

426− closeLocalNode (ipLocalNode conf)

426+ let mLocks = ipLocks conf

427− closeTransport (ipTransport conf)

427+ case mLocks of

428+ Nothing -> pure ()

429+ Just (lockFileH, _) -> closeLockFile lockFileH

428

430

429−close conn@(RemoteProcessConnection conf) = do

431+close (RemoteConnection (RemoteConnectionConf conn)) =

430− _ <- remoteCall conn Logout :: IO Bool

432+ RPC.close conn

431− closeLocalNode (rLocalNode conf)

432− closeTransport (rTransport conf)

433

434--used only by the server EntryPoints

435closeRemote_ :: Connection -> IO ()

436closeRemote_ (InProcessConnection _) = error "invalid call of closeRemote_ on InProcessConnection"

437−closeRemote_ (RemoteProcessConnection conf) = runProcess (rLocalNode conf) (reconnect (rProcessId conf))

437+closeRemote_ (RemoteConnection (RemoteConnectionConf conn)) = RPC.close conn

438

439 --we need to actually close the localNode's connection to the remote

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

@@ -445,40 +445,19 @@ excEither = handle handler

445 where

446 handler exc | Just (_ :: AsyncException) <- fromException exc = throwIO exc

447 | otherwise = pure (Left (UnhandledExceptionError (show exc)))

448−

449−runProcessResult :: LocalNode -> Process a -> IO a

450−runProcessResult localNode proc = do

451− ret <- newEmptyMVar

452− runProcess localNode $ do

453− val <- proc

454− liftIO $ putMVar ret val

455− takeMVar ret

456−

457−safeLogin :: Login -> ProcessId -> Process Bool

458−safeLogin login procId = do

459− ret <- call procId login

460− case ret of

461− Left (_ :: ServerError) -> pure False

462− Right val -> pure val

463

448

449+

464−remoteCall :: (Serializable a, Serializable b) => Connection -> a -> IO b

450+remoteCall :: (Serialise a, Serialise b) => Connection -> a -> IO b

465remoteCall (InProcessConnection _ ) _ = error "remoteCall called on local connection"

451remoteCall (InProcessConnection _ ) _ = error "remoteCall called on local connection"

466−remoteCall (RemoteProcessConnection conf) arg = runProcessResult localNode $ do

452+remoteCall (RemoteConnection (RemoteConnectionConf rpcConn)) arg = do

467− ret <- safeCall serverProcessId arg

453+ eRet <- RPC.call rpcConn arg

468− case ret of

454+ case eRet of

469− Left err -> error ("server died: " ++ show err)

455+ Left err -> convertRPCErrors err

470− Right ret' -> case ret' of

471− Left RequestTimeoutError -> liftIO (throwIO RequestTimeoutException)

472− Left (ProcessDiedError _) -> liftIO (throwIO RemoteProcessDiedException)

473− Right val -> pure val

456+ Right val -> pure val

474− where

475− localNode = rLocalNode conf

476− serverProcessId = rProcessId conf

477

457

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

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

479−sessionForSessionId sessionId sessions = do

459+sessionForSessionId sessionId sessions =

480− maybeSession <- STMMap.lookup sessionId sessions

481− pure $ maybe (Left $ NoSuchSessionError sessionId) Right maybeSession

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

482

461

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

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

484schemaForSessionId session = do

463schemaForSessionId session = do

@@ -509,7 +488,7 @@ currentSchemaName sessionId (InProcessConnection conf) = atomically $ do

509 case eSession of

488 case eSession of

510 Left err -> pure (Left err)

489 Left err -> pure (Left err)

511 Right session -> pure (Right (Sess.schemaName session))

490 Right session -> pure (Right (Sess.schemaName session))

512−currentSchemaName sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveCurrentSchemaName sessionId)

491+currentSchemaName sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveCurrentSchemaName sessionId)

513

492

514-- | Switch to the named isomorphic schema.

493-- | Switch to the named isomorphic schema.

515setCurrentSchemaName :: SessionId -> Connection -> SchemaName -> IO (Either RelationalError ())

494setCurrentSchemaName :: SessionId -> Connection -> SchemaName -> IO (Either RelationalError ())

@@ -520,8 +499,8 @@ setCurrentSchemaName sessionId (InProcessConnection conf) sname = atomically $ d

520 Left err -> pure (Left err)

499 Left err -> pure (Left err)

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

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

522 Left err -> pure (Left err)

501 Left err -> pure (Left err)

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

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

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

503+setCurrentSchemaName sessionId conn@(RemoteConnection _) sname = remoteCall conn (ExecuteSetCurrentSchema sessionId sname)

525

504

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

527executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

506executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

@@ -537,10 +516,15 @@ executeRelationalExpr sessionId (InProcessConnection conf) expr = excEither $ at

537 Right expr

516 Right expr

538 case expr' of

517 case expr' of

539 Left err -> pure (Left err)

518 Left err -> pure (Left err)

519+ Right expr'' -> do

520+ let graphTvar = ipTransactionGraph conf

521+ graph <- readTVar graphTvar

540− Right expr'' -> case runReader (RE.evalRelationalExpr expr'') (RE.mkRelationalExprState (Sess.concreteDatabaseContext session)) of

522+ let reEnv = RE.mkRelationalExprEnv (Sess.concreteDatabaseContext session) graph

541− Left err -> pure (Left err)

523+ case optimizeAndEvalRelationalExpr reEnv expr'' of

542− 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+

543−executeRelationalExpr sessionId conn@(RemoteProcessConnection _) relExpr = remoteCall conn (ExecuteRelationalExpr sessionId relExpr)

527+executeRelationalExpr sessionId conn@(RemoteConnection _) relExpr = remoteCall conn (ExecuteRelationalExpr sessionId relExpr)

544

528

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

546executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ())

530executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ())

@@ -556,36 +540,54 @@ executeDatabaseContextExpr sessionId (InProcessConnection conf) expr = excEither

556 Schema.processDatabaseContextExprInSchema schema expr

540 Schema.processDatabaseContextExprInSchema schema expr

557 case expr' of

541 case expr' of

558 Left err -> pure (Left err)

542 Left err -> pure (Left err)

543+ Right expr'' -> do

544+ graph <- readTVar (ipTransactionGraph conf)

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

560− (Just err,_) -> pure (Left err)

549+ Left err -> pure (Left err)

550+ Right newState ->

561− (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

562− (Nothing, (!context',_,True)) -> do

552+ pure (Right ())

553+ else do

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

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

555+ context' = RE.dbc_context newState

564− newSubschemas = Schema.processDatabaseContextExprSchemasUpdate (Sess.subschemas session) expr

556+ newSubschemas = Schema.processDatabaseContextExprSchemasUpdate (Sess.subschemas session) expr

565− newSchemas = Schemas context' newSubschemas

557+ newSchemas = Schemas context' newSubschemas

566− newSession = Session newDiscon (Sess.schemaName session)

558+ newSession = Session newDiscon (Sess.schemaName session)

567− STMMap.insert newSession sessionId sessions

559+ StmMap.insert newSession sessionId sessions

568− pure (Right ())

560+ pure (Right ())

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

561+executeDatabaseContextExpr sessionId conn@(RemoteConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)

570−

562+

571−-- | 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.

572autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())

564autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())

573autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do

565autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do

574 let sessions = ipSessions conf

566 let sessions = ipSessions conf

575 id1 <- nextRandom

567 id1 <- nextRandom

576 id2 <- nextRandom

568 id2 <- nextRandom

577 id3 <- nextRandom

569 id3 <- nextRandom

578− stamp <- getCurrentTime

570+ tstamp <- getCurrentTime

579 commitLock_ sessionId conf $ \graph -> do

571 commitLock_ sessionId conf $ \graph -> do

580 eSession <- sessionForSessionId sessionId sessions

572 eSession <- sessionForSessionId sessionId sessions

581 case eSession of

573 case eSession of

582 Left err -> pure (Left err)

574 Left err -> pure (Left err)

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

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

585− Left err -> pure (Left err)

587+ Left err -> pure (Left err)

586− Right (discon', graph') ->

588+ Right ((discon', graph'), transactionIdsAdded) ->

587− pure (Right (discon', graph', [id1, id2, id3]))

589+ pure (Right (discon', graph', transactionIdsAdded))

588−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')

589

591

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

591--this is almost completely identical to executeDatabaseContextExpr above

593--this is almost completely identical to executeDatabaseContextExpr above

@@ -597,39 +599,38 @@ executeDatabaseContextIOExpr sessionId (InProcessConnection conf) expr = excEith

597 case eSession of

599 case eSession of

598 Left err -> pure (Left err)

600 Left err -> pure (Left err)

599 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

600− res <- RE.evalDatabaseContextIOExpr scriptSession (Sess.concreteDatabaseContext session) expr

605+ context = Sess.concreteDatabaseContext session

606+ res <- RE.runDatabaseContextIOEvalMonad env context (optimizeAndEvalDatabaseContextIOExpr expr)

601 case res of

607 case res of

602 Left err -> pure (Left err)

608 Left err -> pure (Left err)

603− Right context' -> do

609+ Right newState -> do

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

610+ let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas False

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

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

606 newSession = Session newDiscon (Sess.schemaName session)

612 newSession = Session newDiscon (Sess.schemaName session)

613+ context' = RE.dbc_context newState

607− atomically $ STMMap.insert newSession sessionId sessions

614+ atomically $ StmMap.insert newSession sessionId sessions

608 pure (Right ())

615 pure (Right ())

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

616+executeDatabaseContextIOExpr sessionId conn@(RemoteConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextIOExpr sessionId dbExpr)

610

617

611−{-

612−executeGraphExprSTM_ :: TransactionId -> SessionId -> Session -> Sessions -> TransactionGraphOperator -> TransactionGraph -> TVar TransactionGraph -> STM (Either RelationalError (TransactionGraph, DisconnectedTransaction)

613−executeGraphExprSTM_ freshId sessionId session sessions graphExpr graph graphTVar= do

614− case evalGraphOp freshId (Sess.disconnectedTransaction session) graph graphExpr of

615− Left err -> do

616− when updateGraphOnError (writeTVar graphTVar graph)

617− pure $ Left err

618− Right (discon', graph') -> do

619− writeTVar graphTVar graph'

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

621− STMMap.insert newSession sessionId sessions

622− pure $ Right graph'

623−-}

624−

625-- process notifications for commits

618-- process notifications for commits

619+executeCommitExprSTM_

620+ :: TransactionGraph

621+ -> DatabaseContext

622+ -> DatabaseContext

623+ -> ClientNodes

626−executeCommitExprSTM_ :: DatabaseContext -> DatabaseContext -> ClientNodes -> STM (EvaluatedNotifications, ClientNodes)

624+ -> STM (EvaluatedNotifications, ClientNodes)

627−executeCommitExprSTM_ oldContext newContext nodes = do

625+executeCommitExprSTM_ graph oldContext newContext nodes = do

628 let nots = notifications oldContext

626 let nots = notifications oldContext

629− fireNots = notificationChanges nots oldContext newContext

627+ fireNots = notificationChanges nots graph oldContext newContext

630 evaldNots = M.map mkEvaldNot fireNots

628 evaldNots = M.map mkEvaldNot fireNots

629+ evalInContext expr ctx = optimizeAndEvalRelationalExpr (RE.mkRelationalExprEnv ctx graph) expr

630+

631 mkEvaldNot notif = EvaluatedNotification { notification = notif,

632− reportRelation = runReader (RE.evalRelationalExpr (reportExpr notif)) (RE.mkRelationalExprState oldContext) }

632+ reportOldRelation = evalInContext (reportOldExpr notif) oldContext,

633+ reportNewRelation = evalInContext (reportNewExpr notif) newContext}

633 pure (evaldNots, nodes)

634 pure (evaldNots, nodes)

634

635

635-- | Execute a transaction graph expression in the context of the session and connection. Transaction graph operators modify the transaction graph state.

636-- | Execute a transaction graph expression in the context of the session and connection. Transaction graph operators modify the transaction graph state.

@@ -641,103 +642,29 @@ executeGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> IO (E

641executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do

642executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do

642 let sessions = ipSessions conf

643 let sessions = ipSessions conf

643 freshId <- nextRandom

644 freshId <- nextRandom

644− stamp <- getCurrentTime

645+ tstamp <- getCurrentTime

645 commitLock_ sessionId conf $ \updatedGraph -> do

646 commitLock_ sessionId conf $ \updatedGraph -> do

646 eSession <- sessionForSessionId sessionId sessions

647 eSession <- sessionForSessionId sessionId sessions

647 case eSession of

648 case eSession of

648 Left err -> pure (Left err)

649 Left err -> pure (Left err)

649 Right session -> do

650 Right session -> do

650 let discon = Sess.disconnectedTransaction session

651 let discon = Sess.disconnectedTransaction session

651− case evalGraphOp stamp freshId discon updatedGraph graphExpr of

652+ case evalGraphOp tstamp freshId discon updatedGraph graphExpr of

652 Left err -> pure (Left err)

653 Left err -> pure (Left err)

653 Right (discon', graph') -> do

654 Right (discon', graph') -> do

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

655− let transIds = [freshId | isRight (transactionForId freshId graph')]

656+ let transIds = [freshId | isRight (RE.transactionForId freshId graph')]

656 pure (Right (discon', graph', transIds))

657 pure (Right (discon', graph', transIds))

657−{-

658+

658−executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do

659− let strat = ipPersistenceStrategy conf

660− clientNodes = ipClientNodes conf

661− sessions = ipSessions conf

662− graphTvar = ipTransactionGraph conf

663− mLockFileH = ipLocks conf

664− lockHandler body = case graphExpr of

665− Commit -> case mLockFileH of

666− Nothing -> body False

667− Just (lockFileH, lockMVar) -> let acquireLocks = do

668− lastWrittenDigest <- takeMVar lockMVar

669− lockFile lockFileH WriteLock

670− latestDigest <- readGraphTransactionIdDigest strat

671− pure (latestDigest /= lastWrittenDigest)

672−

673− releaseLocks _ = do

674− --still holding the lock- get the latest digest

675− gDigest <- readGraphTransactionIdDigest strat

676− unlockFile lockFileH

677− putMVar lockMVar gDigest

678− in bracket acquireLocks releaseLocks body

679− _ -> body False

680− freshId <- nextRandom

681− lockHandler $ \dbWrittenByOtherProcess -> do

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

683− --read transaction data and compare to existing graph

684− --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)

685− manip <- atomically $ do

686− eSession <- sessionForSessionId sessionId sessions

687− --handle graph update by other process

688− oldGraph <- readTVar graphTvar

689− case eSession of

690− Left err -> pure (Left err)

691− Right session -> do

692− let mScriptSession = ipScriptSession conf

693− dbdir = case strat of

694− MinimalPersistence x -> x

695− CrashSafePersistence x -> x

696− _ -> error "accessing dbdir on non-persisted connection"

697− eRefreshedGraph <- if dbWrittenByOtherProcess then

698− unsafeIOToSTM (transactionGraphLoad dbdir oldGraph mScriptSession)

699− else

700− pure (Right oldGraph)

701− case eRefreshedGraph of

702− Left err -> pure (Left (DatabaseLoadError err))

703− Right refreshedGraph -> do

704− --snip it

705− eGraph <- executeGraphExprSTM_ dbWrittenByOtherProcess freshId sessionId session sessions graphExpr refreshedGraph graphTvar

706− --snip it

707− case eGraph of

708− Left err -> pure (Left err)

709− Right newGraph -> do

710− --handle commit

711− if isCommit graphExpr then do

712− case transactionForId (Sess.parentId session) oldGraph of

713− Left err -> pure $ Left err

714− Right previousTrans -> do

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

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

717− pure $ Right (evaldNots, nodesToNotify, newGraph)

718− else

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

720− case manip of

721− Left err -> return $ Just err

722− Right (notsToFire, nodesToNotify, newGraph) -> do

723− --update filesystem database, if necessary

724− processTransactionGraphPersistence strat newGraph

725− sendNotifications nodesToNotify (ipLocalNode conf) notsToFire

726− pure Nothing

727−-}

728−executeGraphExpr sessionId conn@(RemoteProcessConnection _) graphExpr = remoteCall conn (ExecuteGraphExpr sessionId graphExpr)

659+executeGraphExpr sessionId conn@(RemoteConnection _) graphExpr = remoteCall conn (ExecuteGraphExpr sessionId graphExpr)

729

660

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

731executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)

662executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)

732executeTransGraphRelationalExpr _ (InProcessConnection conf) tgraphExpr = excEither . atomically $ do

663executeTransGraphRelationalExpr _ (InProcessConnection conf) tgraphExpr = excEither . atomically $ do

733 let graphTvar = ipTransactionGraph conf

664 let graphTvar = ipTransactionGraph conf

734 graph <- readTVar graphTvar

665 graph <- readTVar graphTvar

735− case evalTransGraphRelationalExpr tgraphExpr graph of

666+ pure $ force $ optimizeAndEvalTransGraphRelationalExpr graph tgraphExpr

736− Left err -> pure (Left err)

737− Right relExpr -> case runReader (RE.evalRelationalExpr relExpr) (RE.mkRelationalExprState DBC.empty) of

738− Left err -> pure (Left err)

739− Right rel -> pure (force (Right rel))

740−executeTransGraphRelationalExpr sessionId conn@(RemoteProcessConnection _) tgraphExpr = remoteCall conn (ExecuteTransGraphRelationalExpr sessionId tgraphExpr)

667+executeTransGraphRelationalExpr sessionId conn@(RemoteConnection _) tgraphExpr = remoteCall conn (ExecuteTransGraphRelationalExpr sessionId tgraphExpr)

741

668

742-- | Schema expressions manipulate the isomorphic schemas for the current 'DatabaseContext'.

669-- | Schema expressions manipulate the isomorphic schemas for the current 'DatabaseContext'.

743executeSchemaExpr :: SessionId -> Connection -> Schema.SchemaExpr -> IO (Either RelationalError ())

670executeSchemaExpr :: SessionId -> Connection -> Schema.SchemaExpr -> IO (Either RelationalError ())

@@ -748,32 +675,36 @@ executeSchemaExpr sessionId (InProcessConnection conf) schemaExpr = atomically $

748 Left err -> pure (Left err)

675 Left err -> pure (Left err)

749 Right (session, _) -> do

676 Right (session, _) -> do

750 let subschemas' = subschemas session

677 let subschemas' = subschemas session

678+ transId = Sess.parentId session

679+ context = Sess.concreteDatabaseContext session

680+ graph <- readTVar (ipTransactionGraph conf)

751− case Schema.evalSchemaExpr schemaExpr (Sess.concreteDatabaseContext session) subschemas' of

681+ case Schema.evalSchemaExpr schemaExpr context transId graph subschemas' of

752 Left err -> pure (Left err)

682 Left err -> pure (Left err)

753 Right (newSubschemas, newContext) -> do

683 Right (newSubschemas, newContext) -> do

754 --hm- maybe we should start using lenses

684 --hm- maybe we should start using lenses

755 let discon = Sess.disconnectedTransaction session

685 let discon = Sess.disconnectedTransaction session

756 newSchemas = Schemas newContext newSubschemas

686 newSchemas = Schemas newContext newSubschemas

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

687+ newSession = Session (DisconnectedTransaction (Discon.parentId discon) newSchemas False) (Sess.schemaName session)

758− STMMap.insert newSession sessionId sessions

688+ StmMap.insert newSession sessionId sessions

759 pure (Right ())

689 pure (Right ())

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

690+executeSchemaExpr sessionId conn@(RemoteConnection _) schemaExpr = remoteCall conn (ExecuteSchemaExpr sessionId schemaExpr)

761

691

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

763commit :: SessionId -> Connection -> IO (Either RelationalError ())

693commit :: SessionId -> Connection -> IO (Either RelationalError ())

764commit sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Commit

694commit sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Commit

765−commit sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Commit)

695+commit sessionId conn@(RemoteConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Commit)

766−

696+

767−sendNotifications :: [ProcessId] -> LocalNode -> EvaluatedNotifications -> IO ()

697+sendNotifications :: [ClientInfo] -> EvaluatedNotifications -> IO ()

768−sendNotifications pids localNode nots = mapM_ sendNots pids

698+sendNotifications clients notifs =

769− where

699+ unless (M.null notifs) $ forM_ clients sender

770− sendNots remoteClientPid =

700+ where

771− unless (M.null nots) $ runProcess localNode $ send remoteClientPid (NotificationMessage nots)

701+ sender (RemoteClientInfo sock) = RPC.sendMessage sock (NotificationMessage notifs)

772−

702+ sender (InProcessClientInfo tvar) = putMVar tvar notifs

703+

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

774rollback :: SessionId -> Connection -> IO (Either RelationalError ())

705rollback :: SessionId -> Connection -> IO (Either RelationalError ())

775rollback sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Rollback

706rollback sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Rollback

776−rollback sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Rollback)

707+rollback sessionId conn@(RemoteConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Rollback)

777

708

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

779processTransactionGraphPersistence :: PersistenceStrategy -> [TransactionId] -> TransactionGraph -> IO ()

710processTransactionGraphPersistence :: PersistenceStrategy -> [TransactionId] -> TransactionGraph -> IO ()

@@ -789,7 +720,7 @@ readGraphTransactionIdDigest (CrashSafePersistence dbdir) = readGraphTransaction

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

790typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

721typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

791typeForRelationalExpr sessionId conn@(InProcessConnection _) relExpr = atomically $ typeForRelationalExprSTM sessionId conn relExpr

722typeForRelationalExpr sessionId conn@(InProcessConnection _) relExpr = atomically $ typeForRelationalExprSTM sessionId conn relExpr

792−typeForRelationalExpr sessionId conn@(RemoteProcessConnection _) relExpr = remoteCall conn (ExecuteTypeForRelationalExpr sessionId relExpr)

723+typeForRelationalExpr sessionId conn@(RemoteConnection _) relExpr = remoteCall conn (ExecuteTypeForRelationalExpr sessionId relExpr)

793

724

794typeForRelationalExprSTM :: SessionId -> Connection -> RelationalExpr -> STM (Either RelationalError Relation)

725typeForRelationalExprSTM :: SessionId -> Connection -> RelationalExpr -> STM (Either RelationalError Relation)

795typeForRelationalExprSTM sessionId (InProcessConnection conf) relExpr = do

726typeForRelationalExprSTM sessionId (InProcessConnection conf) relExpr = do

@@ -804,7 +735,10 @@ typeForRelationalExprSTM sessionId (InProcessConnection conf) relExpr = do

804 Schema.processRelationalExprInSchema schema relExpr

735 Schema.processRelationalExprInSchema schema relExpr

805 case processed of

736 case processed of

806 Left err -> pure (Left err)

737 Left err -> pure (Left err)

738+ Right relExpr' -> do

739+ graph <- readTVar (ipTransactionGraph conf)

807− 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')

808

742

809typeForRelationalExprSTM _ _ _ = error "typeForRelationalExprSTM called on non-local connection"

743typeForRelationalExprSTM _ _ _ = error "typeForRelationalExprSTM called on non-local connection"

810

744

@@ -823,22 +757,38 @@ inclusionDependencies sessionId (InProcessConnection conf) = do

823 else

757 else

824 pure (Schema.inclusionDependenciesInSchema schema (B.inclusionDependencies context))

758 pure (Schema.inclusionDependenciesInSchema schema (B.inclusionDependencies context))

825

759

826−inclusionDependencies sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveInclusionDependencies sessionId)

760+inclusionDependencies sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveInclusionDependencies sessionId)

827

761

762+typeConstructorMapping :: SessionId -> Connection -> IO (Either RelationalError TypeConstructorMapping)

763+typeConstructorMapping sessionId (InProcessConnection conf) = do

764+ let sessions = ipSessions conf

765+ atomically $ do

766+ eSession <- sessionAndSchema sessionId sessions

767+ case eSession of

768+ Left err -> pure $ Left err

769+ Right (session, _) -> --warning, no schema support for typeconstructors

770+ pure (Right (B.typeConstructorMapping (Sess.concreteDatabaseContext session)))

771+typeConstructorMapping sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveTypeConstructorMapping sessionId)

772+

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

829−planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError DatabaseContextExpr)

774+planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr)

830planForDatabaseContextExpr sessionId (InProcessConnection conf) dbExpr = do

775planForDatabaseContextExpr sessionId (InProcessConnection conf) dbExpr = do

831 let sessions = ipSessions conf

776 let sessions = ipSessions conf

832 atomically $ do

777 atomically $ do

778+ graph <- readTVar (ipTransactionGraph conf)

833 eSession <- sessionAndSchema sessionId sessions

779 eSession <- sessionAndSchema sessionId sessions

834 case eSession of

780 case eSession of

835 Left err -> pure $ Left err

781 Left err -> pure $ Left err

782+ Right (session, _) ->

836− Right (session, _) -> if schemaName session == defaultSchemaName then

783+ if schemaName session == defaultSchemaName then do

837− 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)

838− 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-}

839− pure (Right dbExpr)

789+ pure (Left NonConcreteSchemaPlanError)

840

790

841−planForDatabaseContextExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr)

791+planForDatabaseContextExpr sessionId conn@(RemoteConnection _) dbExpr = remoteCall conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr)

842

792

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

844-- * 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

@@ -853,30 +803,57 @@ transactionGraphAsRelation sessionId (InProcessConnection conf) = do

853 eSession <- sessionForSessionId sessionId sessions

803 eSession <- sessionForSessionId sessionId sessions

854 case eSession of

804 case eSession of

855 Left err -> pure $ Left err

805 Left err -> pure $ Left err

856− Right session -> do

806+ Right session ->

857− graph <- readTVar tvar

858− pure $ graphAsRelation (Sess.disconnectedTransaction session) graph

807+ graphAsRelation (Sess.disconnectedTransaction session) <$> readTVar tvar

859

808

860−transactionGraphAsRelation sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveTransactionGraph sessionId)

809+transactionGraphAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveTransactionGraph sessionId)

861

810

862-- | 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'.

863relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

812relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

864relationVariablesAsRelation sessionId (InProcessConnection conf) = do

813relationVariablesAsRelation sessionId (InProcessConnection conf) = do

865 let sessions = ipSessions conf

814 let sessions = ipSessions conf

866 atomically $ do

815 atomically $ do

816+ graph <- readTVar (ipTransactionGraph conf)

867 eSession <- sessionAndSchema sessionId sessions

817 eSession <- sessionAndSchema sessionId sessions

868 case eSession of

818 case eSession of

869 Left err -> pure (Left err)

819 Left err -> pure (Left err)

870 Right (session, schema) -> do

820 Right (session, schema) -> do

871 let context = Sess.concreteDatabaseContext session

821 let context = Sess.concreteDatabaseContext session

872 if Sess.schemaName session == defaultSchemaName then

822 if Sess.schemaName session == defaultSchemaName then

873− pure $ R.relationVariablesAsRelation (relationVariables context)

823+ pure $ RE.relationVariablesAsRelation context graph

874 else

824 else

875− case Schema.relationVariablesInSchema schema context of

825+ case Schema.relationVariablesInSchema schema of

876 Left err -> pure (Left err)

826 Left err -> pure (Left err)

827+ Right relvars -> do

828+ let schemaContext = context {relationVariables = relvars }

877− Right relvars -> pure $ R.relationVariablesAsRelation relvars

829+ pure $ RE.relationVariablesAsRelation schemaContext graph

878

830

879−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)

880

857

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

882headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId)

859headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId)

@@ -887,7 +864,7 @@ headTransactionId sessionId (InProcessConnection conf) = do

887 case eSession of

864 case eSession of

888 Left err -> pure (Left err)

865 Left err -> pure (Left err)

889 Right session -> pure $ Right (Sess.parentId session)

866 Right session -> pure $ Right (Sess.parentId session)

890−headTransactionId sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveHeadTransactionId sessionId)

867+headTransactionId sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveHeadTransactionId sessionId)

891

868

892headNameSTM_ :: SessionId -> Sessions -> TVar TransactionGraph -> STM (Either RelationalError HeadName)

869headNameSTM_ :: SessionId -> Sessions -> TVar TransactionGraph -> STM (Either RelationalError HeadName)

893headNameSTM_ sessionId sessions graphTvar = do

870headNameSTM_ sessionId sessions graphTvar = do

@@ -895,7 +872,7 @@ headNameSTM_ sessionId sessions graphTvar = do

895 eSession <- sessionForSessionId sessionId sessions

872 eSession <- sessionForSessionId sessionId sessions

896 case eSession of

873 case eSession of

897 Left err -> pure (Left err)

874 Left err -> pure (Left err)

898− Right session -> case transactionForId (Sess.parentId session) graph of

875+ Right session -> case RE.transactionForId (Sess.parentId session) graph of

899 Left err -> pure (Left err)

876 Left err -> pure (Left err)

900 Right parentTrans -> case headNameForTransaction parentTrans graph of

877 Right parentTrans -> case headNameForTransaction parentTrans graph of

901 Nothing -> pure (Left UnknownHeadError)

878 Nothing -> pure (Left UnknownHeadError)

@@ -907,7 +884,7 @@ headName sessionId (InProcessConnection conf) = do

907 let sessions = ipSessions conf

884 let sessions = ipSessions conf

908 graphTvar = ipTransactionGraph conf

885 graphTvar = ipTransactionGraph conf

909 atomically (headNameSTM_ sessionId sessions graphTvar)

886 atomically (headNameSTM_ sessionId sessions graphTvar)

910−headName sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteHeadName sessionId)

887+headName sessionId conn@(RemoteConnection _) = remoteCall conn (ExecuteHeadName sessionId)

911

888

912-- | Returns a listing of all available atom types.

889-- | Returns a listing of all available atom types.

913atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

890atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

@@ -918,10 +895,10 @@ atomTypesAsRelation sessionId (InProcessConnection conf) = do

918 case eSession of

895 case eSession of

919 Left err -> pure (Left err)

896 Left err -> pure (Left err)

920 Right session ->

897 Right session ->

921− case typesAsRelation (typeConstructorMapping (Sess.concreteDatabaseContext session)) of

898+ case typesAsRelation (B.typeConstructorMapping (Sess.concreteDatabaseContext session)) of

922 Left err -> pure (Left err)

899 Left err -> pure (Left err)

923 Right rel -> pure (Right rel)

900 Right rel -> pure (Right rel)

924−atomTypesAsRelation sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveAtomTypesAsRelation sessionId)

901+atomTypesAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveAtomTypesAsRelation sessionId)

925

902

926disconnectedTransactionIsDirty :: SessionId -> Connection -> IO (Either RelationalError Bool)

903disconnectedTransactionIsDirty :: SessionId -> Connection -> IO (Either RelationalError Bool)

927disconnectedTransactionIsDirty sessionId (InProcessConnection conf) = do

904disconnectedTransactionIsDirty sessionId (InProcessConnection conf) = do

@@ -932,23 +909,23 @@ disconnectedTransactionIsDirty sessionId (InProcessConnection conf) = do

932 Left err -> pure (Left err)

909 Left err -> pure (Left err)

933 Right session ->

910 Right session ->

934 pure (Right (isDirty session))

911 pure (Right (isDirty session))

935−disconnectedTransactionIsDirty sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveSessionIsDirty sessionId)

912+disconnectedTransactionIsDirty sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveSessionIsDirty sessionId)

936

913

937--used only for testing- we expect this to throw an exception

914--used only for testing- we expect this to throw an exception

938callTestTimeout_ :: SessionId -> Connection -> IO Bool

915callTestTimeout_ :: SessionId -> Connection -> IO Bool

939callTestTimeout_ _ (InProcessConnection _) = error "bad testing call"

916callTestTimeout_ _ (InProcessConnection _) = error "bad testing call"

940−callTestTimeout_ sessionId conn@(RemoteProcessConnection _) = remoteCall conn (TestTimeout sessionId)

917+callTestTimeout_ sessionId conn@(RemoteConnection _) = remoteCall conn (TestTimeout sessionId)

941

918

942--used in tests only

919--used in tests only

943transactionGraph_ :: Connection -> IO TransactionGraph

920transactionGraph_ :: Connection -> IO TransactionGraph

944−transactionGraph_ (InProcessConnection conf) = atomically $ readTVar (ipTransactionGraph conf)

921+transactionGraph_ (InProcessConnection conf) = readTVarIO (ipTransactionGraph conf)

945transactionGraph_ _ = error "remote connection used"

922transactionGraph_ _ = error "remote connection used"

946

923

947--used in tests only

924--used in tests only

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

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

949disconnectedTransaction_ sessionId (InProcessConnection conf) = do

926disconnectedTransaction_ sessionId (InProcessConnection conf) = do

950 let sessions = ipSessions conf

927 let sessions = ipSessions conf

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

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

952 case mSession of

929 case mSession of

953 Nothing -> error "No such session"

930 Nothing -> error "No such session"

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

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

@@ -1006,13 +983,13 @@ commitLock_ sessionId conf stmBlock = do

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

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

1007 writeTVar graphTvar graph'

984 writeTVar graphTvar graph'

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

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

1009− STMMap.insert newSession sessionId sessions

986+ StmMap.insert newSession sessionId sessions

1010− case transactionForId (Sess.parentId session) oldGraph of

987+ case RE.transactionForId (Sess.parentId session) oldGraph of

1011 Left err -> pure $ Left err

988 Left err -> pure $ Left err

1012 Right previousTrans ->

989 Right previousTrans ->

1013 if not (Prelude.null transactionIdsToPersist) then do

990 if not (Prelude.null transactionIdsToPersist) then do

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

991+ (evaldNots, nodes) <- executeCommitExprSTM_ graph' (Trans.concreteDatabaseContext previousTrans) (Sess.concreteDatabaseContext session) clientNodes

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

992+ nodesToNotify <- stmSetToList nodes

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

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

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

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

1018

995

@@ -1022,15 +999,8 @@ commitLock_ sessionId conf stmBlock = do

1022 Right (notsToFire, nodesToNotify, newGraph, transactionIdsToPersist) -> do

999 Right (notsToFire, nodesToNotify, newGraph, transactionIdsToPersist) -> do

1023 --update filesystem database, if necessary

1000 --update filesystem database, if necessary

1024 processTransactionGraphPersistence strat transactionIdsToPersist newGraph

1001 processTransactionGraphPersistence strat transactionIdsToPersist newGraph

1025− sendNotifications nodesToNotify (ipLocalNode conf) notsToFire

1002+ sendNotifications nodesToNotify notsToFire

1026 pure (Right ())

1003 pure (Right ())

1027−{-

1028−writeDisconAndGraph_ :: TVar TransactionGraph -> SessionId -> Session -> Sessions -> DisconnectedTransaction -> TransactionGraph -> STM ()

1029−writeDisconAndGraph_ graphTvar sessionId session sessions discon graph = do

1030− writeTVar graphTvar graph

1031− let newSession = Session discon (Sess.schemaName session)

1032− STMMap.insert newSession sessionId sessions

1033−-}

1034

1004

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

1036withTransaction :: 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)

@@ -1055,3 +1025,71 @@ withTransaction sessionId conn io successFunc = bracketOnError (pure ()) (const

1055 Right _ -> pure (Right val)

1025 Right _ -> pure (Right val)

1056 else -- no updates executed, so don't create a commit

1026 else -- no updates executed, so don't create a commit

1057 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+5−4

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

1{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2+-- | A simplified client interface for Project:M36 database access.

2module ProjectM36.Client.Simple (

3module ProjectM36.Client.Simple (

3 simpleConnectProjectM36,

4 simpleConnectProjectM36,

4 simpleConnectProjectM36At,

5 simpleConnectProjectM36At,

@@ -24,10 +25,10 @@ module ProjectM36.Client.Simple (

24 C.PersistenceStrategy(..),

25 C.PersistenceStrategy(..),

25 C.NotificationCallback,

26 C.NotificationCallback,

26 C.emptyNotificationCallback,

27 C.emptyNotificationCallback,

27− C.DatabaseContextExpr(..),

28+ C.DatabaseContextExprBase(..),

29+ C.DatabaseContextExpr,

28 C.RelationalExprBase(..)

30 C.RelationalExprBase(..)

29 ) where

31 ) where

30−-- | A simplified client interface for Project:M36 database access.

32import Control.Exception.Base

33import Control.Exception.Base

33import Control.Monad ((<=<))

34import Control.Monad ((<=<))

@@ -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+4−4

@@ -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,5 +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

20−typeVarsInDefArg (DataConstructorDefTypeVarNameArg pVarName) = S.singleton pVarName

19+typeVarsInDefArg (DataConstructorDefTypeVarNameArg pVarName) = S.singleton pVarName

20+

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+8−4

@@ -37,13 +37,17 @@ 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",

46 atomFuncType = [listAtomType (TypeVariableType "a"), maybeAtomType (TypeVariableType "a")],

45 atomFuncType = [listAtomType (TypeVariableType "a"), maybeAtomType (TypeVariableType "a")],

47 atomFuncBody = AtomFunctionBody Nothing (\(listAtom:_) -> listMaybeHead listAtom)

46 atomFuncBody = AtomFunctionBody Nothing (\(listAtom:_) -> listMaybeHead listAtom)

48 }

47 }

49− ]

48+ ]

49+

50+--just a private utility function

51+listCons :: AtomType -> [Atom] -> Atom

52+listCons typ [] = ConstructedAtom "Empty" (listAtomType typ) []

53+listCons typ (a:as) = ConstructedAtom "Cons" (listAtomType typ) [a, listCons typ as]

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+31−16

@@ -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,10 +62,12 @@ 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

66− | FunctionArgumentCountMismatch Int Int

69+ | FunctionArgumentCountMismatchError Int Int

70+ | ConstructedAtomArgumentCountMismatchError Int Int

67 | NoSuchDataConstructorError DataConstructorName

71 | NoSuchDataConstructorError DataConstructorName

68 | NoSuchTypeConstructorError TypeConstructorName

72 | NoSuchTypeConstructorError TypeConstructorName

69 | InvalidAtomTypeName AtomTypeName

73 | InvalidAtomTypeName AtomTypeName

@@ -77,11 +81,12 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

77 | RelationValuedAttributesNotSupportedError [AttributeName]

81 | RelationValuedAttributesNotSupportedError [AttributeName]

78 | NotificationNameInUseError NotificationName

82 | NotificationNameInUseError NotificationName

79 | NotificationNameNotInUseError NotificationName

83 | NotificationNameNotInUseError NotificationName

80− | 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'

81 | ExportError T.Text

85 | ExportError T.Text

82 | UnhandledExceptionError String

86 | UnhandledExceptionError String

83 | MergeTransactionError MergeError

87 | MergeTransactionError MergeError

84 | ScriptError ScriptCompilationError

88 | ScriptError ScriptCompilationError

89+ | LoadFunctionError

85 | DatabaseContextFunctionUserError DatabaseContextFunctionError

90 | DatabaseContextFunctionUserError DatabaseContextFunctionError

86 | DatabaseLoadError PersistenceError

91 | DatabaseLoadError PersistenceError

@@ -91,14 +96,21 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

91 | SchemaCreationError SchemaError

96 | SchemaCreationError SchemaError

93 | ImproperDatabaseStateError

98 | ImproperDatabaseStateError

94−

99+

100+ | NonConcreteSchemaPlanError

101+

102+ | NoUncommittedContextInEvalError

103+ | TupleExprsReferenceMultipleMarkersError

104+

105+ | MerkleHashValidationError TransactionId MerkleHash MerkleHash

106+

95 | MultipleErrors [RelationalError]

107 | MultipleErrors [RelationalError]

96− deriving (Show,Eq,Generic,Binary,Typeable, NFData)

108+ deriving (Show,Eq,Generic,Typeable, NFData)

109

98data PersistenceError = InvalidDirectoryError FilePath |

110data PersistenceError = InvalidDirectoryError FilePath |

99 MissingTransactionError TransactionId |

111 MissingTransactionError TransactionId |

100 WrongDatabaseFormatVersionError String String

112 WrongDatabaseFormatVersionError String String

101− deriving (Show, Eq, Generic, Binary, NFData)

113+ deriving (Show, Eq, Generic, NFData)

102

114

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

104someErrors :: [RelationalError] -> RelationalError

116someErrors :: [RelationalError] -> RelationalError

@@ -116,7 +128,7 @@ data MergeError = SelectedHeadMismatchMergeError |

116 StrategyViolatesComponentMergeError | --failed merge in inc deps, relvars, etc.

128 StrategyViolatesComponentMergeError | --failed merge in inc deps, relvars, etc.

117 StrategyViolatesRelationVariableMergeError |

129 StrategyViolatesRelationVariableMergeError |

118 StrategyViolatesTypeConstructorMergeError

130 StrategyViolatesTypeConstructorMergeError

119− deriving (Show, Eq, Generic, Binary, Typeable)

131+ deriving (Show, Eq, Generic, Typeable)

120

132

121instance NFData MergeError where rnf = genericRnf

133instance NFData MergeError where rnf = genericRnf

122

134

@@ -124,17 +136,20 @@ data ScriptCompilationError = TypeCheckCompilationError String String | --expect

124 SyntaxErrorCompilationError String |

136 SyntaxErrorCompilationError String |

125 ScriptCompilationDisabledError |

137 ScriptCompilationDisabledError |

126 OtherScriptCompilationError String

138 OtherScriptCompilationError String

127− deriving (Show, Eq, Generic, Binary, Typeable, NFData)

139+ deriving (Show, Eq, Generic, Typeable, NFData)

128

140

129instance Exception ScriptCompilationError

141instance Exception ScriptCompilationError

130

142

131data SchemaError = RelVarReferencesMissing (S.Set RelVarName) |

143data SchemaError = RelVarReferencesMissing (S.Set RelVarName) |

132 RelVarInReferencedMoreThanOnce RelVarName |

144 RelVarInReferencedMoreThanOnce RelVarName |

133 RelVarOutReferencedMoreThanOnce RelVarName

145 RelVarOutReferencedMoreThanOnce RelVarName

134− deriving (Show, Eq, Generic, Binary, Typeable, NFData)

146+ deriving (Show, Eq, Generic, Typeable, NFData)

135−

147+

136−

148+

137−-- errors returned from the distributed-process call handlers

149+data ImportError' = InvalidSHA256Error T.Text

138−data ServerError = RequestTimeoutError |

150+ | SHA256MismatchError T.Text T.Text

139− ProcessDiedError String

151+ | InvalidFileURIError T.Text

152+ | ImportFileDecodeError T.Text

153+ | ImportFileError T.Text

154+ | ImportDownloadError T.Text

140− deriving (Generic, Binary, Eq)

155+ deriving (Show, Eq, Generic, Typeable, NFData)

src/lib/ProjectM36/FSType.hsnew file+102

@@ -0,0 +1,102 @@

1+{-# LANGUAGE CPP #-}

2+-- confirm that the filesystem type is a journaled FS type expected by Project:M36

3+-- use statfs on Linux and macOS and GetVolumeInformation on Windows

4+-- this could still be fooled with symlinks or by disabling journaling on filesystems that support that

5+module ProjectM36.FSType where

7+#if defined(mingw32_HOST_OS)

8+# if defined(i386_HOST_ARCH)

9+# define WINDOWS_CCONV stdcall

10+# elif defined(x86_64_HOST_ARCH)

11+# define WINDOWS_CCONV ccall

12+# endif

13+import System.Win32.Types

14+import Foreign.ForeignPtr

15+import Data.Word

16+import Data.Bits

17+import Foreign.Storable

18+

19+foreign import WINDOWS_CCONV unsafe "windows.h GetVolumePathNameW"

20+ c_GetVolumePathName :: LPCTSTR -> LPTSTR -> DWORD -> IO BOOL

21+

22+foreign import WINDOWS_CCONV unsafe "windows.h GetVolumeInformationW"

23+ c_GetVolumeInformation :: LPCTSTR -> LPTSTR -> DWORD -> LPDWORD -> LPDWORD -> LPDWORD -> LPTSTR -> DWORD -> IO BOOL

24+

25+#define FILE_SUPPORTS_USN_JOURNAL 0x02000000

26+

27+getVolumePathName :: FilePath -> IO String

28+getVolumePathName path = do

29+ let maxpathlen = 260 --ANSI MAX_PATH- we only care about the drive name anyway

30+ withTString path $ \c_path -> do

31+ fp_pathout <- mallocForeignPtrBytes maxpathlen

32+ withForeignPtr fp_pathout $ \pathout -> do

33+ failIfFalse_ ("GetVolumePathNameW " ++ path) (c_GetVolumePathName c_path pathout (fromIntegral maxpathlen))

34+ peekTString pathout

35+

36+fsTypeSupportsJournaling :: FilePath -> IO Bool

37+fsTypeSupportsJournaling path = do

38+ -- get the drive path of the incoming path

39+ drive <- getVolumePathName path

40+ withTString drive $ \c_drive -> do

41+ foreign_flags <- mallocForeignPtrBytes 8

42+ withForeignPtr foreign_flags $ \ptr_fsFlags -> do

43+ failIfFalse_ (unwords ["GetVolumeInformationW", path]) (c_GetVolumeInformation c_drive nullPtr 0 nullPtr nullPtr ptr_fsFlags nullPtr 0)

44+ fsFlags <- peekByteOff ptr_fsFlags 0 :: IO Word64

45+ pure (fsFlags .&. FILE_SUPPORTS_USN_JOURNAL /= 0)

46+

47+#elif darwin_HOST_OS

48+import Foreign.C.Error

49+import Foreign.C.String

50+import Foreign.C.Types

51+

52+--Darwin reports journaling directly in the fs flags

53+

54+type CStatFS = ()

55+foreign import ccall unsafe "cDarwinFSJournaled"

56+ c_DarwinFSJournaled :: CString -> IO CInt

57+

58+fsTypeSupportsJournaling :: FilePath -> IO Bool

59+fsTypeSupportsJournaling path =

60+ withCString path $ \c_path -> do

61+ ret <- throwErrnoIfMinus1 "statfs" (c_DarwinFSJournaled c_path)

62+ pure (ret > (0 :: CInt))

63+

64+#elif linux_HOST_OS

65+import Foreign

66+import Foreign.C.Error

67+import Foreign.C.String

68+import Foreign.C.Types

69+

70+#include "MachDeps.h"

71+--Linux cannot report journaling, so we just check the filesystem type as a proxy

72+type CStatFS = ()

73+foreign import ccall unsafe "sys/vfs.h statfs"

74+ c_statfs :: CString -> Ptr CStatFS -> IO CInt

75+

76+#if WORD_SIZE_IN_BITS == 64

77+type CFSType = Word64

78+sizeofStructStatFS :: Int

79+sizeofStructStatFS = 120

80+#else

81+#error 32-bit not supported due to sizeof struct statfs missing

82+type CFSType = Word32

83+sizeofStructStatFS :: Int

84+sizeofStructStatFS = undefined

85+#endif

86+

87+fsTypeSupportsJournaling :: FilePath -> IO Bool

88+fsTypeSupportsJournaling path = do

89+ struct_statfs <- mallocForeignPtrBytes sizeofStructStatFS

90+ withCString path $ \c_path -> do

91+ withForeignPtr struct_statfs $ \ptr_statfs -> do

92+ throwErrnoIfMinus1_ "statfs" (c_statfs c_path ptr_statfs)

93+ cfstype <- peekByteOff ptr_statfs 0 :: IO CFSType

94+ let journaledFS = [0xEF53, --EXT3+4

95+ 0x5346544e, --NTFS

96+ 0x52654973, --REISERFS

97+ 0x58465342, --XFS

98+ 0x3153464a --JFS

99+ ]

100+ pure (elem cfstype journaledFS)

101+#endif

102+

src/lib/ProjectM36/FileLock.hs+42−31

@@ -2,11 +2,9 @@

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

@@ -24,9 +22,24 @@ foreign import WINDOWS_CCONV "LockFileEx" c_lockFileEx :: HANDLE -> DWORD -> DWO

25foreign import WINDOWS_CCONV "UnlockFileEx" c_unlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL

23foreign import WINDOWS_CCONV "UnlockFileEx" c_unlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL

25+type LockFile = HANDLE

26+

27+openLockFile :: FilePath -> IO LockFile

28+openLockFile path = createFile path

29+ (gENERIC_READ .|. gENERIC_WRITE)

30+ (fILE_SHARE_READ .|. fILE_SHARE_WRITE)

31+ Nothing

32+ oPEN_ALWAYS

33+ fILE_ATTRIBUTE_NORMAL

34+ Nothing

35+

36+closeLockFile :: LockFile -> IO ()

37+closeLockFile file = do

38+ closeHandle file

39+

27--swiped from System.FileLock package

40--swiped from System.FileLock package

28−lockFile :: Handle -> LockType -> IO ()

41+lockFile :: HANDLE -> LockType -> IO ()

29−lockFile handle lock = withHandleToHANDLE handle $ \winHandle -> do

42+lockFile winHandle lock = do

30 let exFlag = case lock of

43 let exFlag = case lock of

31 WriteLock -> 2

44 WriteLock -> 2

32 ReadLock -> 0

45 ReadLock -> 0

@@ -35,51 +48,49 @@ lockFile handle lock = withHandleToHANDLE handle $ \winHandle -> do

36 allocaBytes sizeof_OVERLAPPED $ \op -> do

49 allocaBytes sizeof_OVERLAPPED $ \op -> do

37 zeroMemory op $ fromIntegral sizeof_OVERLAPPED

50 zeroMemory op $ fromIntegral sizeof_OVERLAPPED

38− res <- c_lockFileEx winHandle (exFlag .|. blockFlag) 0 1 0 op

51+ failIfFalse_ "LockFileEx" $ c_lockFileEx winHandle (exFlag .|. blockFlag) 0 1 0 op

39− if res then

52+

40− pure ()

41− else

42− error "failed to wait for database lock"

43−

44−unlockFile :: Handle -> IO ()

53+unlockFile :: HANDLE -> IO ()

45−unlockFile handle = withHandleToHANDLE handle $ \winHandle -> do

54+unlockFile winHandle = do

46 let sizeof_OVERLAPPED = 32

55 let sizeof_OVERLAPPED = 32

47 allocaBytes sizeof_OVERLAPPED $ \op -> do

56 allocaBytes sizeof_OVERLAPPED $ \op -> do

48 zeroMemory op $ fromIntegral sizeof_OVERLAPPED

57 zeroMemory op $ fromIntegral sizeof_OVERLAPPED

49− res <- c_unlockFileEx winHandle 0 1 0 op

58+ failIfFalse_ "UnlockFileEx" $ c_unlockFileEx winHandle 0 1 0 op

50− if res then

51− pure ()

52− else

53− error ("failed to unlock database lock: " ++ show res)

55#else

60#else

61+--all of this complicated nonsense is fixed if we switch to GHC 8.2 which includes native flock support on handles

56import qualified System.Posix.IO as P

62import qualified System.Posix.IO as P

63+import System.Posix.Types

64+import System.Posix.Files

65+import System.IO

58lockStruct :: P.LockRequest -> P.FileLock

67lockStruct :: P.LockRequest -> P.FileLock

59lockStruct req = (req, AbsoluteSeek, 0, 0)

68lockStruct req = (req, AbsoluteSeek, 0, 0)

70+newtype LockFile = LockFile Fd

71+

72+--we cannot use openFile from System.IO because it implements complicated locking which prevents opening the same file twice in write mode in the same process with no way to bypass the check.

73+openLockFile :: FilePath -> IO LockFile

74+openLockFile path =

75+ LockFile <$> P.createFile path ownerWriteMode

76+

77+closeLockFile :: LockFile -> IO ()

78+closeLockFile (LockFile fd) =

79+ P.closeFd fd

80+

61--blocks on lock, if necessary

81--blocks on lock, if necessary

62−lockFile :: Handle -> LockType -> IO ()

82+lockFile :: LockFile -> LockType -> IO ()

63−lockFile file lock = do

83+lockFile (LockFile fd) lock = do

64− fd <- P.handleToFd file

65 let lockt = case lock of

84 let lockt = case lock of

66 WriteLock -> P.WriteLock

85 WriteLock -> P.WriteLock

67 ReadLock -> P.ReadLock

86 ReadLock -> P.ReadLock

68 P.waitToSetLock fd (lockStruct lockt)

87 P.waitToSetLock fd (lockStruct lockt)

70−unlockFile :: Handle -> IO ()

89+unlockFile :: LockFile -> IO ()

71−unlockFile file = do

90+unlockFile (LockFile fd) =

72− fd <- P.handleToFd file

73 P.waitToSetLock fd (lockStruct P.Unlock)

91 P.waitToSetLock fd (lockStruct P.Unlock)

74#endif

92#endif

76−data LockType = ReadLock | WriteLock

94+data LockType = ReadLock | WriteLock deriving (Show)

77−

78−{-

79−lockFileSTM :: Handle -> LockType -> STM ()

80−lockFileSTM file lock = unsafeIOToSTM $ onException (lockFile file lock) (unlockFile file)

82−unlockFileSTM :: Handle -> STM ()

83−unlockFileSTM file = unsafeIOToSTM $ unlockFile file

84−-}

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+62−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

@@ -31,11 +47,12 @@ foreign import ccall unsafe "cDirectoryFsync" cHSDirectoryFsync :: CString -> IO

32data DiskSync = NoDiskSync | FsyncDiskSync

48data DiskSync = NoDiskSync | FsyncDiskSync

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

34−writeFileSync :: DiskSync -> FilePath -> Text -> IO()

51+writeFileSync :: DiskSync -> FilePath -> T.Text -> IO()

35writeFileSync sync path strOut = withFile path WriteMode handler

52writeFileSync sync path strOut = withFile path WriteMode handler

36 where

53 where

37 handler handle = do

54 handler handle = do

38− TIO.hPutStr handle strOut

55+ BS'.hPut handle (TE.encodeUtf8 strOut)

39 syncHandle sync handle

56 syncHandle sync handle

41renameSync :: DiskSync -> FilePath -> FilePath -> IO ()

58renameSync :: DiskSync -> FilePath -> FilePath -> IO ()

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

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

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

49atomicRename srcPath dstPath =

66atomicRename srcPath dstPath =

50#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

51− Win32.moveFileEx srcPath dstPath Win32.mOVEFILE_REPLACE_EXISTING

74+ Win32.moveFileEx srcPath dst Win32.mOVEFILE_REPLACE_EXISTING

52#else

75#else

53 Posix.rename srcPath dstPath

76 Posix.rename srcPath dstPath

54#endif

77#endif

@@ -58,21 +81,28 @@ syncHandle FsyncDiskSync handle =

58#if defined(mingw32_HOST_OS)

81#if defined(mingw32_HOST_OS)

59 withHandleToHANDLE handle (\h -> Win32.flushFileBuffers h)

82 withHandleToHANDLE handle (\h -> Win32.flushFileBuffers h)

60#elif defined(linux_HOST_OS)

83#elif defined(linux_HOST_OS)

84+ do

61 --fdatasync doesn't exist on macOS

85 --fdatasync doesn't exist on macOS

86+ fd <- handleToFd handle

62− handleToFd handle >>= fileSynchroniseDataOnly

87+ fileSynchroniseDataOnly fd

88+ closeFd fd

63−#else

89+#else

90+ do

91+ fd <- handleToFd handle

64− handleToFd handle >>= fileSynchronise

92+ fileSynchronise fd

93+ closeFd fd

65#endif

94#endif

95+

66syncHandle NoDiskSync _ = pure ()

96syncHandle NoDiskSync _ = pure ()

68syncDirectory :: DiskSync -> FilePath -> IO ()

98syncDirectory :: DiskSync -> FilePath -> IO ()

69syncDirectory FsyncDiskSync path = directoryFsync path

99syncDirectory FsyncDiskSync path = directoryFsync path

70syncDirectory NoDiskSync _ = pure ()

100syncDirectory NoDiskSync _ = pure ()

101

72−writeBSFileSync :: DiskSync -> FilePath -> BS.ByteString -> IO ()

102+writeBSFileSync :: DiskSync -> FilePath -> BS'.ByteString -> IO ()

73writeBSFileSync sync path bstring =

103writeBSFileSync sync path bstring =

74 withFile path WriteMode $ \handle -> do

104 withFile path WriteMode $ \handle -> do

75− BS.hPut handle bstring

105+ BS'.hPut handle bstring

76 syncHandle sync handle

106 syncHandle sync handle

107

78directoryFsync :: FilePath -> IO ()

108directoryFsync :: FilePath -> IO ()

@@ -82,3 +112,22 @@ directoryFsync _ = pure () -- on Windows directory metadata cannot be synchroniz

82directoryFsync path = throwErrnoIfMinus1Retry_ "directoryFsync" (withCString path $ \cpath -> cHSDirectoryFsync cpath)

112directoryFsync path = throwErrnoIfMinus1Retry_ "directoryFsync" (withCString path $ \cpath -> cHSDirectoryFsync cpath)

83#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+133−22

@@ -1,21 +1,27 @@

1module ProjectM36.Relation.Parse.CSV where

2--parse Relations from CSV

3+import ProjectM36.Base

4+import ProjectM36.Error

5+import ProjectM36.Relation

6+import ProjectM36.AtomType

7+import ProjectM36.DataTypes.Interval

8+import qualified ProjectM36.Attribute as A

3import Data.Csv.Parser

10import Data.Csv.Parser

4import qualified Data.Vector as V

11import qualified Data.Vector as V

5−import Data.Char (ord)

12+import Data.Char (ord, isUpper, isSpace)

6import qualified Data.ByteString.Lazy as BS

13import qualified Data.ByteString.Lazy as BS

7−import ProjectM36.Base

8−import ProjectM36.Relation

9−import ProjectM36.Error

10import Data.Text.Encoding (decodeUtf8)

14import Data.Text.Encoding (decodeUtf8)

11−import qualified ProjectM36.Attribute as A

12import qualified Data.Set as S

15import qualified Data.Set as S

13−import Data.HashMap.Lazy as HM

16+import qualified Data.HashMap.Lazy as HM

14import qualified Data.List as L

17import qualified Data.List as L

15import qualified Data.Text as T

18import qualified Data.Text as T

16−import Data.Attoparsec.ByteString.Lazy

19+import qualified Data.Attoparsec.ByteString.Lazy as APBL

17−import ProjectM36.Atom

20+import qualified Data.Attoparsec.Text as APT

18import Control.Arrow

21import Control.Arrow

22+import Text.Read hiding (parens)

23+import Control.Applicative

24+import Data.Either

20data CsvImportError = CsvParseError String |

26data CsvImportError = CsvParseError String |

21 AttributeMappingError RelationalError |

27 AttributeMappingError RelationalError |

@@ -25,25 +31,22 @@ data CsvImportError = CsvParseError String |

25csvDecodeOptions :: DecodeOptions

31csvDecodeOptions :: DecodeOptions

26csvDecodeOptions = DecodeOptions {decDelimiter = fromIntegral (ord ',')}

32csvDecodeOptions = DecodeOptions {decDelimiter = fromIntegral (ord ',')}

28−--special case from Text- outer quotes are *not* required in CSV, so we have to add them to make it parseable

29−makeAtomFromCSVText :: AttributeName -> AtomType -> T.Text -> Either RelationalError Atom

30−makeAtomFromCSVText attrName aType textIn = makeAtomFromText attrName aType $ if aType == TextAtomType then

31− "\"" `T.append` textIn `T.append` "\""

32− else

33− textIn

34−

35−csvAsRelation :: BS.ByteString -> Attributes -> Either CsvImportError Relation

34+csvAsRelation :: Attributes -> TypeConstructorMapping -> BS.ByteString -> Either CsvImportError Relation

36−csvAsRelation inString attrs = case parse (csvWithHeader csvDecodeOptions) inString of

35+csvAsRelation attrs tConsMap inString = case APBL.parse (csvWithHeader csvDecodeOptions) inString of

37− Fail _ _ err -> Left (CsvParseError err)

36+ APBL.Fail _ _ err -> Left (CsvParseError err)

38− Done _ (headerRaw,vecMapsRaw) -> do

37+ APBL.Done _ (headerRaw,vecMapsRaw) -> do

39 let strHeader = V.map decodeUtf8 headerRaw

38 let strHeader = V.map decodeUtf8 headerRaw

40 strMapRecords = V.map convertMap vecMapsRaw

39 strMapRecords = V.map convertMap vecMapsRaw

41 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)

42− attrNames = V.map A.attributeName attrs

41+ attrNameSet = A.attributeNameSet attrs

43− attrNameSet = S.fromList (V.toList attrNames)

44 headerSet = S.fromList (V.toList strHeader)

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

45+ Right eAtom -> eAtom

45 makeTupleList :: HM.HashMap AttributeName String -> [Either CsvImportError Atom]

46 makeTupleList :: HM.HashMap AttributeName String -> [Either CsvImportError Atom]

47+ makeTupleList tupMap = V.toList $ V.map (\attr ->

48+ either (Left . AttributeMappingError) Right $

46− makeTupleList tupMap = V.toList $ V.map (\attr -> either (Left . AttributeMappingError) Right $ makeAtomFromCSVText (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)

47 if attrNameSet == headerSet then do

50 if attrNameSet == headerSet then do

48 tupleList <- mapM sequence $ V.toList (V.map makeTupleList strMapRecords)

51 tupleList <- mapM sequence $ V.toList (V.map makeTupleList strMapRecords)

49 case mkRelationFromList attrs tupleList of

52 case mkRelationFromList attrs tupleList of

@@ -52,3 +55,111 @@ csvAsRelation inString attrs = case parse (csvWithHeader csvDecodeOptions) inStr

52 else

55 else

53 Left $ HeaderAttributeMismatchError (S.difference attrNameSet headerSet)

56 Left $ HeaderAttributeMismatchError (S.difference attrNameSet headerSet)

58+

59+parseCSVAtomP :: AttributeName -> TypeConstructorMapping -> AtomType -> APT.Parser (Either RelationalError Atom)

60+parseCSVAtomP _ _ IntegerAtomType = Right . IntegerAtom <$> APT.decimal

61+parseCSVAtomP _ _ IntAtomType = Right . IntAtom <$> APT.decimal

62+parseCSVAtomP _ _ DoubleAtomType = Right . DoubleAtom <$> APT.double

63+parseCSVAtomP _ _ TextAtomType =

64+ Right . TextAtom <$> (quotedString <|> takeToEndOfData)

65+parseCSVAtomP _ _ DayAtomType = do

66+ dString <- T.unpack <$> takeToEndOfData

67+ case readMaybe dString of

68+ Nothing -> fail ("invalid Day string: " ++ dString)

69+ Just date -> pure (Right (DayAtom date))

70+parseCSVAtomP _ _ DateTimeAtomType = do

71+ dString <- T.unpack <$> takeToEndOfData

72+ case readMaybe dString of

73+ Nothing -> fail ("invalid Date string: " ++ dString)

74+ Just date -> pure (Right (DateTimeAtom date))

75+parseCSVAtomP _ _ ByteStringAtomType = do

76+ bsString <- T.unpack <$> takeToEndOfData

77+ case readMaybe bsString of

78+ Nothing -> fail ("invalid ByteString string: " ++ bsString)

79+ Just bs -> pure (Right (ByteStringAtom bs))

80+parseCSVAtomP _ _ BoolAtomType = do

81+ bString <- T.unpack <$> takeToEndOfData

82+ case readMaybe bString of

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

84+ Just b -> pure (Right (BoolAtom b))

85+parseCSVAtomP _ _ RelationalExprAtomType = do

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

87+ case readMaybe reString of

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

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

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

108+ dConsName <- capitalizedIdentifier

109+ APT.skipSpace

110+ --we need to look up the name right away in order to determine the types of the following arguments

111+ -- grab the data constructor

112+ case findDataConstructor dConsName tConsMap of

113+ Nothing -> pure (Left (NoSuchDataConstructorError dConsName))

114+ Just (_, dConsDef) ->

115+ -- identify the data constructor's expected atom type args

116+ case resolvedAtomTypesForDataConstructorDefArgs tConsMap tvmap dConsDef of

117+ Left err -> pure (Left err)

118+ Right argAtomTypes -> do

119+ atomArgs <- mapM (\argTyp -> let parseNextAtom = parseCSVAtomP attrName tConsMap argTyp <* APT.skipSpace in

120+ case argTyp of

121+ ConstructedAtomType _ _ ->

122+ parens parseNextAtom <|>

123+ parseNextAtom

124+ _ -> parseNextAtom

125+ ) argAtomTypes

126+ case lefts atomArgs of

127+ [] -> pure (Right (ConstructedAtom dConsName typ (rights atomArgs)))

128+ errs -> pure (Left (someErrors errs))

129+parseCSVAtomP attrName _ (RelationAtomType _) = pure (Left (RelationValuedAttributesNotSupportedError [attrName]))

130+parseCSVAtomP _ _ (TypeVariableType x) = pure (Left (TypeConstructorTypeVarMissing x))

131+

132+capitalizedIdentifier :: APT.Parser T.Text

133+capitalizedIdentifier = do

134+ fletter <- APT.satisfy isUpper APT.<?> "capitalized data constructor letter"

135+ rest <- APT.takeWhile (\c -> not (isSpace c || c == ')')) APT.<?> "data constructor name"

136+ pure (fletter `T.cons` rest)

137+

138+--read data for Text.Read parser but be wary of end of interval blocks

139+takeToEndOfData :: APT.Parser T.Text

140+takeToEndOfData = APT.takeWhile (APT.notInClass ",)]")

141+

142+parens :: APT.Parser a -> APT.Parser a

143+parens p = do

144+ APT.skip (== '(')

145+ APT.skipSpace

146+ v <- p

147+ APT.skipSpace

148+ APT.skip (== ')')

149+ pure v

150+

151+quotedString :: APT.Parser T.Text

152+quotedString = do

153+ let escapeMap = [('"','"'), ('n', '\n'), ('r', '\r')]

154+ APT.skip (== '"')

155+ (_, s) <- APT.runScanner [] (\prevl nextChar -> case prevl of

156+ [] -> Just [nextChar]

157+ chars | last chars == '\\' ->

158+ case lookup nextChar escapeMap of

159+ Nothing -> Just (chars ++ [nextChar]) --there is no escape sequence, so leave backslash + char

160+ Just escapeVal -> Just (init chars ++ [escapeVal]) -- nuke the backslash and add the escapeVal

161+ | nextChar == '"' -> Nothing

162+ | otherwise -> Just (chars ++ [nextChar]))

163+ APT.skip (== '"')

164+ pure (T.pack s)

165+

src/lib/ProjectM36/Relation/Show/CSV.hs+6−8

@@ -1,14 +1,13 @@

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

8import qualified Data.Vector as V

9import ProjectM36.Error

10import qualified Data.Text.Encoding as TE

11−import qualified Data.Text as T

12import ProjectM36.Atom

11import ProjectM36.Atom

14--spit out error for relations without attributes (since relTrue and relFalse cannot be distinguished then as CSV) and for relations with relation-valued attributes

13--spit out error for relations without attributes (since relTrue and relFalse cannot be distinguished then as CSV) and for relations with relation-valued attributes

@@ -18,13 +17,13 @@ relationAsCSV (Relation attrs tupleSet)

18 | relValAttrs /= [] =

17 | relValAttrs /= [] =

19 Left $ RelationValuedAttributesNotSupportedError (map attributeName relValAttrs)

18 Left $ RelationValuedAttributesNotSupportedError (map attributeName relValAttrs)

20 --check that there is at least one attribute

19 --check that there is at least one attribute

21− | V.null attrs =

20+ | A.null attrs =

22 Left $ TupleAttributeCountMismatchError 0

21 Left $ TupleAttributeCountMismatchError 0

23 | otherwise =

22 | otherwise =

24 Right $ encodeByName bsAttrNames $ map RecordRelationTuple (asList tupleSet)

23 Right $ encodeByName bsAttrNames $ map RecordRelationTuple (asList tupleSet)

25 where

24 where

26− relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) attrs

25+ relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) (attributesVec attrs)

27− bsAttrNames = V.map (TE.encodeUtf8 . attributeName) attrs

26+ bsAttrNames = V.map (TE.encodeUtf8 . attributeName) (attributesVec attrs)

29{-

28{-

30instance ToRecord RelationTuple where

29instance ToRecord RelationTuple where

@@ -37,13 +36,12 @@ instance ToNamedRecord RecordRelationTuple where

37 toNamedRecord rTuple = namedRecord $ map (\(k,v) -> TE.encodeUtf8 k .= RecordAtom v) (tupleAssocs $ unTuple rTuple)

36 toNamedRecord rTuple = namedRecord $ map (\(k,v) -> TE.encodeUtf8 k .= RecordAtom v) (tupleAssocs $ unTuple rTuple)

39instance DefaultOrdered RecordRelationTuple where

38instance DefaultOrdered RecordRelationTuple where

40− headerOrder (RecordRelationTuple tuple) = V.map (TE.encodeUtf8 . attributeName) (tupleAttributes tuple)

39+ headerOrder (RecordRelationTuple tuple) = V.map (TE.encodeUtf8 . attributeName) (attributesVec (tupleAttributes tuple))

42newtype RecordAtom = RecordAtom {unAtom :: Atom}

41newtype RecordAtom = RecordAtom {unAtom :: Atom}

44instance ToField RecordAtom where

43instance ToField RecordAtom where

45− toField (RecordAtom (ConstructedAtom dConsName _ atomList)) = TE.encodeUtf8 $ dConsName `T.append` T.intercalate " " (map atomToText atomList)

44+ toField (RecordAtom (TextAtom atomVal)) = TE.encodeUtf8 atomVal --without this, CSV text atoms are doubly quoted

46− toField (RecordAtom (TextAtom atomVal)) = TE.encodeUtf8 atomVal --squelch extraneous quotes for text type- the CSV library will add them if necessary

47 toField (RecordAtom atomVal) = (TE.encodeUtf8 . atomToText) atomVal

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+1094−575

@@ -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,415 +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 resultExpr) = 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− reportExpr = resultExpr }

378+ reportOldExpr = resultOldExpr,

379+ reportNewExpr = resultNewExpr}

378 putStateContext $ currentContext { notifications = newNotifications }

380 putStateContext $ currentContext { notifications = newNotifications }

379− return Nothing

380

381

381−evalDatabaseContextExpr (RemoveNotification notName) = do

382+evalGraphRefDatabaseContextExpr (RemoveNotification notName) = do

382 currentContext <- getStateContext

383 currentContext <- getStateContext

383 let nots = notifications currentContext

384 let nots = notifications currentContext

384 if M.notMember notName nots then

385 if M.notMember notName nots then

385− return $ Just (NotificationNameNotInUseError notName)

386+ dbErr (NotificationNameNotInUseError notName)

386 else do

387 else do

387 let newNotifications = M.delete notName nots

388 let newNotifications = M.delete notName nots

388 putStateContext $ currentContext { notifications = newNotifications }

389 putStateContext $ currentContext { notifications = newNotifications }

389− return Nothing

390+

390

391

391-- | Adds type and data constructors to the database context.

392-- | Adds type and data constructors to the database context.

392-- validate that the type *and* constructor names are unique! not yet implemented!

393-- validate that the type *and* constructor names are unique! not yet implemented!

393−evalDatabaseContextExpr (AddTypeConstructor tConsDef dConsDefList) = do

394+evalGraphRefDatabaseContextExpr (AddTypeConstructor tConsDef dConsDefList) = do

394 currentContext <- getStateContext

395 currentContext <- getStateContext

395 let oldTypes = typeConstructorMapping currentContext

396 let oldTypes = typeConstructorMapping currentContext

396 tConsName = TCD.name tConsDef

397 tConsName = TCD.name tConsDef

397 -- validate that the constructor's types exist

398 -- validate that the constructor's types exist

398− case validateTypeConstructorDef tConsDef dConsDefList of

399+ case validateTypeConstructorDef tConsDef dConsDefList oldTypes of

399− errs@(_:_) -> pure $ Just (someErrors errs)

400+ Left err -> throwError err

400− [] | 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)

401− | isJust (findTypeConstructor tConsName oldTypes) -> pure $ Just (AtomTypeNameInUseError tConsName)

402+ | isJust (findTypeConstructor tConsName oldTypes) -> dbErr (AtomTypeNameInUseError tConsName)

402− | otherwise -> do

403+ | otherwise -> do

403 let newTypes = oldTypes ++ [(tConsDef, dConsDefList)]

404 let newTypes = oldTypes ++ [(tConsDef, dConsDefList)]

404 putStateContext $ currentContext { typeConstructorMapping = newTypes }

405 putStateContext $ currentContext { typeConstructorMapping = newTypes }

405− pure Nothing

406

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.

408−evalDatabaseContextExpr (RemoveTypeConstructor tConsName) = do

408+evalGraphRefDatabaseContextExpr (RemoveTypeConstructor tConsName) = do

409 currentContext <- getStateContext

410 let oldTypes = typeConstructorMapping currentContext

411 if isNothing (findTypeConstructor tConsName oldTypes) then

412− pure $ Just (AtomTypeNameNotInUseError tConsName)

412+ dbErr (AtomTypeNameNotInUseError tConsName)

413 else do

414 let newTypes = filter (\(tCons, _) -> TCD.name tCons /= tConsName) oldTypes

415 putStateContext $ currentContext { typeConstructorMapping = newTypes }

416− pure Nothing

417

416

418−evalDatabaseContextExpr (MultipleExpr exprs) = do

417+evalGraphRefDatabaseContextExpr (MultipleExpr exprs) =

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

420− evald <- forM exprs evalDatabaseContextExpr

419+ mapM_ evalGraphRefDatabaseContextExpr exprs

421− --some lifting magic needed here

420+

422− case catMaybes evald of

423− [] -> pure Nothing

424− err:_ -> pure (Just err)

425−

426−evalDatabaseContextExpr (RemoveAtomFunction funcName) = do

421+evalGraphRefDatabaseContextExpr (RemoveAtomFunction funcName) = do

427 currentContext <- getStateContext

422 currentContext <- getStateContext

428 let atomFuncs = atomFunctions currentContext

423 let atomFuncs = atomFunctions currentContext

429 case atomFunctionForName funcName atomFuncs of

424 case atomFunctionForName funcName atomFuncs of

430− Left err -> pure (Just err)

425+ Left err -> dbErr err

426+ Right realFunc ->

431− Right realFunc -> if isScriptedAtomFunction realFunc then do

427+ if isScriptedAtomFunction realFunc then do

432− let updatedFuncs = HS.delete realFunc atomFuncs

428+ let updatedFuncs = HS.delete realFunc atomFuncs

433− putStateContext (currentContext {atomFunctions = updatedFuncs })

429+ putStateContext (currentContext {atomFunctions = updatedFuncs })

434− pure Nothing

435− else

430+ else

436− pure (Just (PrecompiledFunctionRemoveError funcName))

431+ dbErr (PrecompiledFunctionRemoveError funcName)

437−

438

432

439−evalDatabaseContextExpr (RemoveDatabaseContextFunction funcName) = do

433+evalGraphRefDatabaseContextExpr (RemoveDatabaseContextFunction funcName) = do

440 context <- getStateContext

434 context <- getStateContext

441 let dbcFuncs = dbcFunctions context

435 let dbcFuncs = dbcFunctions context

442 case databaseContextFunctionForName funcName dbcFuncs of

436 case databaseContextFunctionForName funcName dbcFuncs of

443− Left err -> pure (Just err)

437+ Left err -> dbErr err

438+ Right realFunc ->

444− Right realFunc -> if isScriptedDatabaseContextFunction realFunc then do

439+ if isScriptedDatabaseContextFunction realFunc then do

445− let updatedFuncs = HS.delete realFunc dbcFuncs

440+ let updatedFuncs = HS.delete realFunc dbcFuncs

446− putStateContext (context { dbcFunctions = updatedFuncs })

441+ putStateContext (context { dbcFunctions = updatedFuncs })

447− pure Nothing

448− else

442+ else

449− pure (Just (PrecompiledFunctionRemoveError funcName))

443+ dbErr (PrecompiledFunctionRemoveError funcName)

450

444

451−evalDatabaseContextExpr (ExecuteDatabaseContextFunction funcName atomArgExprs) = do

445+evalGraphRefDatabaseContextExpr (ExecuteDatabaseContextFunction funcName atomArgExprs) = do

452 context <- getStateContext

446 context <- getStateContext

447+ graph <- dbcGraph

453 --resolve atom arguments

448 --resolve atom arguments

454− let relExprState = mkRelationalExprState context

449+ let eAtomTypes = mapM (runGraphRefRelationalExprM gfEnv . typeForGraphRefAtomExpr emptyAttributes) atomArgExprs

455− eAtomTypes = map (\atomExpr -> runReader (typeFromAtomExpr emptyAttributes atomExpr) relExprState) atomArgExprs

456 eFunc = databaseContextFunctionForName funcName (dbcFunctions context)

450 eFunc = databaseContextFunctionForName funcName (dbcFunctions context)

451+ gfEnv = freshGraphRefRelationalExprEnv (Just context) graph

457 case eFunc of

452 case eFunc of

458− Left err -> pure (Just err)

453+ Left err -> dbErr err

459 Right func -> do

454 Right func -> do

460 let expectedArgCount = length (dbcFuncType func)

455 let expectedArgCount = length (dbcFuncType func)

461 actualArgCount = length atomArgExprs

456 actualArgCount = length atomArgExprs

462 if expectedArgCount /= actualArgCount then

457 if expectedArgCount /= actualArgCount then

463− pure (Just (FunctionArgumentCountMismatch expectedArgCount actualArgCount))

458+ dbErr (FunctionArgumentCountMismatchError expectedArgCount actualArgCount)

464 else

459 else

465 --check that the atom types are valid

460 --check that the atom types are valid

466− case lefts eAtomTypes of

461+ case eAtomTypes of

467− _:_ -> pure (Just (someErrors (lefts eAtomTypes)))

462+ Left err -> dbErr err

468− [] -> do

463+ Right atomTypes -> do

469− let atomTypes = rights eAtomTypes

464+ let mValidTypes = zipWith (\ expType actType

470− let mValidTypes = map (\(expType, actType) -> case atomTypeVerify expType actType of

465+ -> case atomTypeVerify expType actType of

471− Left err -> Just err

466+ Left err -> Just err

467+ Right _ -> Nothing)

472− Right _ -> Nothing) (zip (dbcFuncType func) atomTypes)

468+ (dbcFuncType func) atomTypes

473− typeErrors = catMaybes mValidTypes

469+ typeErrors = catMaybes mValidTypes

474− eAtomArgs = map (\arg -> runReader (evalAtomExpr emptyTuple arg) relExprState) atomArgExprs

470+ eAtomArgs = map (runGraphRefRelationalExprM gfEnv . evalGraphRefAtomExpr emptyTuple) atomArgExprs

475 if length (lefts eAtomArgs) > 1 then

471 if length (lefts eAtomArgs) > 1 then

476− pure (Just (someErrors (lefts eAtomArgs)))

472+ dbErr (someErrors (lefts eAtomArgs))

477 else if not (null typeErrors) then

473 else if not (null typeErrors) then

478− pure (Just (someErrors typeErrors))

474+ dbErr (someErrors typeErrors)

479 else

475 else

480 case evalDatabaseContextFunction func (rights eAtomArgs) context of

476 case evalDatabaseContextFunction func (rights eAtomArgs) context of

481− Left err -> pure (Just err)

477+ Left err -> dbErr err

482− Right newContext -> putStateContext newContext >> pure Nothing

478+ Right newContext -> putStateContext newContext

483−

479+data DatabaseContextIOEvalEnv = DatabaseContextIOEvalEnv

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

485−evalDatabaseContextIOExpr mScriptSession currentContext (AddAtomFunction funcName funcType script) =

523+evalGraphRefDatabaseContextIOExpr (AddAtomFunction funcName funcType script) = do

486− case mScriptSession of

524+ eScriptSession <- requireScriptSession

487− Nothing -> pure (Left (ScriptError ScriptCompilationDisabledError))

525+ currentContext <- getDBCIOContext

526+ case eScriptSession of

527+ Left err -> pure (Left err)

488− Just scriptSession -> do

528+ Right scriptSession -> do

489− res <- try $ runGhc (Just libdir) $ do

529+ res <- liftIO $ try $ runGhc (Just libdir) $ do

490 setSession (hscEnv scriptSession)

530 setSession (hscEnv scriptSession)

491 let atomFuncs = atomFunctions currentContext

531 let atomFuncs = atomFunctions currentContext

492 case extractAtomFunctionType funcType of

532 case extractAtomFunctionType funcType of

@@ -497,7 +537,7 @@ evalDatabaseContextIOExpr mScriptSession currentContext (AddAtomFunction funcNam

497 pure $ case eCompiledFunc of

537 pure $ case eCompiledFunc of

498 Left err -> Left (ScriptError err)

538 Left err -> Left (ScriptError err)

499 Right compiledFunc -> do

539 Right compiledFunc -> do

500− funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructor funcTypeArg (typeConstructorMapping currentContext)) adjustedAtomTypeCons

540+ funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructorValidate False funcTypeArg (typeConstructorMapping currentContext) M.empty) adjustedAtomTypeCons

501 let updatedFuncs = HS.insert newAtomFunc atomFuncs

541 let updatedFuncs = HS.insert newAtomFunc atomFuncs

502 newContext = currentContext { atomFunctions = updatedFuncs }

542 newContext = currentContext { atomFunctions = updatedFuncs }

503 newAtomFunc = AtomFunction { atomFuncName = funcName,

543 newAtomFunc = AtomFunction { atomFuncName = funcName,

@@ -512,12 +552,13 @@ evalDatabaseContextIOExpr mScriptSession currentContext (AddAtomFunction funcNam

512 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))

552 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))

513 Right eContext -> case eContext of

553 Right eContext -> case eContext of

514 Left err -> pure (Left err)

554 Left err -> pure (Left err)

515− Right context' -> pure (Right context')

555+ Right context' -> putDBCIOContext context'

516−

517−evalDatabaseContextIOExpr mScriptSession currentContext (AddDatabaseContextFunction funcName funcType script) =

556+evalGraphRefDatabaseContextIOExpr (AddDatabaseContextFunction funcName funcType script) = do

518− case mScriptSession of

557+ eScriptSession <- requireScriptSession

519− Nothing -> pure (Left (ScriptError ScriptCompilationDisabledError))

558+ currentContext <- getDBCIOContext

559+ case eScriptSession of

560+ Left err -> pure (Left err)

520− Just scriptSession -> do

561+ Right scriptSession -> do

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

522 let last2Args = reverse (take 2 (reverse funcType))

563 let last2Args = reverse (take 2 (reverse funcType))

523 atomArgs = take (length funcType - 2) funcType

564 atomArgs = take (length funcType - 2) funcType

@@ -527,14 +568,14 @@ evalDatabaseContextIOExpr mScriptSession currentContext (AddDatabaseContextFunct

527 if last2Args /= [ADTypeConstructor "DatabaseContext" [], dbContextTypeCons] then

568 if last2Args /= [ADTypeConstructor "DatabaseContext" [], dbContextTypeCons] then

528 pure (Left (ScriptError (TypeCheckCompilationError expectedType actualType)))

569 pure (Left (ScriptError (TypeCheckCompilationError expectedType actualType)))

529 else do

570 else do

530− res <- try $ runGhc (Just libdir) $ do

571+ res <- liftIO $ try $ runGhc (Just libdir) $ do

531 setSession (hscEnv scriptSession)

572 setSession (hscEnv scriptSession)

532 eCompiledFunc <- compileScript (dbcFunctionBodyType scriptSession) script

573 eCompiledFunc <- compileScript (dbcFunctionBodyType scriptSession) script

533 pure $ case eCompiledFunc of

574 pure $ case eCompiledFunc of

534 Left err -> Left (ScriptError err)

575 Left err -> Left (ScriptError err)

535 Right compiledFunc -> do

576 Right compiledFunc -> do

536 --if we are here, we have validated that the written function type is X -> DatabaseContext -> DatabaseContext, so we need to munge the first elements into an array

577 --if we are here, we have validated that the written function type is X -> DatabaseContext -> DatabaseContext, so we need to munge the first elements into an array

537− funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructor funcTypeArg (typeConstructorMapping currentContext)) atomArgs

578+ funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructor funcTypeArg (typeConstructorMapping currentContext) M.empty) atomArgs

538 let updatedDBCFuncs = HS.insert newDBCFunc (dbcFunctions currentContext)

579 let updatedDBCFuncs = HS.insert newDBCFunc (dbcFunctions currentContext)

539 newContext = currentContext { dbcFunctions = updatedDBCFuncs }

580 newContext = currentContext { dbcFunctions = updatedDBCFuncs }

540 dbcFuncs = dbcFunctions currentContext

581 dbcFuncs = dbcFunctions currentContext

@@ -552,123 +593,170 @@ evalDatabaseContextIOExpr mScriptSession currentContext (AddDatabaseContextFunct

552 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))

593 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))

553 Right eContext -> case eContext of

594 Right eContext -> case eContext of

554 Left err -> pure (Left err)

595 Left err -> pure (Left err)

555− Right context' -> pure (Right context')

596+ Right context' -> putDBCIOContext context'

556−

597+evalGraphRefDatabaseContextIOExpr (LoadAtomFunctions modName funcName modPath) = do

557−

598+ currentContext <- getDBCIOContext

558−updateTupleWithAtomExprs :: M.Map AttributeName AtomExpr -> DatabaseContext -> RelationTuple -> Either RelationalError RelationTuple

599+ eLoadFunc <- liftIO $ loadAtomFunctions (T.unpack modName) (T.unpack funcName) modPath

559−updateTupleWithAtomExprs exprMap context tupIn = do

600+ case eLoadFunc of

560− --resolve all atom exprs

601+ Left LoadSymbolError -> pure (Left LoadFunctionError)

561− atomsAssoc <- mapM (\(attrName, atomExpr) -> do

602+ Right atomFunctionListFunc -> let newContext = currentContext { atomFunctions = mergedFuncs }

562− atom <- runReader (evalAtomExpr tupIn atomExpr) (RelationalExprStateElems context)

603+ mergedFuncs = HS.union (atomFunctions currentContext) (HS.fromList atomFunctionListFunc)

563− pure (attrName, atom)

604+ in putDBCIOContext newContext

564− ) (M.toList exprMap)

605+evalGraphRefDatabaseContextIOExpr (LoadDatabaseContextFunctions modName funcName modPath) = do

565− 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')

566

644

567--run verification on all constraints

645--run verification on all constraints

568−checkConstraints :: DatabaseContext -> Maybe RelationalError

646+checkConstraints :: DatabaseContext -> TransactionId -> TransactionGraph -> Either RelationalError ()

569−checkConstraints context = case failures of

647+checkConstraints context transId graph@(TransactionGraph graphHeads transSet) = do

570− [] -> Nothing

648+ mapM_ (uncurry checkIncDep) (M.toList deps)

571− l:_ -> Just l

572 where

649 where

573− 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+

574 deps = inclusionDependencies context

660 deps = inclusionDependencies context

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

576 checkIncDep depName (InclusionDependency subsetExpr supersetExpr) = do

662 checkIncDep depName (InclusionDependency subsetExpr supersetExpr) = do

577− let checkExpr = Equals supersetExpr (Union subsetExpr supersetExpr)

663+ let process = runProcessExprM UncommittedContextMarker

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

579− Left err -> Just err

676+ Left err -> Left err

580 Right resultRel -> if resultRel == relationTrue then

677 Right resultRel -> if resultRel == relationTrue then

581− Nothing

678+ pure ()

582 else

679 else

583− Just $ InclusionDependencyCheckError depName

680+ Left (InclusionDependencyCheckError depName)

584

681

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

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

587

684

588−typeForRelationalExpr :: RelationalExpr -> RelationalExprState (Either RelationalError Relation)

685+typeForRelationalExpr :: RelationalExpr -> RelationalExprM Relation

589typeForRelationalExpr expr = do

686typeForRelationalExpr expr = do

590− rstate <- ask

591− let context = stateElemsContext rstate

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

593− let context' = contextWithEmptyTupleSets context

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

594− rstate' = setStateElemsContext rstate context'

689+ graph <- reGraph

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

690+ context <- reContext

596−

691+ let gfExpr = runProcessExprM UncommittedContextMarker (processRelationalExpr expr)

597−--returns a database context with all tuples removed

692+ gfEnv = freshGraphRefRelationalExprEnv (Just context) graph

598−--this is useful for type checking and optimization

693+ runGf = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr gfExpr)

599−contextWithEmptyTupleSets :: DatabaseContext -> DatabaseContext

694+ lift $ except runGf

600−contextWithEmptyTupleSets contextIn = contextIn { relationVariables = relVars }

601− where

602− relVars = M.map (\rel -> Relation (attributes rel) emptyTupleSet) (relationVariables contextIn)

603

695

604liftE :: (Monad m) => m (Either a b) -> ExceptT a m b

696liftE :: (Monad m) => m (Either a b) -> ExceptT a m b

605liftE v = do

697liftE v = do

606 y <- lift v

698 y <- lift v

607 case y of

699 case y of

608− Left err -> throwE err

700+ Left err -> throwError err

609 Right val -> pure val

701 Right val -> pure val

610

702

611{- 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 -}

612−predicateRestrictionFilter :: Attributes -> RestrictionPredicateExpr -> RelationalExprState (Either RelationalError RestrictionFilter)

704+predicateRestrictionFilter :: Attributes -> GraphRefRestrictionPredicateExpr -> GraphRefRelationalExprM RestrictionFilter

613−predicateRestrictionFilter attrs (AndPredicate expr1 expr2) =

705+predicateRestrictionFilter attrs (AndPredicate expr1 expr2) = do

614− runExceptT $ do

615− expr1v <- liftE (predicateRestrictionFilter attrs expr1)

706+ expr1v <- predicateRestrictionFilter attrs expr1

616− expr2v <- liftE (predicateRestrictionFilter attrs expr2)

707+ expr2v <- predicateRestrictionFilter attrs expr2

617− pure (\x -> do

708+ pure (\x -> do

618− ev1 <- expr1v x

709+ ev1 <- expr1v x

619− ev2 <- expr2v x

710+ ev2 <- expr2v x

620− pure (ev1 && ev2))

711+ pure (ev1 && ev2))

621

712

622−predicateRestrictionFilter attrs (OrPredicate expr1 expr2) =

713+predicateRestrictionFilter attrs (OrPredicate expr1 expr2) = do

623− runExceptT $ do

624− expr1v <- liftE (predicateRestrictionFilter attrs expr1)

714+ expr1v <- predicateRestrictionFilter attrs expr1

625− expr2v <- liftE (predicateRestrictionFilter attrs expr2)

715+ expr2v <- predicateRestrictionFilter attrs expr2

626 pure (\x -> do

716 pure (\x -> do

627 ev1 <- expr1v x

717 ev1 <- expr1v x

628 ev2 <- expr2v x

718 ev2 <- expr2v x

629 pure (ev1 || ev2))

719 pure (ev1 || ev2))

630

720

631−predicateRestrictionFilter _ TruePredicate = pure (Right (\_ -> pure True))

721+predicateRestrictionFilter _ TruePredicate = pure (\_ -> pure True)

632

722

633−predicateRestrictionFilter attrs (NotPredicate expr) =

723+predicateRestrictionFilter attrs (NotPredicate expr) = do

634− runExceptT $ do

635− exprv <- liftE (predicateRestrictionFilter attrs expr)

724+ exprv <- predicateRestrictionFilter attrs expr

636− pure (\x -> do

725+ pure (fmap not . exprv)

637− ev <- exprv x

638− pure (not ev))

639

726

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

641predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = do

728predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = do

642− rstate <- ask

729+ renv <- askEnv

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

644 Left err -> Left err

735 Left err -> Left err

645 Right rel -> if arity rel /= 0 then

736 Right rel -> if arity rel /= 0 then

646 Left (PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'")

737 Left (PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'")

647 else

738 else

648− pure (rel == relationTrue)))

739+ pure (rel == relationTrue))

649

740

650predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do

741predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do

651− rstate <- ask

742+ env <- askEnv

652− let (attrs', ctxtup') = case rstate of

743+ let attrs' = A.union attrs (envAttributes env)

653− RelationalExprStateElems _ -> (attrs, emptyTuple)

744+ ctxtup' = envTuple env

654− RelationalExprStateAttrsElems _ _ -> (attrs, emptyTuple)

655− RelationalExprStateTupleElems _ ctxtup -> (A.union attrs (tupleAttributes ctxtup), ctxtup)

656− runExceptT $ do

657− atomExprType <- liftE (typeFromAtomExpr attrs' atomExpr)

745+ atomExprType <- typeForGraphRefAtomExpr attrs' atomExpr

658− attr <- either throwE pure $ case A.attributeForName attrName attrs of

746+ attr <- lift $ except $ case A.attributeForName attrName attrs of

659 Right attr -> Right attr

747 Right attr -> Right attr

660 Left (NoSuchAttributeNamesError _) -> case A.attributeForName attrName (tupleAttributes ctxtup') of

748 Left (NoSuchAttributeNamesError _) -> case A.attributeForName attrName (tupleAttributes ctxtup') of

661 Right ctxattr -> Right ctxattr

749 Right ctxattr -> Right ctxattr

662 Left err2@(NoSuchAttributeNamesError _) -> Left err2

750 Left err2@(NoSuchAttributeNamesError _) -> Left err2

663 Left err -> Left err

751 Left err -> Left err

664 Left err -> Left err

752 Left err -> Left err

665− if atomExprType /= A.atomType attr then

753+ if atomExprType /= A.atomType attr then

666− throwE (TupleAttributeTypeMismatchError (A.attributesFromList [attr]))

754+ throwError (TupleAttributeTypeMismatchError (A.attributesFromList [attr]))

667− else

755+ else

668 pure $ \tupleIn -> let evalAndCmp atomIn = case atomEvald of

756 pure $ \tupleIn -> let evalAndCmp atomIn = case atomEvald of

669 Right atomCmp -> atomCmp == atomIn

757 Right atomCmp -> atomCmp == atomIn

670 Left _ -> False

758 Left _ -> False

671− atomEvald = runReader (evalAtomExpr tupleIn atomExpr) rstate

759+ atomEvald = runGraphRefRelationalExprM env (evalGraphRefAtomExpr tupleIn atomExpr)

672 in

760 in

673 pure $ case atomForAttributeName attrName tupleIn of

761 pure $ case atomForAttributeName attrName tupleIn of

674 Left (NoSuchAttributeNamesError _) -> case atomForAttributeName attrName ctxtup' of

762 Left (NoSuchAttributeNamesError _) -> case atomForAttributeName attrName ctxtup' of

@@ -679,195 +767,626 @@ predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr)

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

680predicateRestrictionFilter attrs (AtomExprPredicate atomExpr) = do

768predicateRestrictionFilter attrs (AtomExprPredicate atomExpr) = do

681 --merge attrs into the state attributes

769 --merge attrs into the state attributes

682− rstate <- ask

770+ renv <- askEnv

683− runExceptT $ do

684− aType <- liftE (typeFromAtomExpr attrs atomExpr)

771+ aType <- typeForGraphRefAtomExpr attrs atomExpr

685− if aType /= BoolAtomType then

772+ if aType /= BoolAtomType then

686− throwE (AtomTypeMismatchError aType BoolAtomType)

773+ throwError (AtomTypeMismatchError aType BoolAtomType)

687− else

774+ else

688 pure (\tupleIn ->

775 pure (\tupleIn ->

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

776+ case runGraphRefRelationalExprM renv (evalGraphRefAtomExpr tupleIn atomExpr) of

690− Left _ -> False

777+ Left err -> Left err

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

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

692

779

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

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

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

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

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

782+ Left (AttributeNameInUseError attrName)

696 else

783 else

697 Right rel

784 Right rel

698

785

699−extendTupleExpressionProcessor :: Relation -> ExtendTupleExpr -> RelationalExprState (Either RelationalError (Attributes, RelationTuple -> Either RelationalError RelationTuple))

786+extendGraphRefTupleExpressionProcessor :: Relation -> GraphRefExtendTupleExpr -> GraphRefRelationalExprM (Attributes, RelationTuple -> Either RelationalError RelationTuple)

700−extendTupleExpressionProcessor relIn (AttributeExtendTupleExpr newAttrName atomExpr) = do

787+extendGraphRefTupleExpressionProcessor relIn (AttributeExtendTupleExpr newAttrName atomExpr) =

701− rstate <- ask

788+-- renv <- askEnv

702 -- check that the attribute name is not in use

789 -- check that the attribute name is not in use

703 case tupleExprCheckNewAttrName newAttrName relIn of

790 case tupleExprCheckNewAttrName newAttrName relIn of

704− Left err -> pure (Left err)

791+ Left err -> throwError err

705− Right _ -> runExceptT $ do

792+ Right _ -> do

706− atomExprType <- liftE (typeFromAtomExpr (attributes relIn) atomExpr)

793+ atomExprType <- typeForGraphRefAtomExpr (attributes relIn) atomExpr

707− atomExprType' <- liftE (verifyAtomExprTypes relIn atomExpr atomExprType)

794+ atomExprType' <- verifyGraphRefAtomExprTypes relIn atomExpr atomExprType

708 let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType']

795 let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType']

709 newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

796 newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

710− pure (newAndOldAttrs, \tup -> let substate = mergeTuplesIntoRelationalExprState tup rstate in case runReader (evalAtomExpr tup atomExpr) substate of

797+ env <- ask

711− Left err -> Left err

798+ pure (newAndOldAttrs, \tup -> do

799+ let gfEnv = mergeTuplesIntoGraphRefRelationalExprEnv tup env

800+ atom <- runGraphRefRelationalExprM gfEnv (evalGraphRefAtomExpr tup atomExpr)

712− Right atom -> Right (tupleAtomExtend newAttrName atom tup)

801+ Right (tupleAtomExtend newAttrName atom tup)

713 )

802 )

714

803

715−evalAtomExpr :: RelationTuple -> AtomExpr -> RelationalExprState (Either RelationalError Atom)

804+evalGraphRefAtomExpr :: RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom

805+evalGraphRefAtomExpr tupIn (AttributeAtomExpr attrName) =

716−evalAtomExpr tupIn (AttributeAtomExpr attrName) = case atomForAttributeName attrName tupIn of

806+ case atomForAttributeName attrName tupIn of

717− Right atom -> pure (Right atom)

807+ Right atom -> pure atom

718− err@(Left (NoSuchAttributeNamesError _)) -> do

808+ Left err@(NoSuchAttributeNamesError _) -> do

719− rstate <- ask

809+ env <- askEnv

720− case rstate of

810+ case gre_extra env of

721− RelationalExprStateElems _ -> pure err

811+ Nothing -> throwError err

722− RelationalExprStateAttrsElems _ _ -> pure err

723− RelationalExprStateTupleElems _ ctxtup -> pure (atomForAttributeName attrName ctxtup)

812+ Just (Left ctxtup) -> lift $ except $ atomForAttributeName attrName ctxtup

813+ Just (Right _) -> throwError err

724− Left err -> pure (Left err)

814+ Left err -> throwError err

725−evalAtomExpr _ (NakedAtomExpr atom) = pure (Right atom)

815+evalGraphRefAtomExpr _ (NakedAtomExpr atom) = pure atom

726−evalAtomExpr tupIn (FunctionAtomExpr funcName arguments ()) = do

816+evalGraphRefAtomExpr tupIn (FunctionAtomExpr funcName arguments tid) = do

727− argTypes <- mapM (typeFromAtomExpr (tupleAttributes tupIn)) arguments

817+ argTypes <- mapM (typeForGraphRefAtomExpr (tupleAttributes tupIn)) arguments

728− context <- fmap stateElemsContext ask

818+ context <- gfDatabaseContextForMarker tid

729− runExceptT $ do

730− let functions = atomFunctions context

819+ let functions = atomFunctions context

731− func <- either throwE pure (atomFunctionForName funcName functions)

820+ func <- lift $ except (atomFunctionForName funcName functions)

732− let expectedArgCount = length (atomFuncType func) - 1

821+ let expectedArgCount = length (atomFuncType func) - 1

733− actualArgCount = length argTypes

822+ actualArgCount = length argTypes

734− safeInit [_] = []

735− safeInit [] = [] -- different behavior from normal init

823+ safeInit [] = [] -- different behavior from normal init

736− safeInit (_:xs) = safeInit xs

824+ safeInit xs = init xs

737− if expectedArgCount /= actualArgCount then

825+ if expectedArgCount /= actualArgCount then

738− throwE (FunctionArgumentCountMismatch expectedArgCount actualArgCount)

826+ throwError (FunctionArgumentCountMismatchError expectedArgCount actualArgCount)

739− else do

827+ else do

740− _ <- 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

741− evaldArgs <- mapM (liftE . evalAtomExpr tupIn) arguments

831+ evaldArgs <- mapM (evalGraphRefAtomExpr tupIn) arguments

742 case evalAtomFunction func evaldArgs of

832 case evalAtomFunction func evaldArgs of

743− Left err -> throwE (AtomFunctionUserError err)

833+ Left err -> throwError (AtomFunctionUserError err)

744 Right result -> do

834 Right result -> do

745 --validate that the result matches the expected type

835 --validate that the result matches the expected type

746− _ <- either throwE pure (atomTypeVerify (last (atomFuncType func)) (atomTypeForAtom result))

836+ _ <- lift $ except (atomTypeVerify (last (atomFuncType func)) (atomTypeForAtom result))

747 pure result

837 pure result

748−evalAtomExpr tupIn (RelationAtomExpr relExpr) = do

838+evalGraphRefAtomExpr tupIn (RelationAtomExpr relExpr) = do

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

750− rstate <- ask

840+ env <- ask

751− runExceptT $ do

841+ let gfEnv = mergeTuplesIntoGraphRefRelationalExprEnv tupIn env

752− let newState = mergeTuplesIntoRelationalExprState tupIn rstate

842+ relAtom <- lift $ except $ runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr relExpr)

753− relAtom <- either throwE pure (runReader (evalRelationalExpr relExpr) newState)

754− pure (RelationAtom relAtom)

843+ pure (RelationAtom relAtom)

755−evalAtomExpr tupIn cons@(ConstructedAtomExpr dConsName dConsArgs ()) = runExceptT $ do

844+evalGraphRefAtomExpr tupIn cons@(ConstructedAtomExpr dConsName dConsArgs _) = do --why is the tid unused here? suspicious

756− rstate <- lift ask

845+ let mergeEnv = mergeTuplesIntoGraphRefRelationalExprEnv tupIn

757− let newState = mergeTuplesIntoRelationalExprState tupIn rstate

758− aType <- either throwE pure (runReader (typeFromAtomExpr (tupleAttributes tupIn) cons) newState)

846+ aType <- local mergeEnv (typeForGraphRefAtomExpr (tupleAttributes tupIn) cons)

759− argAtoms <- mapM (\arg -> either throwE pure (runReader (evalAtomExpr tupIn arg) newState)) dConsArgs

847+ argAtoms <- local mergeEnv $

848+ mapM (evalGraphRefAtomExpr tupIn) dConsArgs

760 pure (ConstructedAtom dConsName aType argAtoms)

849 pure (ConstructedAtom dConsName aType argAtoms)

761

850

762−typeFromAtomExpr :: Attributes -> AtomExpr -> RelationalExprState (Either RelationalError AtomType)

851+typeForGraphRefAtomExpr :: Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType

763−typeFromAtomExpr attrs (AttributeAtomExpr attrName) = do

852+typeForGraphRefAtomExpr attrs (AttributeAtomExpr attrName) = do

764− rstate <- ask

853+ renv <- askEnv

765 case A.atomTypeForAttributeName attrName attrs of

854 case A.atomTypeForAttributeName attrName attrs of

766− Right aType -> pure (Right aType)

855+ Right aType -> pure aType

767− Left err@(NoSuchAttributeNamesError _) -> case rstate of

856+ Left err@(NoSuchAttributeNamesError _) ->

857+ let envTup = envTuple renv

858+ envAttrs = envAttributes renv in

768− RelationalExprStateAttrsElems _ attrs' -> case A.attributeForName attrName attrs' of

859+ case A.attributeForName attrName envAttrs of

769− Left err' -> pure (error "SPAMMO2" $ Left err')

770− Right attr -> pure (Right (A.atomType attr))

860+ Right attr -> pure (A.atomType attr)

771− RelationalExprStateElems _ -> pure (error (show attrs) $ Left err)

861+ Left _ -> case atomForAttributeName attrName envTup of

772− RelationalExprStateTupleElems _ tup -> case atomForAttributeName attrName tup of

862+ Right atom -> pure (atomTypeForAtom atom)

773− Left err' -> pure (error "STAMP" $ Left err')

863+ Left _ -> --throwError (traceStack (show ("typeForGRAtomExpr", attrs, envTup)) err)

774− Right atom -> pure (Right (atomTypeForAtom atom))

864+ throwError err

775− Left err -> pure (error "GONK" $ Left err)

865+ Left err -> throwError err

866+

776−typeFromAtomExpr _ (NakedAtomExpr atom) = pure (Right (atomTypeForAtom atom))

867+typeForGraphRefAtomExpr _ (NakedAtomExpr atom) = pure (atomTypeForAtom atom)

777−typeFromAtomExpr attrs (FunctionAtomExpr funcName atomArgs _) = do

868+typeForGraphRefAtomExpr attrs (FunctionAtomExpr funcName atomArgs transId) = do

778− context <- fmap stateElemsContext ask

869+ funcs <- atomFunctions <$> gfDatabaseContextForMarker transId

779− let funcs = atomFunctions context

780 case atomFunctionForName funcName funcs of

870 case atomFunctionForName funcName funcs of

781− Left err -> pure (Left err)

871+ Left err -> throwError err

782 Right func -> do

872 Right func -> do

783 let funcRetType = last (atomFuncType func)

873 let funcRetType = last (atomFuncType func)

784 funcArgTypes = init (atomFuncType func)

874 funcArgTypes = init (atomFuncType func)

785− eArgTypes <- mapM (typeFromAtomExpr attrs) atomArgs

875+ argTypes <- mapM (typeForGraphRefAtomExpr attrs) atomArgs

786− case lefts eArgTypes of

787− errs@(_:_) -> pure (Left (someErrors errs))

788− [] -> do

789− let eTvMap = resolveTypeVariables funcArgTypes argTypes

876+ let eTvMap = resolveTypeVariables funcArgTypes argTypes

790− argTypes = rights eArgTypes

791− case eTvMap of

877+ case eTvMap of

792− Left err -> pure (Left err)

878+ Left err -> throwError err

793− Right tvMap -> pure (resolveFunctionReturnValue funcName tvMap funcRetType)

879+ Right tvMap -> lift $ except $ resolveFunctionReturnValue funcName tvMap funcRetType

794−typeFromAtomExpr attrs (RelationAtomExpr relExpr) = runExceptT $ do

880+typeForGraphRefAtomExpr attrs (RelationAtomExpr relExpr) = do

795− rstate <- lift ask

881+ relType <- R.local (mergeAttributesIntoGraphRefRelationalExprEnv attrs) (typeForGraphRefRelationalExpr relExpr)

796− relType <- either throwE pure (runReader (typeForRelationalExpr relExpr) (mergeAttributesIntoRelationalExprState attrs rstate))

797 pure (RelationAtomType (attributes relType))

882 pure (RelationAtomType (attributes relType))

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

799−typeFromAtomExpr attrs (ConstructedAtomExpr dConsName dConsArgs _) =

884+typeForGraphRefAtomExpr attrs (ConstructedAtomExpr dConsName dConsArgs tid) =

800− runExceptT $ do

885+ do

801− argsTypes <- mapM (liftE . typeFromAtomExpr attrs) dConsArgs

886+ argsTypes <- mapM (typeForGraphRefAtomExpr attrs) dConsArgs

802− context <- fmap stateElemsContext (lift ask)

887+ tConsMap <- typeConstructorMapping <$> gfDatabaseContextForMarker tid

803− aType <- either throwE pure (atomTypeForDataConstructor (typeConstructorMapping context) dConsName argsTypes)

888+ lift $ except $ atomTypeForDataConstructor tConsMap dConsName argsTypes

804− pure aType

805

889

806-- | Validate that the type of the AtomExpr matches the expected type.

890-- | Validate that the type of the AtomExpr matches the expected type.

807−verifyAtomExprTypes :: Relation -> AtomExpr -> AtomType -> RelationalExprState (Either RelationalError AtomType)

891+verifyGraphRefAtomExprTypes :: Relation -> GraphRefAtomExpr -> AtomType -> GraphRefRelationalExprM AtomType

808−verifyAtomExprTypes relIn (AttributeAtomExpr attrName) expectedType = runExceptT $ do

892+verifyGraphRefAtomExprTypes relIn (AttributeAtomExpr attrName) expectedType = do

809− rstate <- lift ask

893+ env <- askEnv

810 case A.atomTypeForAttributeName attrName (attributes relIn) of

894 case A.atomTypeForAttributeName attrName (attributes relIn) of

811− Right aType -> pure aType

895+ Right aType -> lift $ except $ atomTypeVerify expectedType aType

812− (Left err@(NoSuchAttributeNamesError _)) -> case rstate of

896+ (Left err@(NoSuchAttributeNamesError _)) ->

813− RelationalExprStateTupleElems _ _ -> throwE err

897+ let attrs' = envAttributes env in

814− RelationalExprStateElems _ -> throwE err

898+ if attrs' == emptyAttributes then

899+ throwError err

900+ else

815− RelationalExprStateAttrsElems _ attrs -> case A.attributeForName attrName attrs of

901+ case A.attributeForName attrName attrs' of

816− Left err' -> throwE (error "GONK" err')

902+ Left err' -> throwError err'

817− Right attrType -> either throwE pure (atomTypeVerify expectedType (A.atomType attrType))

903+ Right attrType -> lift $ except $ atomTypeVerify expectedType (A.atomType attrType)

818− Left err -> throwE err

904+ Left err -> throwError err

905+

906+verifyGraphRefAtomExprTypes _ (NakedAtomExpr atom) expectedType =

819−verifyAtomExprTypes _ (NakedAtomExpr atom) expectedType = pure (atomTypeVerify expectedType (atomTypeForAtom atom))

907+ lift $ except $ atomTypeVerify expectedType (atomTypeForAtom atom)

820−verifyAtomExprTypes relIn (FunctionAtomExpr funcName funcArgExprs _) expectedType = do

908+verifyGraphRefAtomExprTypes relIn (FunctionAtomExpr funcName funcArgExprs tid) expectedType = do

821− rstate <- ask

909+ context <- gfDatabaseContextForMarker tid

822 let functions = atomFunctions context

910 let functions = atomFunctions context

823− context = stateElemsContext rstate

824− runExceptT $ do

825− func <- either throwE pure (atomFunctionForName funcName functions)

911+ func <- lift $ except $ atomFunctionForName funcName functions

826− let expectedArgTypes = atomFuncType func

912+ let expectedArgTypes = atomFuncType func

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

828− Left (AtomTypeMismatchError expSubType actSubType) -> throwE (AtomFunctionTypeError funcName argCount expSubType actSubType)

915+ handler (AtomTypeMismatchError expSubType actSubType) = throwError (AtomFunctionTypeError funcName argCount expSubType actSubType)

829− Left err -> throwE err

916+ handler err = throwError err

830− Right x -> pure x

917+ verifyGraphRefAtomExprTypes relIn atomExpr expectedType2 `catchError` handler

831− ) $ zip3 funcArgExprs expectedArgTypes [1..]

918+ funcArgTypes <- mapM funcArgVerifier $ zip3 funcArgExprs expectedArgTypes [1..]

832− if length funcArgTypes /= length expectedArgTypes - 1 then

919+ if length funcArgTypes /= length expectedArgTypes - 1 then

833− throwE (AtomTypeCountError funcArgTypes expectedArgTypes)

920+ throwError (AtomTypeCountError funcArgTypes expectedArgTypes)

834 else

921 else

835− either throwE pure (atomTypeVerify expectedType (last expectedArgTypes))

922+ lift $ except $ atomTypeVerify expectedType (last expectedArgTypes)

836−verifyAtomExprTypes relIn (RelationAtomExpr relationExpr) expectedType = runExceptT $ do

923+verifyGraphRefAtomExprTypes relIn (RelationAtomExpr relationExpr) expectedType =

837− rstate <- lift ask

924+ do

838− 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)

839− either throwE pure (atomTypeVerify expectedType (RelationAtomType (attributes relType)))

927+ lift $ except $ atomTypeVerify expectedType (RelationAtomType (attributes relType))

840−verifyAtomExprTypes rel cons@ConstructedAtomExpr{} expectedType = runExceptT $ do

928+verifyGraphRefAtomExprTypes rel cons@ConstructedAtomExpr{} expectedType = do

841− cType <- liftE (typeFromAtomExpr (attributes rel) cons)

929+ cType <- typeForGraphRefAtomExpr (attributes rel) cons

842− either throwE pure (atomTypeVerify expectedType cType)

930+ lift $ except $ atomTypeVerify expectedType cType

843

931

844-- | Look up the type's name and create a new attribute.

932-- | Look up the type's name and create a new attribute.

845−evalAttrExpr :: TypeConstructorMapping -> AttributeExpr -> Either RelationalError Attribute

933+evalGraphRefAttrExpr :: GraphRefAttributeExpr -> GraphRefRelationalExprM Attribute

846−evalAttrExpr aTypes (AttributeAndTypeNameExpr attrName tCons ()) = do

934+evalGraphRefAttrExpr (AttributeAndTypeNameExpr attrName tCons transId) = do

847− aType <- atomTypeForTypeConstructor tCons aTypes

935+ tConsMap <- typeConstructorMapping <$> gfDatabaseContextForMarker transId

848− Right (Attribute attrName aType)

936+ aType <- lift $ except $ atomTypeForTypeConstructorValidate True tCons tConsMap M.empty

849−

937+ lift $ except $ validateAtomType aType tConsMap

850−evalAttrExpr _ (NakedAttributeExpr attr) = Right attr

938+ pure $ Attribute attrName aType

851

939

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

853−evalTupleExpr attrs (TupleExpr tupMap) = do

991+evalGraphRefTupleExpr mAttrs (TupleExpr tupMap) = do

854− context <- fmap stateElemsContext ask

855− runExceptT $ do

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

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

858− attrAtoms <- mapM (\(attrName, aExpr) -> do

995+ resolveOneAtom (attrName, aExpr) =

859− 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?

860− newAtom <- liftE (evalAtomExpr emptyTuple aExpr)

1004+ newAtom <- evalGraphRefAtomExpr emptyTuple aExpr

861− pure (attrName, newAtom, newAtomType)

1005+ pure (attrName, newAtom, resolvedType)

862− ) (M.toList tupMap)

1006+ attrAtoms <- mapM resolveOneAtom (M.toList tupMap)

863− let tupAttrs = A.attributesFromList $ map (\(attrName, _, aType) -> Attribute attrName aType) attrAtoms

1007+ let tupAttrs = A.attributesFromList $ map (\(attrName, _, aType) -> Attribute attrName aType) attrAtoms

864− atoms = V.fromList $ map (\(_, atom, _) -> atom) attrAtoms

1008+ atoms = V.fromList $ map (\(_, atom, _) -> atom) attrAtoms

865− tup = mkRelationTuple tupAttrs atoms

1009+ tup = mkRelationTuple tupAttrs atoms

866− tConss = typeConstructorMapping context

867− finalAttrs = fromMaybe tupAttrs attrs

1010+ finalAttrs = fromMaybe tupAttrs mAttrs

868 --verify that the attributes match

1011 --verify that the attributes match

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

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

871− _ <- either throwE pure (validateTuple tup' tConss)

1017+-- _ <- lift $ except (validateTuple tup' tConss)

872− 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)

873

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

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+200−87

@@ -5,100 +5,213 @@ import ProjectM36.Client

5import ProjectM36.Server.EntryPoints

6import ProjectM36.Server.RemoteCallTypes

7import ProjectM36.Server.Config (ServerConfig(..))

8+import ProjectM36.FSType

9−import Control.Monad.IO.Class (liftIO)

10−import Network.Transport.TCP (createTransport, defaultTCPParameters)

11−import Network.Transport (EndPointAddress(..), newEndPoint, address)

12−import Control.Distributed.Process.Node (initRemoteTable, runProcess, newLocalNode, initRemoteTable)

13−import Control.Distributed.Process.Extras.Time (Delay(..))

14−import Control.Distributed.Process (Process, register, getSelfPid)

15−import Control.Distributed.Process.ManagedProcess (defaultProcess, UnhandledMessagePolicy(..), ProcessDefinition(..), handleCall, serve, InitHandler, InitResult(..))

16−import Control.Concurrent.MVar (putMVar, MVar)

10+import Control.Concurrent.MVar (MVar)

17import System.IO (stderr, hPutStrLn)

11import System.IO (stderr, hPutStrLn)

12+import System.FilePath (takeDirectory)

13+import 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

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

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

20+

21−serverDefinition :: Bool -> Timeout -> ProcessDefinition Connection

21+requestHandlers :: TestMode -> Maybe Timeout -> RequestHandlers ServerState

22−serverDefinition testBool ti = defaultProcess {

22+requestHandlers testFlag ti =

23− apiHandlers = [

23+ [

24+ RequestHandler (\sState (Login dbName) -> do

25+ addClientLogin dbName sState

26+ conn <- getConn sState

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

24− handleCall (\conn (ExecuteHeadName sessionId) -> handleExecuteHeadName ti sessionId conn),

34+ handleExecuteHeadName ti sessionId conn,

35+ RequestHandler (\sState (ExecuteRelationalExpr sessionId expr) -> do

36+ conn <- getConn sState

25− handleCall (\conn (ExecuteRelationalExpr sessionId expr) -> handleExecuteRelationalExpr ti sessionId conn expr),

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

26− handleCall (\conn (ExecuteDatabaseContextExpr sessionId expr) -> handleExecuteDatabaseContextExpr ti sessionId conn expr),

43+ handleExecuteDatabaseContextExpr ti sessionId conn expr),

44+ RequestHandler (\sState (ExecuteDatabaseContextIOExpr sessionId expr) -> do

45+ conn <- getConn sState

27− handleCall (\conn (ExecuteDatabaseContextIOExpr sessionId expr) -> handleExecuteDatabaseContextIOExpr ti sessionId conn expr),

46+ handleExecuteDatabaseContextIOExpr ti sessionId conn expr),

47+ RequestHandler (\sState (ExecuteGraphExpr sessionId expr) -> do

48+ conn <- getConn sState

28− handleCall (\conn (ExecuteGraphExpr sessionId expr) -> handleExecuteGraphExpr ti sessionId conn expr),

49+ handleExecuteGraphExpr ti sessionId conn expr),

50+ RequestHandler (\sState (ExecuteTransGraphRelationalExpr sessionId expr) -> do

51+ conn <- getConn sState

29− handleCall (\conn (ExecuteTransGraphRelationalExpr sessionId expr) -> handleExecuteTransGraphRelationalExpr ti sessionId conn expr),

52+ handleExecuteTransGraphRelationalExpr ti sessionId conn expr),

53+ RequestHandler (\sState (ExecuteTypeForRelationalExpr sessionId expr) -> do

54+ conn <- getConn sState

30− handleCall (\conn (ExecuteTypeForRelationalExpr sessionId expr) -> handleExecuteTypeForRelationalExpr ti sessionId conn expr),

55+ handleExecuteTypeForRelationalExpr ti sessionId conn expr),

56+ RequestHandler (\sState (RetrieveInclusionDependencies sessionId) -> do

57+ conn <- getConn sState

31− handleCall (\conn (RetrieveInclusionDependencies sessionId) -> handleRetrieveInclusionDependencies ti sessionId conn),

58+ handleRetrieveInclusionDependencies ti sessionId conn),

59+ RequestHandler (\sState (RetrievePlanForDatabaseContextExpr sessionId dbExpr) -> do

60+ conn <- getConn sState

32− handleCall (\conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr) -> handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr),

61+ handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr),

62+ RequestHandler (\sState (RetrieveHeadTransactionId sessionId) -> do

63+ conn <- getConn sState

33− handleCall (\conn (RetrieveHeadTransactionId sessionId) -> handleRetrieveHeadTransactionId ti sessionId conn),

64+ handleRetrieveHeadTransactionId ti sessionId conn),

65+ RequestHandler (\sState (RetrieveTransactionGraph sessionId) -> do

66+ conn <- getConn sState

34− handleCall (\conn (RetrieveTransactionGraph sessionId) -> handleRetrieveTransactionGraph ti sessionId conn),

67+ handleRetrieveTransactionGraph ti sessionId conn),

35− handleCall (\conn (Login procId) -> handleLogin ti conn procId),

68+ RequestHandler (\sState (CreateSessionAtHead headn) -> do

69+ conn <- getConn sState

36− handleCall (\conn (CreateSessionAtHead headn) -> handleCreateSessionAtHead ti conn headn),

70+ handleCreateSessionAtHead ti conn headn),

71+ RequestHandler (\sState (CreateSessionAtCommit commitId) -> do

72+ conn <- getConn sState

37− handleCall (\conn (CreateSessionAtCommit commitId) -> handleCreateSessionAtCommit ti conn commitId),

73+ handleCreateSessionAtCommit ti conn commitId),

74+ RequestHandler (\sState (CloseSession sessionId) -> do

75+ conn <- getConn sState

38− handleCall (\conn (CloseSession sessionId) -> handleCloseSession ti sessionId conn),

76+ handleCloseSession sessionId conn),

77+ RequestHandler (\sState (RetrieveAtomTypesAsRelation sessionId) -> do

78+ conn <- getConn sState

39− handleCall (\conn (RetrieveAtomTypesAsRelation sessionId) -> handleRetrieveAtomTypesAsRelation ti sessionId conn),

79+ handleRetrieveAtomTypesAsRelation ti sessionId conn),

80+ RequestHandler (\sState (RetrieveRelationVariableSummary sessionId) -> do

81+ conn <- getConn sState

40− handleCall (\conn (RetrieveRelationVariableSummary sessionId) -> handleRetrieveRelationVariableSummary ti sessionId conn),

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

41− handleCall (\conn (RetrieveCurrentSchemaName sessionId) -> handleRetrieveCurrentSchemaName ti sessionId conn),

90+ handleRetrieveCurrentSchemaName ti sessionId conn),

91+ RequestHandler (\sState (ExecuteSchemaExpr sessionId schemaExpr) -> do

92+ conn <- getConn sState

42− handleCall (\conn (ExecuteSchemaExpr sessionId schemaExpr) -> handleExecuteSchemaExpr ti sessionId conn schemaExpr),

93+ handleExecuteSchemaExpr ti sessionId conn schemaExpr),

94+ RequestHandler (\sState (RetrieveSessionIsDirty sessionId) -> do

95+ conn <- getConn sState

43− handleCall (\conn (RetrieveSessionIsDirty sessionId) -> handleRetrieveSessionIsDirty ti sessionId conn),

96+ handleRetrieveSessionIsDirty ti sessionId conn),

97+ RequestHandler (\sState (ExecuteAutoMergeToHead sessionId strat headName') -> do

98+ conn <- getConn sState

44− handleCall (\conn (ExecuteAutoMergeToHead sessionId strat headName') -> handleExecuteAutoMergeToHead ti sessionId conn strat headName'),

99+ handleExecuteAutoMergeToHead ti sessionId conn strat headName'),

45− handleCall (\conn Logout -> handleLogout ti conn)

100+ RequestHandler (\sState (RetrieveTypeConstructorMapping sessionId) -> do

46− ] ++ testModeHandlers,

101+ conn <- getConn sState

47− unhandledMessagePolicy = Terminate

102+ handleRetrieveTypeConstructorMapping ti sessionId conn),

48− --unhandledMessagePolicy = Log

103+ RequestHandler (\sState (ExecuteValidateMerkleHashes sessionId) -> do

49− }

104+ conn <- getConn sState

50− where

105+ handleValidateMerkleHashes ti sessionId conn)

51− testModeHandlers = if not testBool then

106+ ] ++ if testFlag then testModeHandlers ti else []

52− []

107+

53− else

108+getConn :: ConnectionState ServerState -> IO Connection

54− [handleCall (\conn (TestTimeout sessionId) -> handleTestTimeout ti sessionId conn)]

109+getConn connState = do

55−

110+ let sock = lockless (connectionSocket connState)

56−

111+ sState = connectionServerState connState

57−initServer :: InitHandler (Connection, DatabaseName, Maybe (MVar EndPointAddress), EndPointAddress) Connection

112+ mConn <- connectionForClient sock sState

58−initServer (conn, dbname, mAddressMVar, saddress) = do

59− registerDB dbname

60− case mAddressMVar of

113+ case mConn of

61− Nothing -> pure ()

114+ Nothing -> error "failed to find socket in client map"

62− Just addressMVar -> liftIO $ putMVar addressMVar saddress

63− --traceShowM ("server started on " ++ show saddress)

64− pure $ InitOk conn Infinity

115+ Just conn -> pure conn

116

66−registerDB :: DatabaseName -> Process ()

117+testModeHandlers :: Maybe Timeout -> RequestHandlers ServerState

67−registerDB dbname = do

118+testModeHandlers ti = [RequestHandler (\sState (TestTimeout sessionId) -> do

68− self <- getSelfPid

119+ conn <- getConn sState

69− let dbname' = remoteDBLookupName dbname

120+ handleTestTimeout ti sessionId conn)]

70− register dbname' self

71− --liftIO $ putStrLn $ "registered " ++ (show self) ++ " " ++ dbname'

121

122+

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

74loggingNotificationCallback :: NotificationCallback

124loggingNotificationCallback :: NotificationCallback

75loggingNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received \"" ++ show notName ++ "\": " ++ show evaldNot

125loggingNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received \"" ++ show notName ++ "\": " ++ show evaldNot

126

77−-- | 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.

127+checkFSType :: Bool -> PersistenceStrategy -> IO Bool

78−launchServer :: ServerConfig -> Maybe (MVar EndPointAddress) -> IO Bool

128+checkFSType performCheck strat =

79−launchServer daemonConfig mAddressMVar = do

129+ case strat of

80− econn <- connectProjectM36 (InProcessConnectionInfo (persistenceStrategy daemonConfig) loggingNotificationCallback (ghcPkgPaths daemonConfig))

130+ NoPersistence -> pure True

81− case econn of

131+ MinimalPersistence _ -> pure True

82− Left err -> do

132+ CrashSafePersistence path ->

83− hPutStrLn stderr ("Failed to create database connection: " ++ show err)

133+ if performCheck then do

84− pure False

134+ -- if the path does not (yet) exist, then walk back a step- the db directory may not yet have been created

85− Right conn -> do

135+ fullpathexists <- doesDirectoryExist path

86− let hostname = bindHost daemonConfig

136+ let fscheckpath = if fullpathexists then

87− port = bindPort daemonConfig

137+ path

88− etransport <- createTransport hostname (show port) defaultTCPParameters

138+ else

89− case etransport of

139+ takeDirectory path

90− Left err -> error ("failed to create transport: " ++ show err)

140+ fsTypeSupportsJournaling fscheckpath

91− Right transport -> do

141+ else

92− eEndpoint <- newEndPoint transport

142+ pure True

143+

144+checkFSErrorMsg :: String

145+checkFSErrorMsg = "The filesystem does not support journaling so writes may not be crash-safe. Use --disable-fscheck to disable this fatal error."

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

93− case eEndpoint of

165+ case mVal of

94− Left err -> hPutStrLn stderr ("Failed to create transport: " ++ show err) >> pure False

166+ Nothing -> StmMap.insert dbName (show sock) clientMap

95− Right endpoint -> do

167+ Just _ -> pure () --TODO: throw exception- user already logged in

96− localTCPNode <- newLocalNode transport initRemoteTable

97− --traceShowM ("newLocalNode in Server " ++ show (localNodeId localTCPNode))

98− runProcess localTCPNode $ do

99− let testBool = testMode daemonConfig

100− reqTimeout = perRequestTimeout daemonConfig

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

102− liftIO $ putStrLn "serve returned"

103− pure True

104

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 })

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.

186+launchServer :: ServerConfig -> Maybe (MVar SockAddr) -> IO Bool

187+launchServer daemonConfig mAddr = do

188+ checkFSResult <- checkFSType (checkFS daemonConfig) (persistenceStrategy daemonConfig)

189+ if not checkFSResult then do

190+ hPutStrLn stderr checkFSErrorMsg

191+ pure False

192+ else do

193+ econn <- connectProjectM36 (InProcessConnectionInfo (persistenceStrategy daemonConfig) loggingNotificationCallback (ghcPkgPaths daemonConfig))

194+ case econn of

195+ Left err -> do

196+ hPutStrLn stderr ("Failed to create database connection: " ++ show err)

197+ pure False

198+ Right conn -> do

199+ let hostname = bindHost daemonConfig

200+ port = fromIntegral (bindPort daemonConfig)

201+

202+

203+ --curryer only supports IPv4 for now

204+ let addrHints = defaultHints { addrSocketType = Stream, addrFamily = AF_INET }

205+ hostAddrs <- getAddrInfo (Just addrHints) (Just hostname) Nothing

206+ case hostAddrs of

207+ [] -> hPutStrLn stderr ("Failed to resolve: " <> hostname) >> pure False

208+ (AddrInfo _ _ _ _ (SockAddrInet _ addr32) _):_ -> do

209+ let hostAddr = hostAddressToTuple addr32

210+ mTimeout = fromIntegral <$> case perRequestTimeout daemonConfig of

211+ 0 -> Nothing

212+ v -> Just v

213+

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+9−1

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

1module ProjectM36.Server.Config where

2import ProjectM36.Client

4−data ServerConfig = ServerConfig { persistenceStrategy :: PersistenceStrategy,

4+data ServerConfig = ServerConfig { persistenceStrategy :: PersistenceStrategy,

5+ checkFS :: Bool,

5 databaseName :: DatabaseName,

6 databaseName :: DatabaseName,

6 bindHost :: Hostname,

7 bindHost :: Hostname,

7 bindPort :: Port,

8 bindPort :: Port,

@@ -11,8 +12,15 @@ data ServerConfig = ServerConfig { persistenceStrategy :: PersistenceStrategy,

11 }

12 }

12 deriving (Show)

13 deriving (Show)

15+data WebsocketServerConfig = WebsocketServerConfig { wsServerConfig :: ServerConfig,

16+ tlsCertificatePath :: Maybe String,

17+ tlsKeyPath :: Maybe String

18+ }

19+ deriving (Show)

20+

14defaultServerConfig :: ServerConfig

21defaultServerConfig :: ServerConfig

15defaultServerConfig = ServerConfig { persistenceStrategy = NoPersistence,

22defaultServerConfig = ServerConfig { persistenceStrategy = NoPersistence,

23+ checkFS = True,

16 databaseName = "base",

24 databaseName = "base",

17 bindHost = "127.0.0.1",

25 bindHost = "127.0.0.1",

18 bindPort = 6543,

26 bindPort = 6543,

src/lib/ProjectM36/Server/EntryPoints.hs+127−135

@@ -1,154 +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

4−import ProjectM36.Client

5+import 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

143−handleRetrieveSessionIsDirty :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Bool)

130+

144−handleRetrieveSessionIsDirty ti sessionId conn = do

145− ret <- timeoutOrDie ti (disconnectedTransactionIsDirty sessionId conn)

146− reply ret conn

147−

148−handleExecuteAutoMergeToHead :: Timeout -> SessionId -> Connection -> MergeStrategy -> HeadName -> Reply (Either RelationalError ())

149−handleExecuteAutoMergeToHead ti sessionId conn strat headName' = do

150− ret <- timeoutOrDie ti (autoMergeToHead sessionId conn strat headName')

151− reply ret conn

152

131

132+handleRetrieveSessionIsDirty :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Bool)

133+handleRetrieveSessionIsDirty ti sessionId conn =

134+ timeoutRelErr ti (disconnectedTransactionIsDirty sessionId conn)

153

135

154−

136+handleExecuteAutoMergeToHead :: Maybe Timeout -> SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())

137+handleExecuteAutoMergeToHead ti sessionId conn strat headName' =

138+ timeoutRelErr ti (autoMergeToHead sessionId conn strat headName')

139+

140+handleRetrieveTypeConstructorMapping :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError TypeConstructorMapping)

141+handleRetrieveTypeConstructorMapping ti sessionId conn =

142+ timeoutRelErr ti (C.typeConstructorMapping sessionId conn)

143+

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+64−24

@@ -3,60 +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 <*>

13+ parseCheckFS <*>

11− parseDatabaseName <*>

14+ parseDatabaseName <*>

12− parseHostname (bindHost defaults) <*>

15+ parseHostname (bindHost defaults) <*>

13− parsePort (bindPort defaults) <*>

16+ parsePort (bindPort defaults) <*>

14− many parseGhcPkgPaths <*>

17+ many parseGhcPkgPath <*>

15− parseTimeout (perRequestTimeout defaults) <*>

18+ parseTimeout (perRequestTimeout defaults) <*>

16− pure False

19+ parseTestMode

17−

20+

18parsePersistenceStrategy :: Parser PersistenceStrategy

21parsePersistenceStrategy :: Parser PersistenceStrategy

19parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>

22parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>

20 MinimalPersistence <$> dbdirOpt <|>

23 MinimalPersistence <$> dbdirOpt <|>

21 pure NoPersistence

24 pure NoPersistence

22− where

25+ where

23− dbdirOpt = strOption (short 'd' <>

26+ dbdirOpt = strOption (short 'd' <>

24− long "database-directory" <>

27+ long "database-directory" <>

25 metavar "DIRECTORY" <>

28 metavar "DIRECTORY" <>

26 showDefaultWith show

29 showDefaultWith show

27 )

30 )

28 fsyncOpt = switch (short 'f' <>

31 fsyncOpt = switch (short 'f' <>

29 long "fsync" <>

32 long "fsync" <>

30 help "Fsync all new transactions.")

33 help "Fsync all new transactions.")

31−

34+

35+parseTestMode :: Parser Bool

36+parseTestMode = flag True False (long "test-mode" <> hidden)

37+

38+parseCheckFS :: Parser Bool

39+parseCheckFS = flag True False (long "disable-fscheck" <>

40+ help "Disable filesystem check for journaling.")

41+

32parseDatabaseName :: Parser DatabaseName

42parseDatabaseName :: Parser DatabaseName

33parseDatabaseName = strOption (short 'n' <>

43parseDatabaseName = strOption (short 'n' <>

34 long "database" <>

44 long "database" <>

35 metavar "DATABASE_NAME")

45 metavar "DATABASE_NAME")

36−

46+

37−parseHostname :: Hostname -> Parser Hostname

47+parseHostname :: Hostname -> Parser Hostname

38parseHostname defHostname = strOption (short 'h' <>

48parseHostname defHostname = strOption (short 'h' <>

39 long "hostname" <>

49 long "hostname" <>

40 metavar "HOST_NAME" <>

50 metavar "HOST_NAME" <>

41 value defHostname)

51 value defHostname)

42−

52+

43−parsePort :: Port -> Parser Port

53+parsePort :: Port -> Parser Port

44parsePort defPort = option auto (short 'p' <>

54parsePort defPort = option auto (short 'p' <>

45 long "port" <>

55 long "port" <>

46 metavar "PORT_NUMBER" <>

56 metavar "PORT_NUMBER" <>

47 value defPort)

57 value defPort)

48−

58+

49−parseGhcPkgPaths :: Parser String

59+parseGhcPkgPath :: Parser String

50−parseGhcPkgPaths = strOption (long "ghc-pkg-dir" <>

60+parseGhcPkgPath = strOption (long "ghc-pkg-dir" <>

51 metavar "GHC_PACKAGE_DIRECTORY")

61 metavar "GHC_PACKAGE_DIRECTORY")

52−

62+

53−parseTimeout :: Int -> Parser Int

63+parseTimeout :: Int -> Parser Int

54parseTimeout defTimeout = option auto (long "timeout" <>

64parseTimeout defTimeout = option auto (long "timeout" <>

55 metavar "MICROSECONDS" <>

65 metavar "MICROSECONDS" <>

56 value defTimeout)

66 value defTimeout)

58parseConfig :: IO ServerConfig

68parseConfig :: IO ServerConfig

59parseConfig = parseConfigWithDefaults defaultServerConfig

69parseConfig = parseConfigWithDefaults defaultServerConfig

60−

70+

61parseConfigWithDefaults :: ServerConfig -> IO ServerConfig

71parseConfigWithDefaults :: ServerConfig -> IO ServerConfig

62−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+72−31

@@ -1,62 +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+

99+data RetrieveTypeConstructorMapping = RetrieveTypeConstructorMapping SessionId

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+530−143

@@ -1,191 +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

20−applyStaticRelationalOptimization e@(MakeRelationFromExprs _ _) = return $ Right e

22−applyStaticRelationalOptimization e@(ExistingRelation _) = return $ Right e

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

24−applyStaticRelationalOptimization e@(RelationVariable _ _) = return $ Right e

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+

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+

174+-- apply optimizations which merely remove steps to become no-ops: example: projection of a relation across all of its attributes => original relation

175+

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 resultExpr) = 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)

310+ pure (AddNotification name triggerExpr resultOldExpr resultNewExpr)

154− case eTriggerExprOpt of

311+

155− Left err -> pure $ Left err

156− Right triggerExprOpt -> do

157− let eResultExprOpt = runReader (applyStaticRelationalOptimization resultExpr) (RelationalExprStateElems context)

158− case eResultExprOpt of

159− Left err -> pure $ Left err

160− Right resultExprOpt -> pure (Right (AddNotification name triggerExprOpt resultExprOpt))

161−

162−applyStaticDatabaseOptimization notif@(RemoveNotification _) = pure (Right notif)

312+optimizeGraphRefDatabaseContextExpr notif@(RemoveNotification _) = pure notif

163−

313+

164−applyStaticDatabaseOptimization c@(AddTypeConstructor _ _) = pure (Right c)

314+optimizeGraphRefDatabaseContextExpr c@(AddTypeConstructor _ _) = pure c

165−applyStaticDatabaseOptimization c@(RemoveTypeConstructor _) = pure (Right c)

315+optimizeGraphRefDatabaseContextExpr c@(RemoveTypeConstructor _) = pure c

166−applyStaticDatabaseOptimization c@(RemoveAtomFunction _) = pure (Right c)

316+optimizeGraphRefDatabaseContextExpr c@(RemoveAtomFunction _) = pure c

167−applyStaticDatabaseOptimization c@(RemoveDatabaseContextFunction _) = pure (Right c)

317+optimizeGraphRefDatabaseContextExpr c@(RemoveDatabaseContextFunction _) = pure c

168−applyStaticDatabaseOptimization c@(ExecuteDatabaseContextFunction _ _) = pure (Right c)

318+optimizeGraphRefDatabaseContextExpr c@(ExecuteDatabaseContextFunction _ _) = pure c

169

319

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

171

321

172−--applyStaticDatabaseOptimization (MultipleExpr exprs) = return $ Right $ MultipleExpr exprs

322+--applyStaticDatabaseOptimization (MultipleExpr exprs) = pure $ Right $ MultipleExpr exprs

173--for multiple expressions, we must evaluate

323--for multiple expressions, we must evaluate

174−applyStaticDatabaseOptimization (MultipleExpr exprs) = do

324+optimizeGraphRefDatabaseContextExpr (MultipleExpr exprs) = do

175− context <- getStateContext

176− let optExprs = evalState substateRunner (contextWithEmptyTupleSets context, M.empty, False)

177− let errors = lefts optExprs

178− if not (null errors) then

179− return $ Left (head errors)

180− else

181− return $ Right $ MultipleExpr (rights optExprs)

182− where

183− substateRunner = forM exprs $ \expr -> do

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

185− _ <- evalDatabaseContextExpr expr

326+ context <- askContext

186− applyStaticDatabaseOptimization expr

327+ graph <- askGraph

187− --this error handling could be improved with some lifting presumably

328+ parentId <- askTransId

188− --restore original context

329+

189−

330+ let emptyRvs ctx = ctx { relationVariables = mkEmptyRelVars (relationVariables ctx) }

190−applyStaticPredicateOptimization :: RestrictionPredicateExpr -> RelationalExprState (Either RelationalError RestrictionPredicateExpr)

331+ dbcEnv = mkDatabaseContextEvalEnv parentId graph

191−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))

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+93−64

@@ -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,22 +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.Lazy 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

23+#endif

22getDirectoryNames :: FilePath -> IO [FilePath]

25getDirectoryNames :: FilePath -> IO [FilePath]

23−getDirectoryNames path = do

26+getDirectoryNames path =

24− subpaths <- getDirectoryContents path

25− return $ filter (\n -> n `notElem` ["..", "."]) subpaths

27+ filter (\ n -> n `notElem` ["..", "."]) <$> getDirectoryContents path

28+

27tempTransactionDir :: FilePath -> TransactionId -> FilePath

30tempTransactionDir :: FilePath -> TransactionId -> FilePath

28tempTransactionDir dbdir transId = dbdir </> "." ++ show transId

31tempTransactionDir dbdir transId = dbdir </> "." ++ show transId

@@ -33,14 +36,14 @@ transactionDir dbdir transId = dbdir </> show transId

33transactionInfoPath :: FilePath -> FilePath

36transactionInfoPath :: FilePath -> FilePath

34transactionInfoPath transdir = transdir </> "info"

37transactionInfoPath transdir = transdir </> "info"

36−relvarsDir :: FilePath -> FilePath

39+relvarsPath :: FilePath -> FilePath

37−relvarsDir transdir = transdir </> "relvars"

40+relvarsPath transdir = transdir </> "relvars"

39incDepsDir :: FilePath -> FilePath

42incDepsDir :: FilePath -> FilePath

40incDepsDir transdir = transdir </> "incdeps"

43incDepsDir transdir = transdir </> "incdeps"

42−atomFuncsDir :: FilePath -> FilePath

45+atomFuncsPath :: FilePath -> FilePath

43−atomFuncsDir transdir = transdir </> "atomfuncs"

46+atomFuncsPath transdir = transdir </> "atomfuncs"

45dbcFuncsDir :: FilePath -> FilePath

48dbcFuncsDir :: FilePath -> FilePath

46dbcFuncsDir transdir = transdir </> "dbcfuncs"

49dbcFuncsDir transdir = transdir </> "dbcfuncs"

@@ -59,7 +62,7 @@ readTransaction dbdir transId mScriptSession = do

59 return $ Left $ MissingTransactionError transId

62 return $ Left $ MissingTransactionError transId

60 else do

63 else do

61 relvars <- readRelVars transDir

64 relvars <- readRelVars transDir

62− transInfo <- B.decode <$> BS.readFile (transactionInfoPath transDir)

65+ transInfo <- readFileDeserialise (transactionInfoPath transDir)

63 incDeps <- readIncDeps transDir

66 incDeps <- readIncDeps transDir

64 typeCons <- readTypeConstructorMapping transDir

67 typeCons <- readTypeConstructorMapping transDir

65 sschemas <- readSubschemas transDir

68 sschemas <- readSubschemas transDir

@@ -82,58 +85,75 @@ writeTransaction sync dbdir trans = do

82 transDirExists <- doesDirectoryExist finalTransDir

85 transDirExists <- doesDirectoryExist finalTransDir

83 unless transDirExists $ do

86 unless transDirExists $ do

84 --create sub directories

87 --create sub directories

85− mapM_ createDirectory [tempTransDir, relvarsDir tempTransDir, incDepsDir tempTransDir, atomFuncsDir tempTransDir, dbcFuncsDir tempTransDir]

88+ mapM_ createDirectory [tempTransDir, incDepsDir tempTransDir, dbcFuncsDir tempTransDir]

86 writeRelVars sync tempTransDir (relationVariables context)

89 writeRelVars sync tempTransDir (relationVariables context)

87 writeIncDeps sync tempTransDir (inclusionDependencies context)

90 writeIncDeps sync tempTransDir (inclusionDependencies context)

88 writeAtomFuncs sync tempTransDir (atomFunctions context)

91 writeAtomFuncs sync tempTransDir (atomFunctions context)

89 writeDBCFuncs sync tempTransDir (dbcFunctions context)

92 writeDBCFuncs sync tempTransDir (dbcFunctions context)

90 writeTypeConstructorMapping sync tempTransDir (typeConstructorMapping context)

93 writeTypeConstructorMapping sync tempTransDir (typeConstructorMapping context)

91 writeSubschemas sync tempTransDir (subschemas trans)

94 writeSubschemas sync tempTransDir (subschemas trans)

92− BS.writeFile (transactionInfoPath tempTransDir) (B.encode $ transactionInfo trans)

95+ writeFileSerialise (transactionInfoPath tempTransDir) (transactionInfo trans)

93 --move the temp directory to final location

96 --move the temp directory to final location

94 renameSync sync tempTransDir finalTransDir

97 renameSync sync tempTransDir finalTransDir

95− pure ()

98+

96−

99+writeRelVars :: DiskSync -> FilePath -> RelationVariables -> IO ()

97−writeRelVar :: DiskSync -> FilePath -> (RelVarName, Relation) -> IO ()

100+writeRelVars sync transDir relvars = do

98−writeRelVar sync transDir (relvarName, rel) = do

101+ let path = relvarsPath transDir

99− let relvarPath = relvarsDir transDir </> T.unpack relvarName

100− writeBSFileSync sync relvarPath (B.encode rel)

102+ writeBSFileSync sync path (serialise relvars)

101−

103+

102−writeRelVars :: DiskSync -> FilePath -> M.Map RelVarName Relation -> IO ()

103−writeRelVars sync transDir relvars = mapM_ (writeRelVar sync transDir) $ M.toList relvars

104−

105−readRelVars :: FilePath -> IO (M.Map RelVarName Relation)

104+readRelVars :: FilePath -> IO RelationVariables

106−readRelVars transDir = do

105+readRelVars transDir =

107− let relvarsPath = relvarsDir transDir

106+ readFileDeserialise (relvarsPath transDir)

108− relvarNames <- getDirectoryNames relvarsPath

109− relvars <- mapM (\name -> do

110− rel <- B.decode <$> BS.readFile (relvarsPath </> name)

111− return (T.pack name, rel)) relvarNames

112− return $ M.fromList relvars

113

107

114writeAtomFuncs :: DiskSync -> FilePath -> AtomFunctions -> IO ()

108writeAtomFuncs :: DiskSync -> FilePath -> AtomFunctions -> IO ()

115−writeAtomFuncs sync transDir funcs = mapM_ (writeAtomFunc sync transDir) $ HS.toList funcs

109+writeAtomFuncs sync transDir funcs = do

110+ let atomFuncPath = atomFuncsPath transDir

111+ writeBSFileSync sync atomFuncPath (serialise $ map (\f -> (atomFuncType f, atomFuncName f, atomFunctionScript f)) (HS.toList funcs))

116

112

117−--all the atom functions are in one file (???)

113+--all the atom functions are in one file

118readAtomFuncs :: FilePath -> Maybe ScriptSession -> IO AtomFunctions

114readAtomFuncs :: FilePath -> Maybe ScriptSession -> IO AtomFunctions

119readAtomFuncs transDir mScriptSession = do

115readAtomFuncs transDir mScriptSession = do

120− funcNames <- getDirectoryNames (atomFuncsDir transDir)

116+ atomFuncsList <- readFileDeserialise (atomFuncsPath transDir)

121 --only Haskell script functions can be serialized

117 --only Haskell script functions can be serialized

122 --we always return the pre-compiled functions

118 --we always return the pre-compiled functions

123− funcs <- mapM ((\name -> readAtomFunc transDir name mScriptSession precompiledAtomFunctions) . T.pack) funcNames

119+ funcs <- mapM (\(funcType, funcName, mFuncScript) -> loadAtomFunc precompiledAtomFunctions mScriptSession funcName funcType mFuncScript) atomFuncsList

124 pure (HS.union precompiledAtomFunctions (HS.fromList funcs))

120 pure (HS.union precompiledAtomFunctions (HS.fromList funcs))

125

121

126−--to write the atom functions, we really some bytecode to write (GHCi bytecode?)

122+loadAtomFunc :: AtomFunctions -> Maybe ScriptSession -> AtomFunctionName -> [AtomType] -> Maybe AtomFunctionBodyScript -> IO AtomFunction

127−writeAtomFunc :: DiskSync -> FilePath -> AtomFunction -> IO ()

123+loadAtomFunc precompiledFuncs _mScriptSession funcName _funcType mFuncScript = case mFuncScript of

128−writeAtomFunc sync transDir func = do

124+ --handle pre-compiled case- pull it from the precompiled list

129− let atomFuncPath = atomFuncsDir transDir </> T.unpack (atomFuncName func)

125+ Nothing -> case atomFunctionForName funcName precompiledFuncs of

130− writeBSFileSync sync atomFuncPath (B.encode (atomFuncType func, atomFunctionScript func))

126+ --WARNING: possible landmine here if we remove a precompiled atom function in the future, then the transaction cannot be restored

131−

127+ Left _ -> error ("expected precompiled atom function: " ++ T.unpack funcName)

128+ Right realFunc -> pure realFunc

129+ --handle a real Haskell scripted function- compile and load

130+ Just _funcScript ->

131+#ifdef PM36_HASKELL_SCRIPTING

132+ case _mScriptSession of

133+ Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

134+ Just scriptSession -> do

135+ --risk of GHC exception during compilation here

136+ eCompiledScript <- runGhc (Just libdir) $ do

137+ setSession (hscEnv scriptSession)

138+ compileScript (atomFunctionBodyType scriptSession) _funcScript

139+ case eCompiledScript of

140+ Left err -> throwIO err

141+ Right compiledScript -> pure AtomFunction { atomFuncName = funcName,

142+ atomFuncType = _funcType,

143+ atomFuncBody = AtomFunctionBody (Just _funcScript) compiledScript }

144+#else

145+ error "Haskell scripting is disabled"

146+#endif

147+

132--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!

149+

133readAtomFunc :: 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

134readAtomFunc transDir funcName mScriptSession precompiledFuncs = do

154readAtomFunc transDir funcName mScriptSession precompiledFuncs = do

135− let atomFuncPath = atomFuncsDir transDir </> T.unpack funcName

155+ let atomFuncPath = atomFuncsPath transDir

136− (funcType, mFuncScript) <- B.decode <$> BS.readFile atomFuncPath

156+ (funcType, mFuncScript) <- readFileDeserialise @([AtomType],Maybe T.Text) atomFuncPath

137 case mFuncScript of

157 case mFuncScript of

138 --handle pre-compiled case- pull it from the precompiled list

158 --handle pre-compiled case- pull it from the precompiled list

139 Nothing -> case atomFunctionForName funcName precompiledFuncs of

159 Nothing -> case atomFunctionForName funcName precompiledFuncs of

@@ -141,7 +161,8 @@ readAtomFunc transDir funcName mScriptSession precompiledFuncs = do

141 Left _ -> error ("expected precompiled atom function: " ++ T.unpack funcName)

161 Left _ -> error ("expected precompiled atom function: " ++ T.unpack funcName)

142 Right realFunc -> pure realFunc

162 Right realFunc -> pure realFunc

143 --handle a real Haskell scripted function- compile and load

163 --handle a real Haskell scripted function- compile and load

144− Just funcScript ->

164+ Just funcScript ->

165+

145 case mScriptSession of

166 case mScriptSession of

146 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

167 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

147 Just scriptSession -> do

168 Just scriptSession -> do

@@ -154,6 +175,8 @@ readAtomFunc transDir funcName mScriptSession precompiledFuncs = do

154 Right compiledScript -> pure AtomFunction { atomFuncName = funcName,

175 Right compiledScript -> pure AtomFunction { atomFuncName = funcName,

155 atomFuncType = funcType,

176 atomFuncType = funcType,

156 atomFuncBody = AtomFunctionBody (Just funcScript) compiledScript }

177 atomFuncBody = AtomFunctionBody (Just funcScript) compiledScript }

178+#endif

179+

157

180

158writeDBCFuncs :: DiskSync -> FilePath -> DatabaseContextFunctions -> IO ()

181writeDBCFuncs :: DiskSync -> FilePath -> DatabaseContextFunctions -> IO ()

159writeDBCFuncs sync transDir funcs = mapM_ (writeDBCFunc sync transDir) (HS.toList funcs)

182writeDBCFuncs sync transDir funcs = mapM_ (writeDBCFunc sync transDir) (HS.toList funcs)

@@ -161,40 +184,48 @@ writeDBCFuncs sync transDir funcs = mapM_ (writeDBCFunc sync transDir) (HS.toLis

161writeDBCFunc :: DiskSync -> FilePath -> DatabaseContextFunction -> IO ()

184writeDBCFunc :: DiskSync -> FilePath -> DatabaseContextFunction -> IO ()

162writeDBCFunc sync transDir func = do

185writeDBCFunc sync transDir func = do

163 let dbcFuncPath = dbcFuncsDir transDir </> T.unpack (dbcFuncName func)

186 let dbcFuncPath = dbcFuncsDir transDir </> T.unpack (dbcFuncName func)

164− writeBSFileSync sync dbcFuncPath (B.encode (dbcFuncType func, databaseContextFunctionScript func))

187+ writeBSFileSync sync dbcFuncPath (serialise (dbcFuncType func, databaseContextFunctionScript func))

165

188

166readDBCFuncs :: FilePath -> Maybe ScriptSession -> IO DatabaseContextFunctions

189readDBCFuncs :: FilePath -> Maybe ScriptSession -> IO DatabaseContextFunctions

167readDBCFuncs transDir mScriptSession = do

190readDBCFuncs transDir mScriptSession = do

168 funcNames <- getDirectoryNames (dbcFuncsDir transDir)

191 funcNames <- getDirectoryNames (dbcFuncsDir transDir)

169 --only Haskell script functions can be serialized

192 --only Haskell script functions can be serialized

170 --we always return the pre-compiled functions

193 --we always return the pre-compiled functions

171− funcs <- mapM ((\name -> readDBCFunc transDir name mScriptSession precompiledDatabaseContextFunctions) . T.pack) funcNames

194+ let funcs = mapM ((\name -> readDBCFunc transDir name mScriptSession precompiledDatabaseContextFunctions) . T.pack) funcNames

172− return $ HS.union basicDatabaseContextFunctions (HS.fromList funcs)

195+ HS.union basicDatabaseContextFunctions . HS.fromList <$> funcs

173

196

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

175readDBCFunc transDir funcName mScriptSession precompiledFuncs = do

201readDBCFunc transDir funcName mScriptSession precompiledFuncs = do

202+#endif

176 let dbcFuncPath = dbcFuncsDir transDir </> T.unpack funcName

203 let dbcFuncPath = dbcFuncsDir transDir </> T.unpack funcName

177− (funcType, mFuncScript) <- B.decode <$> BS.readFile dbcFuncPath

204+ (_funcType, mFuncScript) <- readFileDeserialise @([AtomType], Maybe T.Text) dbcFuncPath

178 case mFuncScript of

205 case mFuncScript of

179 Nothing -> case databaseContextFunctionForName funcName precompiledFuncs of

206 Nothing -> case databaseContextFunctionForName funcName precompiledFuncs of

180 Left _ -> error ("expected precompiled dbc function: " ++ T.unpack funcName)

207 Left _ -> error ("expected precompiled dbc function: " ++ T.unpack funcName)

181 Right realFunc -> pure realFunc --return precompiled function

208 Right realFunc -> pure realFunc --return precompiled function

182− Just funcScript ->

209+ Just _funcScript ->

210+#ifdef PM36_HASKELL_SCRIPTING

183 case mScriptSession of

211 case mScriptSession of

184 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

212 Nothing -> error "attempted to read serialized AtomFunction without scripting enabled"

185 Just scriptSession -> do

213 Just scriptSession -> do

186 eCompiledScript <- runGhc (Just libdir) $ do

214 eCompiledScript <- runGhc (Just libdir) $ do

187 setSession (hscEnv scriptSession)

215 setSession (hscEnv scriptSession)

188− compileScript (dbcFunctionBodyType scriptSession) funcScript

216+ compileScript (dbcFunctionBodyType scriptSession) _funcScript

189 case eCompiledScript of

217 case eCompiledScript of

190 Left err -> throwIO err

218 Left err -> throwIO err

191 Right compiledScript -> pure DatabaseContextFunction { dbcFuncName = funcName,

219 Right compiledScript -> pure DatabaseContextFunction { dbcFuncName = funcName,

192− dbcFuncType = funcType,

220+ dbcFuncType = _funcType,

193− dbcFuncBody = DatabaseContextFunctionBody (Just funcScript) compiledScript}

221+ dbcFuncBody = DatabaseContextFunctionBody (Just _funcScript) compiledScript}

222+#else

223+ error "Haskell scripting is disabled"

224+#endif

194

225

195writeIncDep :: DiskSync -> FilePath -> (IncDepName, InclusionDependency) -> IO ()

226writeIncDep :: DiskSync -> FilePath -> (IncDepName, InclusionDependency) -> IO ()

196writeIncDep sync transDir (incDepName, incDep) =

227writeIncDep sync transDir (incDepName, incDep) =

197− writeBSFileSync sync (incDepsDir transDir </> T.unpack incDepName) $ B.encode incDep

228+ writeBSFileSync sync (incDepsDir transDir </> T.unpack incDepName) $ serialise incDep

198

229

199writeIncDeps :: DiskSync -> FilePath -> M.Map IncDepName InclusionDependency -> IO ()

230writeIncDeps :: DiskSync -> FilePath -> M.Map IncDepName InclusionDependency -> IO ()

200writeIncDeps sync transDir incdeps = mapM_ (writeIncDep sync transDir) $ M.toList incdeps

231writeIncDeps sync transDir incdeps = mapM_ (writeIncDep sync transDir) $ M.toList incdeps

@@ -202,34 +233,32 @@ writeIncDeps sync transDir incdeps = mapM_ (writeIncDep sync transDir) $ M.toLis

202readIncDep :: FilePath -> IncDepName -> IO (IncDepName, InclusionDependency)

233readIncDep :: FilePath -> IncDepName -> IO (IncDepName, InclusionDependency)

203readIncDep transDir incdepName = do

234readIncDep transDir incdepName = do

204 let incDepPath = incDepsDir transDir </> T.unpack incdepName

235 let incDepPath = incDepsDir transDir </> T.unpack incdepName

205− incDepData <- BS.readFile incDepPath

236+ incDepData <- readFileDeserialise incDepPath

206− pure (incdepName, B.decode incDepData)

237+ pure (incdepName, incDepData)

207

238

208readIncDeps :: FilePath -> IO (M.Map IncDepName InclusionDependency)

239readIncDeps :: FilePath -> IO (M.Map IncDepName InclusionDependency)

209readIncDeps transDir = do

240readIncDeps transDir = do

210 let incDepsPath = incDepsDir transDir

241 let incDepsPath = incDepsDir transDir

211 incDepNames <- getDirectoryNames incDepsPath

242 incDepNames <- getDirectoryNames incDepsPath

212− incDeps <- mapM (readIncDep transDir . T.pack) incDepNames

243+ M.fromList <$> mapM (readIncDep transDir . T.pack) incDepNames

213− return $ M.fromList incDeps

214

244

215readSubschemas :: FilePath -> IO Subschemas

245readSubschemas :: FilePath -> IO Subschemas

216readSubschemas transDir = do

246readSubschemas transDir = do

217 let sschemasPath = subschemasPath transDir

247 let sschemasPath = subschemasPath transDir

218− bytes <- BS.readFile sschemasPath

248+ readFileDeserialise sschemasPath

219− pure (B.decode bytes)

220

249

221writeSubschemas :: DiskSync -> FilePath -> Subschemas -> IO ()

250writeSubschemas :: DiskSync -> FilePath -> Subschemas -> IO ()

222writeSubschemas sync transDir sschemas = do

251writeSubschemas sync transDir sschemas = do

223 let sschemasPath = subschemasPath transDir

252 let sschemasPath = subschemasPath transDir

224− writeBSFileSync sync sschemasPath (B.encode sschemas)

253+ writeBSFileSync sync sschemasPath (serialise sschemas)

225

254

226writeTypeConstructorMapping :: DiskSync -> FilePath -> TypeConstructorMapping -> IO ()

255writeTypeConstructorMapping :: DiskSync -> FilePath -> TypeConstructorMapping -> IO ()

227writeTypeConstructorMapping sync path types = let atPath = typeConsPath path in

256writeTypeConstructorMapping sync path types = let atPath = typeConsPath path in

228− writeBSFileSync sync atPath $ B.encode types

257+ writeBSFileSync sync atPath $ serialise types

229

258

230readTypeConstructorMapping :: FilePath -> IO TypeConstructorMapping

259readTypeConstructorMapping :: FilePath -> IO TypeConstructorMapping

231readTypeConstructorMapping path = do

260readTypeConstructorMapping path = do

232 let atPath = typeConsPath path

261 let atPath = typeConsPath path

233− B.decode <$> BS.readFile atPath

262+ readFileDeserialise atPath

263+

234

264

235−

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