git.iko.soy/project-m36
on 205293a help sign in
44feeff
swap
0 ahead, 740 behind
.appveyor.ymldeleted−39
since splitsnapshots
unifiedsplit
@@ -1,39 +0,0 @@
1−build: off
2−
3−version: 1.0.{build}-{branch}
4−
5−image: Visual Studio 2017
6−
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.yamldeleted−69
@@ -1,69 +0,0 @@
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+1−7
@@ -14,10 +14,4 @@ nextsteps
14\#*\#
14\#*\#
15view-system-notes
15view-system-notes
16persistence-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.ymlnew file+58
@@ -0,0 +1,58 @@
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 PROJECTM36_VERSION=HLINT
57+
58+# EOF
Changelog.markdown−92
@@ -1,95 +1,3 @@
1−# 2021-04-01 (v0.9.3)
2−
3−* add new ":importtutd <URI> <SHA256 hash>" feature to import TutorialD from a local file or a HTTP/HTTPS URI
4−
5−# 2020-12-27 (v0.9.0)
6−
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
9−
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−
82−# 2017-09-16 (v0.2)
83−
84−* a new [simple client API](https://github.com/agentm/project-m36/blob/master/docs/simple_api.markdown) with a monadic transaction manager
85−* complete hlint compliance
86−* the generics-based [Tupleable typeclass]( https://github.com/agentm/project-m36/blob/master/docs/tupleable.markdown
87−) which makes it easy to marshal Haskell data types to-and-from the database
88−* timestamps attached to transactions to allow specific point-in-time travel
89−* autoMergeToHead, a variant of commit which attempts to merge and commit to the latest head transaction to reduce incidents of TransactionNotAHeadErrors
90−* interval data types
91−* transaction dirtiness detection which allows the client to determine if an update expression actually changed the database state
92−
93# 2017-08-01
1# 2017-08-01
94
2
95## autoMergeToHead
3## autoMergeToHead
README.markdown+9−27
@@ -4,9 +4,7 @@
4[![Public Domain](https://img.shields.io/badge/license-Public%20Domain-brightgreen.svg)](http://unlicense.org)
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)
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)
6[![Hackage dependency status](https://img.shields.io/hackage-deps/v/project-m36.svg)](http://packdeps.haskellers.com/feed?needle=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)
7+[![Build status](https://travis-ci.org/agentm/project-m36.svg?branch=master)](https://travis-ci.org/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−
10
8
11*Software can always be made faster, but rarely can it be made more correct.*
9*Software can always be made faster, but rarely can it be made more correct.*
12
10
@@ -14,12 +12,6 @@
14
12
15Project:M36 implements a relational algebra engine as inspired by the writings of Chris Date.
13Project:M36 implements a relational algebra engine as inspired by the writings of Chris Date.
16
14
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−
23## Description
15## Description
24
16
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.
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.
@@ -32,6 +24,10 @@ Project:M36 is written entirely in the [Haskell programming language](https://ww
32
24
33[![asciicast](https://asciinema.org/a/3syu35c8cydm403292a74l1n5.png)](https://asciinema.org/a/3syu35c8cydm403292a74l1n5)
25[![asciicast](https://asciinema.org/a/3syu35c8cydm403292a74l1n5.png)](https://asciinema.org/a/3syu35c8cydm403292a74l1n5)
34
26
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+
35## Use-Cases
31## Use-Cases
36
32
37Project:M36 supports multiple frontends which target different audiences.
33Project:M36 supports multiple frontends which target different audiences.
@@ -44,9 +40,8 @@ Project:M36 supports multiple frontends which target different audiences.
44
40
45* [Developer's Blog](https://agentm.github.io/project-m36/)
41* [Developer's Blog](https://agentm.github.io/project-m36/)
46* [Mailing List/Discussion Group](https://groups.google.com/d/forum/project-m36)
42* [Mailing List/Discussion Group](https://groups.google.com/d/forum/project-m36)
47−* IRC Channel: irc.libera.chat #project-m36 -- [Chat via Web Client](http://kiwiirc.com/nextclient/irc.libera.chat:+6697/#project-m36)
43+* IRC Channel: chat.freenode.net #project-m36
48* [Hackage](https://hackage.haskell.org/package/project-m36)
44* [Hackage](https://hackage.haskell.org/package/project-m36)
49−* [Diogo Biazus' Project:M36 Video Tutorial](https://www.youtube.com/watch?v=_GC_lxlVEnE)
50
45
51## Documentation
46## Documentation
52
47
@@ -54,47 +49,34 @@ Project:M36 supports multiple frontends which target different audiences.
54
49
551. [Installation and Introduction to Project:M36](docs/introduction_to_projectm36.markdown)
501. [Installation and Introduction to Project:M36](docs/introduction_to_projectm36.markdown)
561. [Introduction to the Relational Algebra](docs/introduction_to_the_relational_algebra.markdown)
511. [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)
591. [TutorialD Tutorial](docs/tutd_tutorial.markdown)
521. [TutorialD Tutorial](docs/tutd_tutorial.markdown)
601. [15 Minute Tutorial](docs/15_minute_tutorial.markdown)
531. [15 Minute Tutorial](docs/15_minute_tutorial.markdown)
611. [Developer's Change Log](Changelog.markdown)
541. [Developer's Change Log](Changelog.markdown)
62−1. [Simple Client API](docs/simple_api.markdown)
63−1. [CSV Import/Export](docs/import_export_csv.markdown)
64
55
65### Database Comparisons
56### Database Comparisons
66
57
671. [ACID Database Properties](docs/acid_assessment.markdown)
581. [ACID Database Properties](docs/acid_assessment.markdown)
681. [On NULL (in SQL)](docs/on_null.markdown)
591. [On NULL (in SQL)](docs/on_null.markdown)
691. [Reaching "Out of the Tarpit" with Project:M36](docs/reaching_out_of_the_tarpit.markdown)
601. [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)
71
61
72### Advanced Features
62### Advanced Features
73
63
741. [Transaction Graph Operators](docs/transaction_graph_operators.markdown)
641. [Transaction Graph Operators](docs/transaction_graph_operators.markdown)
751. [ProjectM36.Client Library](docs/projectm36_client_library.markdown)
651. [ProjectM36.Client Library](docs/projectm36_client_library.markdown)
76−1. [Data Frames for Sorting](docs/dataframes.markdown)
771. [Adding New Data Types](docs/new_datatypes.markdown)
661. [Adding New Data Types](docs/new_datatypes.markdown)
781. [Database-Manipulating Functions](docs/database_context_functions.markdown)
671. [Database-Manipulating Functions](docs/database_context_functions.markdown)
791. [Serving Remote ProjectM36 Databases](docs/server_mode.markdown)
681. [Serving Remote ProjectM36 Databases](docs/server_mode.markdown)
801. [Using Notifications](docs/using_notifications.markdown)
691. [Using Notifications](docs/using_notifications.markdown)
811. [Merge Transactions](docs/merge_transactions.markdown)
701. [Merge Transactions](docs/merge_transactions.markdown)
71+1. [WebSocket Server](docs/websocket_server.markdown)
821. [Atom (Value) Functions](docs/atomfunctions.markdown)
721. [Atom (Value) Functions](docs/atomfunctions.markdown)
831. [Trans-Graph Relational Expressions](docs/transgraphrelationalexpr.markdown)
731. [Trans-Graph Relational Expressions](docs/transgraphrelationalexpr.markdown)
841. [Isomorphic Schemas](docs/isomorphic_schemas.markdown)
741. [Isomorphic Schemas](docs/isomorphic_schemas.markdown)
851. [Replication](docs/replication.markdown)
751. [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)
94
76
95## Development
77## Development
96
78
97−Project:M36 is developed in Haskell and compiled with GHC 8.6 or later.
79+Project:M36 is developed in Haskell and compiled with GHC 7.10 or GHC 8.0.2 or later.
98
80
99## Related Projects
81## Related Projects
100
82
@@ -105,6 +87,6 @@ Project:M36 is developed in Haskell and compiled with GHC 8.6 or later.
105
87
106## Suggested Reading
88## Suggested Reading
107
89
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.
90+* [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.
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
91* [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
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
92* [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+2−9
@@ -1,10 +1,3 @@
1+-- this is needed for GHC8 until distributed-process-extras is updated on Hackage with increased upper bounds
1packages: project-m36.cabal
2packages: project-m36.cabal
2−
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
5−
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,13 +24,11 @@ int cDirectoryFsync(char *path)
24 ret = fstat(fd,&fdstat);
24 ret = fstat(fd,&fdstat);
25 if(ret < 0)
25 if(ret < 0)
26 {
26 {
27− close(fd);
28 return errno;
27 return errno;
29 }
28 }
30
29
31 if(!S_ISDIR(fdstat.st_mode))
30 if(!S_ISDIR(fdstat.st_mode))
32 {
31 {
33− close(fd);
34 return ENOTDIR;
32 return ENOTDIR;
35 }
33 }
36
34
@@ -41,7 +39,6 @@ int cDirectoryFsync(char *path)
41#else
39#else
42 ret = fsync(fd);
40 ret = fsync(fd);
43#endif
41#endif
44− close(fd);
45 if(ret < 0)
42 if(ret < 0)
46 {
43 {
47 return errno;
44 return errno;
cbits/darwin_statfs.cdeleted−23
@@ -1,23 +0,0 @@
1−#include <sys/param.h>
2−#include <sys/mount.h>
3−#include <stdio.h>
4−
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.nixdeleted−1
@@ -1 +0,0 @@
1−(import ./release.nix { }).project
docker.nixdeleted−18
@@ -1,18 +0,0 @@
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+68−65
@@ -4,34 +4,40 @@ Thank you for evaluating Project:M36, a new relational algebra engine written in
4
4
5## Prerequisites
5## Prerequisites
6
6
7−* any Linux, MacOS, or Windows computer with Docker installed
7+* any Linux
8+* GHC 7.10 or later version (Haskell compiler)
9+* cabal (package downloader) installed
8
10
9## Download and Install
11## Download and Install
10
12
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−
17```bash
13```bash
18git clone https://github.com/agentm/project-m36.git
14git clone https://github.com/agentm/project-m36.git
15+cabal sandbox init
16+cabal install --dependencies-only
19−cabal new-run tutd
17+cabal run tutd
20```
18```
21
19
22## Some Basic TutorialD
20## Some Basic TutorialD
23
21
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.
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.
25
23
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.
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.
27
25
28### Load the Canonical Chris Date Example
26### Load the Canonical Chris Date Example
29
27
30```
28```
31−TutorialD (master/main): :importexample cjdate
29+TutorialD (master/main): :importexample date
30+```
31+
32+or
33+
34+```
35+TutorialD (master/main): :importtud "scripts/DateExamples.tutd"
32```
36```
33
37
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.
38+```:importtutd``` (do not skip typing the preceding colon), loads a file which contains a script written in the TutorialD dialect used by Project:M36 and executes it to change the state of the database. In this case, the relations "s" (supplier), "p" (product), and "sp" (suppliers-products) are now loaded.
39+
40+```:importexample date``` loads the date example directly without any file I/O, so it is safe to use with the websocket server.
35
41
36### Execute Relational Expressions
42### Execute Relational Expressions
37
43
@@ -158,7 +164,7 @@ Database context expressions change the state of the database, much like "CREATE
158#### Create a Relation Variable
164#### Create a Relation Variable
159
165
160```
166```
161−TutorialD (master/main): x:=relation{name Text, age Integer}{tuple{name "Steve", age 40},tuple{name "Mike", age 31}}
167+TutorialD (master/main): x:=relation{name Text, age Int}{tuple{name "Steve", age 40},tuple{name "Mike", age 31}}
162TutorialD (master/main): :showexpr x
168TutorialD (master/main): :showexpr x
163┌────────┬──────────┐
169┌────────┬──────────┐
164│age::Int│name::Text│
170│age::Int│name::Text│
@@ -173,25 +179,23 @@ This is similar to SQL's "CREATE TABLE" operator.
173#### Insert Additional Tuples
179#### Insert Additional Tuples
174
180
175```
181```
176−TutorialD (master/main): x:=relation{name Text, age Integer}{tuple{name "Steve", age 40},tuple{name "Mike", age 31}}
182+TutorialD (master/main): x:=relation{name Text, age Int}{tuple{name "Steve", age 40},tuple{name "Mike", age 31}}
177TutorialD (master/main): :showexpr x
183TutorialD (master/main): :showexpr x
178−┌────────────┬──────────┐
184+┌────────┬──────────┐
179−│age::Integer│name::Text│
185+│age::Int│name::Text│
180−├────────────┼──────────┤
186+├────────┼──────────┤
187+│40 │"Steve" │
181−│31 │"Mike" │
188+│31 │"Mike" │
182−│40 │"Steve" │
183−└────────────┴──────────┘
189+└────────┴──────────┘
184−
185TutorialD (master/main): insert x relation{tuple{name "Bob", age 24}}
190TutorialD (master/main): insert x relation{tuple{name "Bob", age 24}}
186TutorialD (master/main): :showexpr x
191TutorialD (master/main): :showexpr x
187−┌────────────┬──────────┐
192+┌────────┬──────────┐
188−│age::Integer│name::Text│
193+│age::Int│name::Text│
189−├────────────┼──────────┤
194+├────────┼──────────┤
190−│31 │"Mike" │
191−│40 │"Steve" │
195+│40 │"Steve" │
192−│24 │"Bob" │
196+│24 │"Bob" │
197+│31 │"Mike" │
193−└────────────┴──────────┘
198+└────────┴──────────┘
194−
195```
199```
196
200
197Note that the relational insertion is identical to "x:=x union relation{...}".
201Note that the relational insertion is identical to "x:=x union relation{...}".
@@ -200,51 +204,50 @@ Note that the relational insertion is identical to "x:=x union relation{...}".
200
204
201```
205```
202TutorialD (master/main): :showexpr s
206TutorialD (master/main): :showexpr s
203−┌──────────┬────────┬───────────┬───────────────┐
207+┌──────────┬────────┬───────────┬───────────┐
204−│city::Text│s#::Text│sname::Text│status::Integer│
208+│city::Text│s#::Text│sname::Text│status::Int│
205−├──────────┼────────┼───────────┼───────────────┤
209+├──────────┼────────┼───────────┼───────────┤
210+│"Paris" │"S2" │"Jones" │10 │
211+│"Paris" │"S3" │"Blake" │30 │
206−│"London" │"S1" │"Smith" │20 │
212+│"London" │"S1" │"Smith" │20 │
213+│"London" │"S4" │"Clark" │20 │
207−│"Athens" │"S5" │"Adams" │30 │
214+│"Athens" │"S5" │"Adams" │30 │
208−│"Paris" │"S3" │"Blake" │30 │
209−│"London" │"S4" │"Clark" │20 │
210−│"Paris" │"S2" │"Jones" │10 │
211−└──────────┴────────┴───────────┴───────────────┘
215+└──────────┴────────┴───────────┴───────────┘
212TutorialD (master/main): update s where city="London" (status:=35)
216TutorialD (master/main): update s where city="London" (status:=35)
213TutorialD (master/main): :showexpr s
217TutorialD (master/main): :showexpr s
214−┌──────────┬────────┬───────────┬───────────────┐
218+┌──────────┬────────┬───────────┬───────────┐
215−│city::Text│s#::Text│sname::Text│status::Integer│
219+│city::Text│s#::Text│sname::Text│status::Int│
216−├──────────┼────────┼───────────┼───────────────┤
220+├──────────┼────────┼───────────┼───────────┤
217−│"Athens" │"S5" │"Adams" │30 │
221+│"London" │"S4" │"Clark" │35 │
218−│"London" │"S1" │"Smith" │35 │
222+│"London" │"S1" │"Smith" │35 │
219−│"London" │"S4" │"Clark" │35 │
220−│"Paris" │"S3" │"Blake" │30 │
221−│"Paris" │"S2" │"Jones" │10 │
223+│"Paris" │"S2" │"Jones" │10 │
224+│"Paris" │"S3" │"Blake" │30 │
225+│"Athens" │"S5" │"Adams" │30 │
222−└──────────┴────────┴───────────┴───────────────┘
226+└──────────┴────────┴───────────┴───────────┘
223−
224```
227```
225#### Deleting Tuples from a Relation Variable
228#### Deleting Tuples from a Relation Variable
226
229
227```
230```
228TutorialD (master/main): :showexpr s
231TutorialD (master/main): :showexpr s
229−┌──────────┬────────┬───────────┬───────────────┐
232+┌──────────┬────────┬───────────┬───────────┐
230−│city::Text│s#::Text│sname::Text│status::Integer│
233+│city::Text│s#::Text│sname::Text│status::Int│
231−├──────────┼────────┼───────────┼───────────────┤
234+├──────────┼────────┼───────────┼───────────┤
232−│"Paris" │"S2" │"Jones" │10 │
235+│"Paris" │"S2" │"Jones" │10 │
233−│"Paris" │"S3" │"Blake" │30 │
236+│"Paris" │"S3" │"Blake" │30 │
234−│"London" │"S1" │"Smith" │20 │
237+│"London" │"S1" │"Smith" │20 │
238+│"London" │"S4" │"Clark" │20 │
235−│"Athens" │"S5" │"Adams" │30 │
239+│"Athens" │"S5" │"Adams" │30 │
236−│"London" │"S4" │"Clark" │20 │
237−└──────────┴────────┴───────────┴───────────────┘
240+└──────────┴────────┴───────────┴───────────┘
238TutorialD (master/main): delete s where sname="Adams"
241TutorialD (master/main): delete s where sname="Adams"
239TutorialD (master/main): :showexpr s
242TutorialD (master/main): :showexpr s
240−┌──────────┬────────┬───────────┬───────────────┐
243+┌──────────┬────────┬───────────┬───────────┐
241−│city::Text│s#::Text│sname::Text│status::Integer│
244+│city::Text│s#::Text│sname::Text│status::Int│
242−├──────────┼────────┼───────────┼───────────────┤
245+├──────────┼────────┼───────────┼───────────┤
243−│"Paris" │"S2" │"Jones" │10 │
246+│"Paris" │"S2" │"Jones" │10 │
244−│"London" │"S4" │"Clark" │20 │
245−│"Paris" │"S3" │"Blake" │30 │
247+│"Paris" │"S3" │"Blake" │30 │
246−│"London" │"S1" │"Smith" │20 │
248+│"London" │"S1" │"Smith" │20 │
249+│"London" │"S4" │"Clark" │20 │
247−└──────────┴────────┴───────────┴───────────────┘
250+└──────────┴────────┴───────────┴───────────┘
248```
251```
249
252
250### Execute Transaction Graph Expressions
253### Execute Transaction Graph Expressions
@@ -267,7 +270,7 @@ TutorialD (master/main): :rollback
267
270
268```
271```
269TutorialD (master/main): :branch experimental
272TutorialD (master/main): :branch experimental
270−TutorialD (experimental): employee:=relation{name Text, salary Integer}
273+TutorialD (experimental): employee:=relation{name Text, salary Int}
271TutorialD (experimental): :commit
274TutorialD (experimental): :commit
272```
275```
273
276
docs/atomfunctions.markdown+2−31
@@ -6,7 +6,7 @@ While Project:M36 includes a set of basic function which operate on relational v
6
6
7Other DBMSes also include this feature by way of stored functions such as with PL/pgsql, T-SQL, or PL/SQL.
7Other DBMSes also include this feature by way of stored functions such as with PL/pgsql, T-SQL, or PL/SQL.
8
8
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.
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.
10
10
11## Atom Function Example
11## Atom Function Example
12
12
@@ -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.
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.
16
16
17```
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```
19```
20
20
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.
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,35 +41,6 @@ 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"
41addatomfunction "idTest" a -> Either AtomFunctionError a "(\(x:_) -> pure x) :: [Atom] -> Either AtomFunctionError Atom"
42```
42```
43
43
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−
73## Differences when compared to other DBMSes
44## Differences when compared to other DBMSes
74
45
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.
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.
docs/basic_benchmarks.htmldeleted−1230
@@ -1,1230 +0,0 @@
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−
16−Copyright (c) 2007-2014 IOLA and Ole Laursen.
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−
26−Copyright (c) 2007-2014 IOLA and Ole Laursen.
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−
35−Copyright (c) 2007-2014 IOLA and Ole Laursen.
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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2; 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&#xb2;
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 = '&#x2079;';
1109− }
1110− if (iters >= 1e6) {
1111− denom = '1e6'; power = '&#x2076;';
1112− }
1113− else if (iters >= 1e3) {
1114− denom = '1e3'; power = '&#xb3;';
1115− }
1116− else denom = 1;
1117− if (denom > 1) {
1118− iters = (iters / denom).toFixed();
1119− iters += '&times;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.markdowndeleted−134
@@ -1,134 +0,0 @@
1−# Transactional Database Commits in O(1)
2−
3−A.M.
4−
5−[Project:M36](https://github.com/agentm/project-m36)
6−
7−## Synopsis
8−
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.markdowndeleted−109
@@ -1,109 +0,0 @@
1−# Project:M36: Towards an Architecture for Data Independence
2−
3−## Introduction
4−
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.
6−
7−## What is Data Independence?
8−
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+1−51
@@ -6,7 +6,7 @@ While "atom functions" operate on individual values and return new values (atoms
6
6
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.
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.
8
8
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.
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.
10
10
11## Database Context Function Types
11## Database Context Function Types
12
12
@@ -112,56 +112,6 @@ executeDatabaseContextExpr sessionId dbconn (ExecuteDatabaseContextFunction func
112```
112```
113from the same module.
113from the same module.
114
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−
165## Future Improvements
115## Future Improvements
166
116
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.
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.
docs/dataframes.markdowndeleted−53
@@ -1,53 +0,0 @@
1−# Project:M36 DataFrames
2−
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.
4−
5−The equivalent feature in SQL is invoked by the `ORDER BY`, `LIMIT`, and `OFFSET` clauses.
6−
7−## Usage
8−
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.markdowndeleted−128
@@ -1,128 +0,0 @@
1−# Project-M36 Filesystem Persistence (Change Proposal)
2−
3−## Introduction
4−
5−Existing database persistent storage is not suitable for Project:M36 storage for several reasons:
6−
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.markdowndeleted−65
@@ -1,65 +0,0 @@
1−# Project:M36 CSV Import/Export
2−
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.
4−
5−## CSV Export
6−
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.
8−
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+14−35
@@ -1,7 +1,7 @@
1# Introduction to Project:M36
1# Introduction to Project:M36
2
2
3## What is Project:M36?
3## What is Project:M36?
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.
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.
5
5
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.
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.
7
7
@@ -15,59 +15,38 @@ The relational algebra is the mathematical model underpinning Project:M36. When
15
15
16## Binary Releases
16## Binary Releases
17
17
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.
18+### Windows
19+Project:M36 now provides binary installations for Windows. Check the (releases page)[https://github.com/agentm/project-m36/releases] for downloads.
19
20
20−### Install Docker:
21+### MacOS X
21
22
22−* [Windows 10 Docker Installation](https://docs.docker.com/docker-for-windows/wsl/)
23+Binary releases are not yet available for MacOS X, but compiling from source is easy.
23−* [MacOS Docker Installation](https://docs.docker.com/docker-for-mac/install/)
24−* [Linux Docker Installation](https://docs.docker.com/engine/install/#server)
25
24
26−### Run TutorialD from Docker Image
25+### Linux
27
26
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.
27+The currently-preferred method of installation is from source. A future enhancement would be installation from deb or rpm.
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−```
47
28
48## Source Installation
29## Source Installation
49
30
50Requirements:
31Requirements:
51
32
52−To build with stack:
53−
54−* [GHC 8.6.5 or greater](https://www.haskell.org/downloads)
33+* [GHC 7.10 or greater](https://www.haskell.org/downloads)
55* [Haskell stack](https://docs.haskellstack.org/en/stable/README/)
34* [Haskell stack](https://docs.haskellstack.org/en/stable/README/)
56−* Linux, macOS, or Microsoft Windows
35+* Linux, MacOS X, or Windows OS
57
36
58Compilation steps:
37Compilation steps:
59
38
60* ```git clone https://github.com/agentm/project-m36```
39* ```git clone https://github.com/agentm/project-m36```
61* ```cd project-m36```
40* ```cd project-m36```
62−* ```stack --stack-yaml stack.ghc8.6.yaml build```
41+* ```stack build```
63
42
64At this point, the TutorialD interactive interpreter can be run using ```stack exec tutd```.
43At this point, the TutorialD interactive interpreter can be run using ```stack exec tutd```.
65
44
66−Alternative building with GHC 8.6.5 or greater:
45+Alternative building with GHC 8.0.x:
67
46
68* ```cabal new-build```
47* ```cabal new-build```
69
48
70−The resultant binaries can be found in ```./dist-newstyle/build/project-m36-<version>/build```.
49+The resultant binaries can be found in ```./dist-newstyle/build/project-m36-0.1/build```.
71
50
72## Accessing Project:M36 Databases
51## Accessing Project:M36 Databases
73
52
@@ -86,7 +65,7 @@ In addition to being a relational algebra engine, Project:M36 supports features
86
65
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.
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.
88
67
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.
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.
90
69
91This feature is useful, for example:
70This feature is useful, for example:
92* during testing- create a testing branch which production will never see. This obviates the need for a separate production data set.
71* during testing- create a testing branch which production will never see. This obviates the need for a separate production data set.
@@ -108,7 +87,7 @@ Decreasing a transaction's durability can reduce IO contention at the cost of re
108
87
109### Native Haskell Compatibility
88### Native Haskell Compatibility
110
89
111−Any Haskell data type which implements the ```Atomable``` typeclass can be manipulated as a value in the database.
90+Any Haskell data type which implements the ```Atom``` typeclass can be manipulated as a value in the database.
112
91
113Haskell functions which operate on those values can also be added to the database.
92Haskell functions which operate on those values can also be added to the database.
114
93
docs/introduction_to_the_relational_algebra.markdown+2−2
@@ -202,7 +202,7 @@ Join (Instructor relation)
202
202
203(Course Relation)
203(Course Relation)
204
204
205−|(Course Name, Course Name Type)|(Instructor Name, Instructor Name Type)|(Course Room Number, Room Number Type)|
205+|(Course Name, Course Name Type)|(Instructor, Instructor Name Type)|(Course Room Number, Room Number Type)|
206|-------------------------------|----------------------------------|--------------------------------------|
206|-------------------------------|----------------------------------|--------------------------------------|
207|English 1|Steve|Room 104|
207|English 1|Steve|Room 104|
208|French 2|Bob|Room 103|
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
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.
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
380
381−In the relational algebra, The aggregate value can be placed alongside the relation value from which the aggregate was derived.
381+In the relational algebra, The aggregate value can be placed alongside the relation value from whic the aggregate was derived.
382
382
383Example:
383Example:
384
384
docs/jupyter_kernel.markdowndeleted−49
@@ -1,49 +0,0 @@
1−# TutorialD Jupyter Kernel for Project:M36
2−
3−## Introduction
4−
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.
6−
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.
8−
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.markdowndeleted−33
@@ -1,33 +0,0 @@
1−# Project:M36: Merkle Hashing for Transaction Graph
2−
3−## Introduction
4−
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.
6−
7−## Usage
8−
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+4−6
@@ -8,8 +8,6 @@ In addition, the Project:M36 runtime supports algebraic data types in the same v
8
8
9Project:M36 makes it easy to add any Haskell data type to the database. Any type which includes instances for a set of typeclasses can be supported.
9Project:M36 makes it easy to add any Haskell data type to the database. Any type which includes instances for a set of typeclasses can be supported.
10
10
11−For storing Haskell record types as database tuples, see "[Converting data types to tuples](/docs/tupleable.markdown)."
12−
13## Support for Runtime Types
11## Support for Runtime Types
14
12
15Use the ```tutd``` interpreter to create new type and data constructors with essentially the same syntax as in Haskell:
13Use the ```tutd``` interpreter to create new type and data constructors with essentially the same syntax as in Haskell:
@@ -61,7 +59,7 @@ Note that the ```Atomable``` instance can also be derived.
61After setting up the connection (which we elide here), the database context is loaded with the expression to define the data type.
59After setting up the connection (which we elide here), the database context is loaded with the expression to define the data type.
62
60
63```haskell
61```haskell
64−executeDatabaseContextExpr sessionId conn (toAddTypeExpr (undefined :: Hair))
62+executeDatabaseContextExpr sessionId conn (toDatabaseContextExpr (undefined :: Hair))
65```
63```
66
64
67Using a ```Proxy``` would also be acceptable, but the result would be the same.
65Using a ```Proxy``` would also be acceptable, but the result would be the same.
@@ -103,9 +101,9 @@ The essential ```Atomable``` typeclass functions are:
103| -------- | ------- |
101| -------- | ------- |
104| ```toAtom :: a -> Atom``` | convert a Haskell data type to a database atom |
102| ```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 |
103| ```fromAtom :: Atom -> a``` | convert a database atom to a Haskell data type |
106−| ```toAtomType :: Proxy a -> AtomType``` | generate a database AtomType for a Haskell datatype |
104+| ```toAtomType :: a -> AtomType``` | generate a database AtomType for a Haskell datatype |
107−| ```toAddTypeExpr :: Proxy a -> DatabaseContextExpr``` | generate a ```DatabaseContextExpr``` which can be executed against a database context in order to add the new type |
105+| ```toDatabaseContextExpr :: a -> DatabaseContextExpr``` | generate a ```DatabaseContextExpr``` which can be executed against a database context in order to add the new type |
108
106
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.
107+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
108
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).
109To 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/projectm36_client_library.markdown+1−3
@@ -2,8 +2,6 @@
2
2
3The Project:M36 client library is the preferred method for interacting with Project:M36 databases. It supports all features of the DBMS while other interfaces may not.
3The Project:M36 client library is the preferred method for interacting with Project:M36 databases. It supports all features of the DBMS while other interfaces may not.
4
4
5−**Note:** A less featureful but more convenient client API also is available: see [documentation](simple_api.markdown).
6−
7The client supports both in-process and remote Project:M36 access.
5The client supports both in-process and remote Project:M36 access.
8
6
9## Setup
7## Setup
@@ -12,7 +10,7 @@ The client supports both in-process and remote Project:M36 access.
12```haskell
10```haskell
13import ProjectM36.Client
11import ProjectM36.Client
14```
12```
15−2. Create a Connection with a `ConnectionInfo` in the Either monad
13+2. Create a Connection with a ConnectionInfo in the Either monad
16```haskell
14```haskell
17conn <- connectProjectM36 (InProcessConnectionInfo NoPersistence)
15conn <- connectProjectM36 (InProcessConnectionInfo NoPersistence)
18```
16```
docs/reaching_out_of_the_tarpit.markdown+7−7
@@ -2,11 +2,11 @@
2
2
3## Introduction
3## Introduction
4
4
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.
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.
6
6
7## Why is "Out of the Tarpit" Important?
7## Why is "Out of the Tarpit" Important?
8
8
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.
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.
10
10
11## Laying the Foundations for Reduced Complexity
11## Laying the Foundations for Reduced Complexity
12
12
@@ -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)
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
22* **restricted**: removing mistaken features; if a programming language allows a programmer to do something less-than-savory, then that misfeature will be used
23
23
24−and provides ([p.37](https://github.com/papers-we-love/papers-we-love/blob/2eb8d21/design/out-of-the-tar-pit.pdf)):
24+and provides ([p.37](http://shaffner.us/cs/papers/tarpit.pdf)):
25
25
26* **structure**: a closed world system whereby all data is represented by relations
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
27* **manipulation**: a means to simulate mutation of the application state over time
28* **data integrity**: constraints which prevent illogical data constructions
28* **data integrity**: constraints which prevent illogical data constructions
29* **data independence**: logical and physical representations of state which are clearly separated
29* **data independence**: logical and physical representations of state which are clearly separated
30
30
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.
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.
32
32
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.
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.
34
34
@@ -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:
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:
58
58
59```
59```
60−TutorialD (master/main): :importexample cjdate
60+TutorialD (master/main): :importexample date
61TutorialD (master/main): :showexpr p
61TutorialD (master/main): :showexpr p
62┌───────────────────┬────────────┬───────────────────┬────────────┬────────────┐
62┌───────────────────┬────────────┬───────────────────┬────────────┬────────────┐
63│address::Address │agent::Agent│dateRegistered::Day│photo::Text │price::Price│
63│address::Address │agent::Agent│dateRegistered::Day│photo::Text │price::Price│
@@ -70,7 +70,7 @@ TutorialD (master/main): :showexpr p
70
70
71### Infrastructure Requirements
71### Infrastructure Requirements
72
72
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):
73+Project:M36 meets or exceeds the enumerated "Infrastructure" ([p.47](http://shaffner.us/cs/papers/tarpit.pdf)) requirements (except one):
74
74
75* **Infrastructure for Essential State**: relation variable manipulation, storage, and data types
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
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
82
82
83### Feeders and Observers
83### Feeders and Observers
84
84
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.
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.
86
86
87SQL developers are already intimately familiar with "feeders"- these are merely INSERT and UPDATE statements issued to the database via some middleware.
87SQL developers are already intimately familiar with "feeders"- these are merely INSERT and UPDATE statements issued to the database via some middleware.
88
88
docs/server_mode.markdown+1−1
@@ -8,7 +8,7 @@ While Project:M36 is easy-to-use as an interactive, in-process database manageme
8
8
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.
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.
10
10
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```.
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```.
12
12
13## Connecting an Interactive Client
13## Connecting an Interactive Client
14
14
docs/simple_api.markdowndeleted−42
@@ -1,42 +0,0 @@
1−# The Project:M36 Simple Client Interface
2−
3−## Introduction
4−
5−For common use cases, the `ProjectM36.Client.Simple` API can assist in transaction management. The API is designed to be less overwhelming than the full-featured `ProjectM36.Client` (see [documentation](projectm36_client_library.markdown)).
6−
7−As such, not all features are available through the simple API, but, because the simple API is a thin layer over the complete API, the user may dip into the complete API at any time.
8−
9−## Usage
10−
11− 1. Create a `DbConn` to connect to the database:
12−
13− ```haskell
14− import ProjectM36.Client.Simple
15− ...
16− let connInfo = InProcessConnectionInfo (CrashSafePersistence "my.db") emptyNotificationCallback []
17− eDbconn <- simpleConnectProjectM36 connInfo
18− ```
19−
20− The result is `Either` a `DbError` or a connection linked to the `"master"` branch of the database.
21−
22− 1. Run the `Db` monad using `withTransaction`:
23−
24− ```haskell
25− withTransaction dbconn $ do
26− execute $ Assign "x" (ExistingRelation relationTrue)
27− query $ RelationVariable "x" ()
28− ```
29−
30− If there is an error in the above update or query, then an exception is thrown behind the scenes which cancels the transactions, rolls back any changes, and the error is returned by `withTransaction`.
31−
32− `query` is used with `RelationalExpr` queries which read the current database state.
33−
34− `execute` is used with `DatabaseContextExpr` values which write the current database state.
35−
36− To execute a query without cancelling the transaction on an error, use the `queryOrErr` and `executeOrErr` variants.
37−
38− 1. Close the connection:
39−
40− ```haskell
41− close dbconn
42− ```
docs/transaction_graph_operators.markdown+19−45
@@ -10,11 +10,23 @@ When a new database is created, a new transaction graph is created for it with o
10
10
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.
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.
12
12
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})
13+![Initial database starting state](http://g.gravizo.com/g?
14+digraph G {
15+ base[label="base transaction",shape=rectangle];
16+ new[label="mutable database context"];
17+ new -> base;
18+})
14
19
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.
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.
16
21
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})
22+![Freshly committed transaction](http://g.gravizo.com/g?
23+digraph G {
24+ base[label="base transaction",shape=rectangle];
25+ discon[label="mutable database context"];
26+ fresh[label="newly committed transaction",shape=rectangle];
27+ fresh -> base;
28+ discon -> fresh;
29+})
18
30
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.
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.
20
32
@@ -43,24 +55,20 @@ TutorialD (master/main): :rollback
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.
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.
44
56
45```
57```
58+TutorialD (master/main): :showgraph
46−┌─────────────┬────────────────────────────────────────────┬──────────┬──────────────────────────────────────┬────────────────────────────────────────┬─────────────────────────────────┐
59+┌───────┬──────┬────────────────────────────────────┬───────┐
47−│current::Bool│hash::ByteString │head::Text│id::Text │parents::relation {id::Text} │stamp::DateTime │
60+│current│head │id │parents│
48−├─────────────┼────────────────────────────────────────────┼──────────┼──────────────────────────────────────┼────────────────────────────────────────┼─────────────────────────────────┤
61+├───────┼──────┼────────────────────────────────────┼───────┤
49−
50−
51<big result elided>
62<big result elided>
52```
63```
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.
64The "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.
54
65
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−
57−The "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.
66+The "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.
58
67
59The "id" attribute is the UUID needed in order to navigate the graph.
68The "id" attribute is the UUID needed in order to navigate the graph.
60
69
61The "parents" attribute is a subrelation holding all parent transaction UUIDs for the given transaction.
70The "parents" attribute is a subrelation holding all parent transaction UUIDs for the given transaction.
62
71
63−The "stamp" attribute marks the time when the transaction was opened.
64
72
65#### Branch
73#### Branch
66
74
@@ -101,37 +109,3 @@ TutorialD (11b601c9-f46b-42b0-a2ce-cf18ced31b7f):
101```
109```
102
110
103Note that the ```tutd``` prompt now indicates that the mutable database context now refers to a specific transaction by UUID.
111Note that the ```tutd``` prompt now indicates that the mutable database context now refers to a specific transaction by UUID.
104−
105−#### Walk Back To Time
106−
107−Each transaction is committed along with a creation timestamp. From any point in the graph, one can "walk back" until the commit timestamp is past a given timestamp threshold.
108−
109−```
110−TutorialD (master/main): x:=true
111−TutorialD (master/main): :commit
112−TutorialD (master/main): :showgraph
113−┌─────────────┬──────────┬──────────────────────────────────────┬────────────────────────────────────────┬──────────────────────────────┐
114−│current::Bool│head::Text│id::Text │parents::relation {id::Text} │stamp::DateTime │
115−├─────────────┼──────────┼──────────────────────────────────────┼────────────────────────────────────────┼──────────────────────────────┤
116−│True │"master" │"b4c3bd0a-c594-456f-8e1b-8e296c939df4"│┌──────────────────────────────────────┐│2017-08-10 16:45:34.635582 UTC│
117−│ │ │ ││id::Text ││ │
118−│ │ │ │├──────────────────────────────────────┤│ │
119−│ │ │ ││"5e441752-f78d-4a0d-b7f6-b2716ab82a4d"││ │
120−│ │ │ │└──────────────────────────────────────┘│ │
121−│False │"" │"5e441752-f78d-4a0d-b7f6-b2716ab82a4d"│┌────────┐ │2017-08-10 16:43:59.160044 UTC│
122−│ │ │ ││id::Text│ │ │
123−│ │ │ │└────────┘ │ │
124−└─────────────┴──────────┴──────────────────────────────────────┴────────────────────────────────────────┴──────────────────────────────┘
125−
126−TutorialD (master/main): :walkbacktotime "2017-08-10 16:44:00"
127−TutorialD (<unknown>/main): :showexpr x
128−ERR: RelVarNotDefinedError "x"
129−```
130−
131−In the above example, we start with a fresh database and commit relvar ```x```. Then, using the displayed graph, we walk back to a time before the stamp provided from the graph display and discover that, indeed, ```x``` was not defined in that point in time.
132−
133−Note that all timestamps are in UTC time.
134−
135−If you choose to walk back in time before the database existed, you will see a ```RootTransactionTraversalError```.
136−
137−Note that some transactions, specifically merge transactions, can have multiple parents. In such walk back scenarios, an arbitrary parent is chosen to continue the search. For more precise control, use the other search/jump strategies to set your current transaction behind the merge transaction and then walk back.
docs/tupleable.markdowndeleted−68
@@ -1,68 +0,0 @@
1−# Marshaling Haskell Data Types to Database Tuples
2−
3−## Introduction
4−
5−Typical ORMs map certain data types to tuples within a relation variable. Because Project:M36 supports Haskell data types natively, any record data type which derives the ```Generic``` typeclass can be marshaled to a database tuple using the ```Tupleable``` typeclass. These marshaled database values can be operated on within the database using Haskell as well.
6−
7−## Setup
8−
9−Let's imagine we have a Haskell record type "Person" which we wish to map to a tuple in a relation variable called "person". Using ```GHC.Generics```, creating this mapping is trivial. Any record fields which are ```Atomable```, including algebraic data types, are supported.
10−
11−```haskell
12−import ProjectM36.Tupleable
13−
14−data Person = Person {
15− name :: Text,
16− employeeNumber :: Int,
17− likesHorses :: Bool
18−}
19−deriving Generic
20−
21−instance Tupleable Person
22−```
23−
24−Now, ```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.
25−
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−
45−## Usage
46−
47−The ```Tupleable``` module includes the following functions:
48−
49− * ```toInsertExpr :: forall a t. (Tupleable a, Traversable t) => t a -> RelVarName -> Either RelationalError DatabaseContextExpr```
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
55− * ```toAttributes :: proxy a -> Attributes```
56− * generates ```Attributes``` from a ```Tupleable``` value- can be used with ```undefined```, so an actual value is not necessary
57− * ```toTuple :: a -> RelationTuple```
58− * converts a ```Tupleable``` value to a tuple for use in queries
59− * ```fromTuple :: RelationTuple -> Either RelationalError a```
60− * converts a tuple to ```Tupleable``` value, unless there is an error such as a missing attribute
61−
62−For example usage, see the [Out of the Tarpit example](/examples/out_of_the_tarpit.hs).
63−
64−## Comparison to Other DBMSes
65−
66−The most annoying misfeature of the so-called object-relational model (ORM) is the data type impedance mismatch. This is especially egregious for Haskell clients which must contend with down-sampling the quality of Haskell data structures. For example, most DBMSes don't support algebraic data types, so the ORM can't represent them or it must represent them as binary or JSON blobs in the database which precludes such types from database-level type safety, constraints, and value queries.
67−
68−Project:M36 solves this mismatch by supporting algebraic data types as database-level values, Haskell scripting of database- and value-level server-side functions, and automatic and lossless marshaling of Haskell algebraic data types to values and tuples. Because the mapping between client data types and database-level data types is one-to-one, the mismatch is eliminated- any expression which could be evaluated against the data type on the client side can also be evaluated server-side.
docs/tutd_cheatsheet.markdowndeleted−99
@@ -1,99 +0,0 @@
1−# Tutorial D Cheatsheet
2−
3−The following tables list examples of expressions for `tutd`, Project:M36's "Tutorial D" implementation.
4−
5−## Relational Expressions
6−
7−Relational expressions query database state without being able to change it.
8−
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|
63−|`data Hair = Bald | Brown | Blond | OtherColor Text`|Create a new algebraic data type for use with values inside tuples|
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+185−310
@@ -14,64 +14,25 @@ TutorialD (master/main):
14
14
15"master" refers to the name of the branch to which the current transaction will be potentially committing.
15"master" refers to the name of the branch to which the current transaction will be potentially committing.
16
16
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−
51### Types
17### Types
52
18
53TutorialD is strongly-typed. The basic built-in types are:
19TutorialD is strongly-typed. The basic built-in types are:
54
20
55|Type Name|Explanation|Example|
21|Type Name|Explanation|Example|
56|---------|-----------|-------|
22|---------|-----------|-------|
57−|Text|arbitrary text|"The Old Man and the Sea"|
23+|char|arbitrary text|"The Old Man and the Sea"|
58−|Integer|arbitarily-sized integer|-4|
24+|int|any integer|-4|
59−|Int|machine word integer|int(10)|
25+|datetime|timestamp UTC|"2015-02-02 04:05:02"::datetime|
60−|DateTime|timestamp UTC|dateTimeFromEpochSeconds(1502304846)|
61−|Date|calendar date|fromGregorian(2017,05,30)|
62−|Double|floating point number|3.1459|
26+|double|floating point number|3.1459|
63−|Bool|boolean value|t|
27+|bool|boolean value|t|
64−|Bytestring|arbitrary-length string of bytes- input is base64-encoded|bytestring("dGVzdGRhdGE=")|
28+|bytestring|arbitrary-length string of bytes- input is base64-encoded|"dGVzdGRhdGE="::bytestring|
65−|Interval x|interval/range type for ints, doubles, datetimes, and dates|interval(3,5,f,f)|
66
29
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.
30With regards to boolean values, be sure not to conflate ```t``` or ```f``` as a boolean value with ```true``` and ```false``` which are relation variables.
68
31
69−The ```interval``` function last two arguments are boolean values indicating whether the interval is open at the start point and end point respectively.
70−
71Project:M36 will complain loudly if the expected types do not match. Automatic type coercion does not exist.
32Project:M36 will complain loudly if the expected types do not match. Automatic type coercion does not exist.
72
33
73```
34```
74−TutorialD (master/main): :showexpr s:{more:=add(10,@sname)}
35+TutorialD (master/main): :showexpr S:{more:=add(10,@sname)}
75ERR: AtomFunctionTypeError "add" 2 IntAtomType StringAtomType
36ERR: AtomFunctionTypeError "add" 2 IntAtomType StringAtomType
76```
37```
77
38
@@ -83,7 +44,7 @@ Relation Variables are named cells which reference relations within a transactio
83
44
84Definition of a relation variable:
45Definition of a relation variable:
85```
46```
86−products :: {name Text, age Integer}
47+products :: {name char, age int}
87```
48```
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.
49This 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.
89
50
@@ -102,6 +63,22 @@ Chris Date refers to these relations as "TABLE_DUM" and "TABLE_DEE" but such arb
102products{}
63products{}
103```
64```
104
65
66+### Date's Sample Relations
67+
68+The examples in this tutorial can be executed after loading Chris Date's sample relations using:
69+
70+```
71+:importexample date
72+```
73+
74+Each section assumes a fresh instance of the Date examples. The relation variables created in the script are:
75+
76+|Relation Variable Name|Description|
77+|----------------------|-----------|
78+|s|suppliers|
79+|p|parts|
80+|sp|contains mapping of which suppliers supply which parts|
81+
105### Relational Expressions
82### Relational Expressions
106
83
107A relational expression combines relational operators to create a new relation. ```tutd``` can display the result of executing a relational expression with ":showexpr".
84A relational expression combines relational operators to create a new relation. ```tutd``` can display the result of executing a relational expression with ":showexpr".
@@ -170,15 +147,15 @@ The unary rename operator outputs a new relation with chosen attributes renamed.
170
147
171```
148```
172TutorialD (master/main): :showexpr s rename {city as town}
149TutorialD (master/main): :showexpr s rename {city as town}
173−┌────────┬───────────┬───────────────┬──────────┐
150+┌──┬─────┬──────┬──────┐
174−│s#::Text│sname::Text│status::Integer│town::Text│
151+│s#│sname│status│town │
175−├────────┼───────────┼───────────────┼──────────┤
152+├──┼─────┼──────┼──────┤
176−│"S3" │"Blake" │30 │"Paris" │
153+│S3│Blake│30 │Paris │
177−│"S4" │"Clark" │20 │"London" │
154+│S4│Clark│20 │London│
178−│"S5" │"Adams" │30 │"Athens" │
155+│S5│Adams│30 │Athens│
179−│"S1" │"Smith" │20 │"London" │
156+│S1│Smith│20 │London│
180−│"S2" │"Jones" │10 │"Paris" │
157+│S2│Jones│10 │Paris │
181−└────────┴───────────┴───────────────┴──────────┘
158+└──┴─────┴──────┴──────┘
182```
159```
183
160
184#### Projection
161#### Projection
@@ -189,153 +166,78 @@ For example:
189
166
190```
167```
191TutorialD (master/main): :showexpr p{color,city}
168TutorialD (master/main): :showexpr p{color,city}
192−┌──────────┬───────────┐
169+┌──────┬─────┐
193−│city::Text│color::Text│
170+│city │color│
194−├──────────┼───────────┤
171+├──────┼─────┤
195−│"London" │"Red" │
172+│London│Red │
196−│"Paris" │"Green" │
173+│Paris │Blue │
197−│"Oslo" │"Blue" │
174+│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 │
227−│"Paris" │"S2" │"Jones" │10 │
175+│Paris │Green│
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−└──────────┘
176+└──────┴─────┘
266```
177```
267
178
268−Here, after joining `s` and `p`, we project on the intersection of attributes from `s` and `p` which happens to be `city`.
269−
270#### Restriction
179#### Restriction
271
180
272Restriction is applied using a "where" clause, much like in SQL.
181Restriction is applied using a "where" clause, much like in SQL.
273
182
274```
183```
275TutorialD (master/main): :showexpr p where color="Blue" and city="Paris"
184TutorialD (master/main): :showexpr p where color="Blue" and city="Paris"
276−┌──────────┬───────────┬────────┬───────────┬───────────────┐
185+┌─────┬─────┬──┬─────┬──────┐
277−│city::Text│color::Text│p#::Text│pname::Text│weight::Integer│
186+│city │color│p#│pname│weight│
278−├──────────┼───────────┼────────┼───────────┼───────────────┤
187+├─────┼─────┼──┼─────┼──────┤
279−│"Paris" │"Blue" │"P5" │"Cam" │12 │
188+│Paris│Blue │P5│Cam │12 │
280−└──────────┴───────────┴────────┴───────────┴───────────────┘
189+└─────┴─────┴──┴─────┴──────┘
281```
190```
282
191
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:
192The 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:
284
193
285```
194```
286TutorialD (master/main): :showexpr s where ^lt(@status,20)
195TutorialD (master/main): :showexpr s where ^lt(@status,20)
287−┌──────────┬────────┬───────────┬───────────────┐
196+┌─────┬──┬─────┬──────┐
288−│city::Text│s#::Text│sname::Text│status::Integer│
197+│city │s#│sname│status│
289−├──────────┼────────┼───────────┼───────────────┤
198+├─────┼──┼─────┼──────┤
290−│"Paris" │"S2" │"Jones" │10 │
199+│Paris│S2│Jones│10 │
291−└──────────┴────────┴───────────┴───────────────┘
200+└─────┴──┴─────┴──────┘
292```
201```
293
202
294#### Join
203#### Join
295
204
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.
205+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
297
206
298```
207```
299TutorialD (master/main): :showexpr s join sp
208TutorialD (master/main): :showexpr s join sp
300−┌──────────┬────────┬────────────┬────────┬───────────┬───────────────┐
209+┌──────┬──┬───┬──┬─────┬──────┐
301−│city::Text│p#::Text│qty::Integer│s#::Text│sname::Text│status::Integer│
210+│city │p#│QTY│s#│sname│status│
302−├──────────┼────────┼────────────┼────────┼───────────┼───────────────┤
211+├──────┼──┼───┼──┼─────┼──────┤
303−│"London" │"P2" │200 │"S1" │"Smith" │20 │
304−│"London" │"P6" │100 │"S1" │"Smith" │20 │
212+│London│P6│100│S1│Smith│20 │
305−│"London" │"P3" │400 │"S1" │"Smith" │20 │
213+│London│P3│400│S1│Smith│20 │
306−│"Paris" │"P2" │400 │"S2" │"Jones" │10 │
307−│"London" │"P5" │400 │"S4" │"Clark" │20 │
214+│London│P5│400│S4│Clark│20 │
308−│"Paris" │"P1" │300 │"S2" │"Jones" │10 │
309−│"London" │"P1" │300 │"S1" │"Smith" │20 │
215+│London│P1│300│S1│Smith│20 │
310−│"Paris" │"P2" │200 │"S3" │"Blake" │30 │
216+│Paris │P2│200│S3│Blake│30 │
217+│Paris │P1│300│S2│Jones│10 │
218+│London│P5│100│S1│Smith│20 │
311−│"London" │"P4" │300 │"S4" │"Clark" │20 │
219+│London│P4│300│S4│Clark│20 │
312−│"London" │"P2" │200 │"S4" │"Clark" │20 │
220+│Paris │P2│400│S2│Jones│10 │
313−│"London" │"P4" │200 │"S1" │"Smith" │20 │
221+│London│P2│200│S1│Smith│20 │
314−│"London" │"P5" │100 │"S1" │"Smith" │20 │
222+│London│P4│200│S1│Smith│20 │
315−└──────────┴────────┴────────────┴────────┴───────────┴───────────────┘
223+└──────┴──┴───┴──┴─────┴──────┘
316−```
224+```
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.
323
225
324#### Union
226#### Union
325
227
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.
228The 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.
327
229
328```
230```
329−TutorialD (master/main): :showexpr s union s
231+TutorialD (master/main): :showexpr S union S
330−┌──────────┬────────┬───────────┬───────────────┐
232+┌──────┬──┬─────┬──────┐
331−│city::Text│s#::Text│sname::Text│status::Integer│
233+│city │s#│sname│status│
332−├──────────┼────────┼───────────┼───────────────┤
234+├──────┼──┼─────┼──────┤
333−│"Paris" │"S3" │"Blake" │30 │
235+│Paris │S3│Blake│30 │
236+│London│S4│Clark│20 │
334−│"Athens" │"S5" │"Adams" │30 │
237+│Athens│S5│Adams│30 │
335−│"London" │"S1" │"Smith" │20 │
238+│London│S1│Smith│20 │
336−│"Paris" │"S2" │"Jones" │10 │
239+│Paris │S2│Jones│10 │
337−│"London" │"S4" │"Clark" │20 │
338−└──────────┴────────┴───────────┴───────────────┘
240+└──────┴──┴─────┴──────┘
339```
241```
340
242
341The union of any relation with itself is itself.
243The union of any relation with itself is itself.
@@ -346,15 +248,15 @@ The extend unary operator adds an attribute to a relation's header and body and
346
248
347```
249```
348TutorialD (master/main): :showexpr s:{status2:=add(10,@status)}
250TutorialD (master/main): :showexpr s:{status2:=add(10,@status)}
349−┌──────────┬────────┬───────────┬───────────────┬────────────────┐
251+┌──────┬──┬─────┬──────┬───────┐
350−│city::Text│s#::Text│sname::Text│status::Integer│status2::Integer│
252+│city │s#│sname│status│status2│
351−├──────────┼────────┼───────────┼───────────────┼────────────────┤
253+├──────┼──┼─────┼──────┼───────┤
352−│"Paris" │"S2" │"Jones" │10 │20 │
254+│Paris │S2│Jones│10 │20 │
353−│"Athens" │"S5" │"Adams" │30 │40 │
255+│Athens│S5│Adams│30 │40 │
354−│"London" │"S4" │"Clark" │20 │30 │
355−│"Paris" │"S3" │"Blake" │30 │40 │
256+│Paris │S3│Blake│30 │40 │
356−│"London" │"S1" │"Smith" │20 │30 │
257+│London│S1│Smith│20 │30 │
258+│London│S4│Clark│20 │30 │
357−└──────────┴────────┴───────────┴───────────────┴────────────────┘
259+└──────┴──┴─────┴──────┴───────┘
358```
260```
359
261
360The "@" is required in the above query in order to distinguish the attribute's name from a relation's name.
262The "@" is required in the above query in order to distinguish the attribute's name from a relation's name.
@@ -376,31 +278,29 @@ The unary group operator groups the argument attributes into subrelations for ea
376
278
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".
279Grouping 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".
378
280
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−
381```
281```
382TutorialD (master/main): :showexpr s group ({sname,status,s#} as subrel)
282TutorialD (master/main): :showexpr s group ({sname,status,s#} as subrel)
383−┌──────────┬───────────────────────────────────────────────────────┐
283+┌──────┬─────────────────┐
384−│city::Text│subrel::relation {s#::Text,sname::Text,status::Integer}│
284+│city │subrel │
385−├──────────┼───────────────────────────────────────────────────────┤
285+├──────┼─────────────────┤
386−│"Athens" │┌────────┬───────────┬───────────────┐ │
286+│Athens│┌──┬─────┬──────┐│
387−│ ││s#::Text│sname::Text│status::Integer│ │
287+│ ││s#│sname│status││
388−│ │├────────┼───────────┼───────────────┤ │
288+│ │├──┼─────┼──────┤│
389−│ ││"S5" │"Adams" │30 │ │
289+│ ││S5│Adams│30 ││
390−│ │└────────┴───────────┴───────────────┘ │
290+│ │└──┴─────┴──────┘│
291+│London│┌──┬─────┬──────┐│
292+│ ││s#│sname│status││
293+│ │├──┼─────┼──────┤│
294+│ ││S1│Smith│20 ││
295+│ ││S4│Clark│20 ││
296+│ │└──┴─────┴──────┘│
391−│"Paris" │┌────────┬───────────┬───────────────┐ │
297+│Paris │┌──┬─────┬──────┐│
392−│ ││s#::Text│sname::Text│status::Integer│ │
298+│ ││s#│sname│status││
393−│ │├────────┼───────────┼───────────────┤ │
299+│ │├──┼─────┼──────┤│
300+│ ││S3│Blake│30 ││
394−│ ││"S2" │"Jones" │10 │ │
301+│ ││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 │ │
402−│ │└────────┴───────────┴───────────────┘ │
302+│ │└──┴─────┴──────┘│
403−└──────────┴───────────────────────────────────────────────────────┘
303+└──────┴─────────────────┘
404```
304```
405
305
406#### Ungroup
306#### Ungroup
@@ -409,15 +309,15 @@ The unary ungroup operator "unwraps" subrelations in a relation-valued attribute
409
309
410```
310```
411TutorialD (master/main): :showexpr (s group ({sname,status,s#} as subrel)) ungroup subrel
311TutorialD (master/main): :showexpr (s group ({sname,status,s#} as subrel)) ungroup subrel
412−┌──────────┬────────┬───────────┬───────────────┐
312+┌──────┬──┬─────┬──────┐
413−│city::Text│s#::Text│sname::Text│status::Integer│
313+│city │s#│sname│status│
414−├──────────┼────────┼───────────┼───────────────┤
314+├──────┼──┼─────┼──────┤
415−│"Paris" │"S2" │"Jones" │10 │
416−│"Paris" │"S3" │"Blake" │30 │
315+│Paris │S3│Blake│30 │
417−│"London" │"S4" │"Clark" │20 │
316+│London│S4│Clark│20 │
418−│"London" │"S1" │"Smith" │20 │
419−│"Athens" │"S5" │"Adams" │30 │
317+│Athens│S5│Adams│30 │
318+│London│S1│Smith│20 │
319+│Paris │S2│Jones│10 │
420−└──────────┴────────┴───────────┴───────────────┘
320+└──────┴──┴─────┴──────┘
421```
321```
422
322
423#### Minus
323#### Minus
@@ -450,11 +350,11 @@ The relation variable assignment mentioned above certainly changes the state of
450```
350```
451TutorialD (master/main): newrelvar:=relation{tuple{age 3}}
351TutorialD (master/main): newrelvar:=relation{tuple{age 3}}
452TutorialD (master/main): :showexpr newrelvar
352TutorialD (master/main): :showexpr newrelvar
453−┌────────────┐
353+┌───┐
454−│age::Integer│
354+│age│
455−├────────────┤
355+├───┤
456−│3 │
356+│3 │
457−└────────────┘
357+└───┘
458```
358```
459
359
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.
360All 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.
@@ -476,16 +376,16 @@ The insert operators accepts a relation variable and a relation of the same type
476```
376```
477TutorialD (master/main): insert s relation{tuple{city "Boston",s# "S10",sname "Gonzalez",status 10}}
377TutorialD (master/main): insert s relation{tuple{city "Boston",s# "S10",sname "Gonzalez",status 10}}
478TutorialD (master/main): :showexpr s
378TutorialD (master/main): :showexpr s
479−┌──────────┬────────┬───────────┬───────────────┐
379+┌──────┬───┬────────┬──────┐
480−│city::Text│s#::Text│sname::Text│status::Integer│
380+│city │s# │sname │status│
481−├──────────┼────────┼───────────┼───────────────┤
381+├──────┼───┼────────┼──────┤
382+│Paris │S3 │Blake │30 │
383+│London│S4 │Clark │20 │
482−│"Athens" │"S5" │"Adams" │30 │
384+│Athens│S5 │Adams │30 │
385+│London│S1 │Smith │20 │
483−│"Paris" │"S2" │"Jones" │10 │
386+│Paris │S2 │Jones │10 │
484−│"Boston" │"S10" │"Gonzalez" │10 │
387+│Boston│S10│Gonzalez│10 │
485−│"London" │"S4" │"Clark" │20 │
486−│"London" │"S1" │"Smith" │20 │
487−│"Paris" │"S3" │"Blake" │30 │
488−└──────────┴────────┴───────────┴───────────────┘
388+└──────┴───┴────────┴──────┘
489```
389```
490
390
491This insertion operation is equivalent to:
391This insertion operation is equivalent to:
@@ -500,15 +400,15 @@ The update operator accepts a relation argument and a predicate, optionally filt
500```
400```
501TutorialD (master/main): update s where status=20 (sname:="Mr. Twenty")
401TutorialD (master/main): update s where status=20 (sname:="Mr. Twenty")
502TutorialD (master/main): :showexpr s
402TutorialD (master/main): :showexpr s
503−┌──────────┬────────┬────────────┬───────────────┐
403+┌──────┬──┬──────────┬──────┐
504−│city::Text│s#::Text│sname::Text │status::Integer│
404+│city │s#│sname │status│
505−├──────────┼────────┼────────────┼───────────────┤
405+├──────┼──┼──────────┼──────┤
506−│"Paris" │"S2" │"Jones" │10 │
507−│"London" │"S1" │"Mr. Twenty"│20 │
508−│"Paris" │"S3" │"Blake" │30 │
406+│Paris │S3│Blake │30 │
509−│"London" │"S4" │"Mr. Twenty"│20 │
407+│London│S1│Mr. Twenty│20 │
510−│"Athens" │"S5" │"Adams" │30 │
408+│Athens│S5│Adams │30 │
409+│Paris │S2│Jones │10 │
410+│London│S4│Mr. Twenty│20 │
511−└──────────┴────────┴────────────┴───────────────┘
411+└──────┴──┴──────────┴──────┘
512```
412```
513
413
514This is logically equivalent to:
414This is logically equivalent to:
@@ -516,15 +416,15 @@ This is logically equivalent to:
516```
416```
517TutorialD (master/main): s:=(((s where status=20){city,s#,status}):{sname:="Mr. Twenty"}) union (s where not status=20)
417TutorialD (master/main): s:=(((s where status=20){city,s#,status}):{sname:="Mr. Twenty"}) union (s where not status=20)
518TutorialD (master/main): :showexpr s
418TutorialD (master/main): :showexpr s
519−┌──────────┬────────┬────────────┬───────────────┐
419+┌──────┬──┬──────────┬──────┐
520−│city::Text│s#::Text│sname::Text │status::Integer│
420+│city │s#│sname │status│
521−├──────────┼────────┼────────────┼───────────────┤
421+├──────┼──┼──────────┼──────┤
522−│"Paris" │"S2" │"Jones" │10 │
523−│"London" │"S1" │"Mr. Twenty"│20 │
524−│"Paris" │"S3" │"Blake" │30 │
422+│Paris │S3│Blake │30 │
525−│"London" │"S4" │"Mr. Twenty"│20 │
423+│London│S1│Mr. Twenty│20 │
526−│"Athens" │"S5" │"Adams" │30 │
424+│Athens│S5│Adams │30 │
425+│Paris │S2│Jones │10 │
426+│London│S4│Mr. Twenty│20 │
527−└──────────┴────────┴────────────┴───────────────┘
427+└──────┴──┴──────────┴──────┘
528```
428```
529
429
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."
430This 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."
@@ -536,19 +436,19 @@ The delete operator accepts a relation argument and a filtering predicate, creat
536```
436```
537TutorialD (master/main): delete sp where s#="S4"
437TutorialD (master/main): delete sp where s#="S4"
538TutorialD (master/main): :showexpr sp
438TutorialD (master/main): :showexpr sp
539−┌────────┬────────────┬────────┐
439+┌──┬───┬──┐
540−│p#::Text│qty::Integer│s#::Text│
440+│p#│QTY│s#│
541−├────────┼────────────┼────────┤
441+├──┼───┼──┤
542−│"P2" │200 │"S3" │
543−│"P2" │400 │"S2" │
442+│P3│400│S1│
544−│"P1" │300 │"S1" │
545−│"P5" │100 │"S1" │
546−│"P4" │200 │"S1" │
443+│P4│200│S1│
547−│"P1" │300 │"S2" │
444+│P2│400│S2│
548−│"P3" │400 │"S1" │
549−│"P2" │200 │"S1" │
445+│P2│200│S1│
550−│"P6" │100 │"S1" │
446+│P6│100│S1│
447+│P1│300│S1│
448+│P2│200│S3│
449+│P1│300│S2│
450+│P5│100│S1│
551−└────────┴────────────┴────────┘
451+└──┴───┴──┘
552```
452```
553
453
554This is logically equivalent to:
454This is logically equivalent to:
@@ -583,7 +483,7 @@ Foreign keys are constraints which require that certain values appearing in one
583TutorialD (master/main): foreign key s#_in_sp sp{s#} in s{s#}
483TutorialD (master/main): foreign key s#_in_sp sp{s#} in s{s#}
584```
484```
585
485
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.
486+This expression ensure that any sp{s#} must also appear as a value in s{s#}.
587
487
588#### Functional dependencies
488#### Functional dependencies
589
489
@@ -617,27 +517,27 @@ SQL supports aggregate queries using aggregate functions (SUM(), COUNT(), AVERAG
617
517
618```
518```
619TutorialD (master/main): :showexpr s group ({s#,sname,status} as subrel):{citycount:=count(@subrel)}
519TutorialD (master/main): :showexpr s group ({s#,sname,status} as subrel):{citycount:=count(@subrel)}
620−┌──────────┬──────────────────┬───────────────────────────────────────────────────────┐
520+┌──────┬─────────┬─────────────────┐
621−│city::Text│citycount::Integer│subrel::relation {s#::Text,sname::Text,status::Integer}│
521+│city │citycount│subrel │
622−├──────────┼──────────────────┼───────────────────────────────────────────────────────┤
522+├──────┼─────────┼─────────────────┤
623−│"Athens" │1 │┌────────┬───────────┬───────────────┐ │
523+│Paris │2 │┌──┬─────┬──────┐│
624−│ │ ││s#::Text│sname::Text│status::Integer│ │
524+│ │ ││s#│sname│status││
625−│ │ │├────────┼───────────┼───────────────┤ │
525+│ │ │├──┼─────┼──────┤│
626−│ │ ││"S5" │"Adams" │30 │ │
526+│ │ ││S3│Blake│30 ││
627−│ │ │└────────┴───────────┴───────────────┘ │
628−│"Paris" │2 │┌────────┬───────────┬───────────────┐ │
629−│ │ ││s#::Text│sname::Text│status::Integer│ │
630−│ │ │├────────┼───────────┼───────────────┤ │
631−│ │ ││"S2" │"Jones" │10 │ │
527+│ │ ││S2│Jones│10 ││
632−│ │ ││"S3" │"Blake" │30 │ │
633−│ │ │└────────┴───────────┴───────────────┘ │
528+│ │ │└──┴─────┴──────┘│
634−│"London" │2 │┌────────┬───────────┬───────────────┐ │
529+│London│2 │┌──┬─────┬──────┐│
635−│ │ ││s#::Text│sname::Text│status::Integer│ │
530+│ │ ││s#│sname│status││
636−│ │ │├────────┼───────────┼───────────────┤ │
531+│ │ │├──┼─────┼──────┤│
532+│ │ ││S1│Smith│20 ││
637−│ │ ││"S4" │"Clark" │20 │ │
533+│ │ ││S4│Clark│20 ││
638−│ │ ││"S1" │"Smith" │20 │ │
639−│ │ │└────────┴───────────┴───────────────┘ │
534+│ │ │└──┴─────┴──────┘│
535+│Athens│1 │┌──┬─────┬──────┐│
536+│ │ ││s#│sname│status││
537+│ │ │├──┼─────┼──────┤│
538+│ │ ││S5│Adams│30 ││
539+│ │ │└──┴─────┴──────┘│
640−└──────────┴──────────────────┴───────────────────────────────────────────────────────┘
540+└──────┴─────────┴─────────────────┘
641```
541```
642
542
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.
543In 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.
@@ -648,28 +548,3 @@ In this query result, we can simultaneously answer how many suppliers are locate
648|sum(relation{int})|return the int sum of the relation's values|
548|sum(relation{int})|return the int sum of the relation's values|
649|max(relation{int})|return the maximum int from all the relation's values|
549|max(relation{int})|return the maximum int from all the relation's values|
650|min(relation{int})|return the minimum int from all the relation's values|
550|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+18−22
@@ -9,9 +9,8 @@ As an example, consider an email application. Users of the applications will wan
9A Project:M36 notification is comprised of three user-selected parts:
9A Project:M36 notification is comprised of three user-selected parts:
10
10
111. an arbitrary notification name: used to uniquely identify the notification in the server and client
111. an arbitrary notification name: used to uniquely identify the notification in the server and client
12−1. a trigger relational expression: when the outcome of this relational expression changes between two transactions, the notification is fired
12+2. a trigger relational expression: when the outcome of this relational expression changes between two transactions, the notification is fired
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
13+3. a report relational expression: when the notification fires, the expression is evaluated and passed along
15
14
16By separating the "trigger" and "report" expressions, database users control what kind of reporting they receive when the outcome of a relational expression changes.
15By separating the "trigger" and "report" expressions, database users control what kind of reporting they receive when the outcome of a relational expression changes.
17
16
@@ -22,7 +21,7 @@ Currently, notifications are sent to all connected clients and not only to the c
22Notifications can be created in the ```tutd``` TutorialD interpreter with the following syntax:
21Notifications can be created in the ```tutd``` TutorialD interpreter with the following syntax:
23
22
24```
23```
25−notify <notification name> <trigger relational expression> <report relational expression (pre-change)> <report relational expression (post-change)>
24+notify <notification name> <trigger relational expression> <report relational expression>
26```
25```
27
26
28## Deleting a Notification
27## Deleting a Notification
@@ -40,23 +39,21 @@ Consider the following ```person``` relation variable where "name" is a key:
40```
39```
41TutorialD (master/main): person:=relation{tuple{name "Steve",address "Main St."},tuple{name "John", address "Elm St."}}
40TutorialD (master/main): person:=relation{tuple{name "Steve",address "Main St."},tuple{name "John", address "Elm St."}}
42TutorialD (master/main): :showexpr person
41TutorialD (master/main): :showexpr person
43−┌─────────────┬──────────┐
42+┌────────┬─────┐
44−│address::Text│name::Text│
43+│address │name │
45−├─────────────┼──────────┤
44+├────────┼─────┤
45+│Elm St. │John │
46−│"Main St." │"Steve" │
46+│Main St.│Steve│
47−│"Elm St." │"John" │
48−└─────────────┴──────────┘
47+└────────┴─────┘
49```
48```
50
49
51If a remote application is currently the address in the tuple for "Steve", then it would install a notification for that tuple's key:
50If a remote application is currently the address in the tuple for "Steve", then it would install a notification for that tuple's key:
52
51
53```
52```
54−TutorialD (master/main): notify steve_change person where name="Steve" true (person where name="Steve"){address}
53+TutorialD (master/main): notify steve_change person where name="Steve" (person where name="Steve"){address}
55TutorialD (master/main): :commit
54TutorialD (master/main): :commit
56```
55```
57
56
58−In this case, we pass `true` as the old context report expression because we plan to ignore the result.
59−
60Then, when any client including the initiating client updates the "Steve" tuple, an asynchronous notification is fired:
57Then, when any client including the initiating client updates the "Steve" tuple, an asynchronous notification is fired:
61
58
62```
59```
@@ -65,17 +62,16 @@ TutorialD (master/main): :commit
65TutorialD (master/main): Notification received "steve_change": ...
62TutorialD (master/main): Notification received "steve_change": ...
66```
63```
67
64
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:
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
69
66
70```
67```
71TutorialD (master/main): Notification received "steve_change":
68TutorialD (master/main): Notification received "steve_change":
72Project (AttributeNames (fromList ["address"])) (Restrict (AttributeEqualityPredicate "name" (NakedAtomExpr Atom "Steve")) (RelationVariable "person"))
69Project (AttributeNames (fromList ["address"])) (Restrict (AttributeEqualityPredicate "name" (NakedAtomExpr Atom "Steve")) (RelationVariable "person"))
73−┌─────────────┐
70+┌────────┐
74−│address::Text│
71+│address │
75−├─────────────┤
72+├────────┤
76−│"Grove St." │
73+│Main St.│
77−└─────────────┘
74+└────────┘
78−
79```
75```
80
76
81## Notifications with ProjectM36.Client
77## Notifications with ProjectM36.Client
@@ -84,10 +80,10 @@ First, implement a ```NotificationCallback``` function to perform an IO action w
84
80
85Each ProjectM36 Connection can only have one callback and it cannot be changed after Connection creation.
81Each ProjectM36 Connection can only have one callback and it cannot be changed after Connection creation.
86
82
87−Then, create a DatabaseContextExpr using the AddNotification constructor:
83+Then, create a DatabaseExpr using the AddNotification constructor:
88
84
89```
85```
90−AddNotification <notification name::Text> <change expression::RelationalExpr> <report old context expression::RelationalExpr> <report new context expression::RelationalExpr>
86+AddNotification <notification name::Text> <change expression::RelationalExpr> <report expression::RelationalExpr>
91```
87```
92
88
93and execute it using ```executeDatabaseContextExpr```. In order for a notification to take effect, it must be committed as well.
89and 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
6
6
7## Setup
7## Setup
8
8
9−The websocket server is started with the same arguments as the normal [Project:M36 server](server_mode.markdown):
9+The websocket server is started with the same arguments as the normal [Project:M36 server](docs/server_mode.markdown):
10
10
11```
11```
12cabal run project-m36-websocket-server -- --database mydbname --hostname 127.0.0.1
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
16
16
17## Client Connection
17## Client Connection
18
18
19−A [simple JavaScript library](/src/bin/ProjectM36/Server/WebSocket/project-m36.js) to manage the WebSocket connection is available.
19+A [simple JavaScript library](/ProjectM36/Server/WebSocket/project-m36.js) to manage the WebSocket connection is available.
20
20
21## Sample Application
21## Sample Application
22
22
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.
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.
examples/CustomTupleable.hsdeleted−67
@@ -1,67 +0,0 @@
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.hsdeleted−54
@@ -1,54 +0,0 @@
1−{-# LANGUAGE DeriveGeneric, DerivingVia, GeneralizedNewtypeDeriving, TypeOperators, DataKinds, OverloadedStrings #-}
2−
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
9−
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.hsdeleted−12
@@ -1,12 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−--compile with `cabal exec ghc -- examples/DynamicAtomFunctions.hs -package project-m36`
3−--load with `loadatomfunctions "DynamicAtomFunctions" "someAtomFunctions" "examples/DynamicAtomFunctions.o"`
4−
5−module DynamicAtomFunctions where
6−import ProjectM36.Base
7−
8−someAtomFunctions :: [AtomFunction]
9−someAtomFunctions = [AtomFunction{
10− atomFuncName = "constTrue",
11− atomFuncType = [TypeVariableType "a", BoolAtomType],
12− atomFuncBody = AtomFunctionBody Nothing (\(x:_) -> pure (BoolAtom True))}]
examples/DynamicDatabaseContextFunctions.hsdeleted−26
@@ -1,26 +0,0 @@
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
9−
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.hsdeleted−446
@@ -1,446 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−
3−{-# LANGUAGE OverloadedStrings #-}
4−
5−{-# LANGUAGE DeriveAnyClass #-}
6−
7−{-# LANGUAGE DerivingVia #-}
8−
9−
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+2−3
@@ -1,12 +1,11 @@
1import ProjectM36.Client
1import ProjectM36.Client
2import ProjectM36.TupleSet
2import ProjectM36.TupleSet
3import ProjectM36.Relation.Show.Term
3import ProjectM36.Relation.Show.Term
4−import Data.Text.IO as TIO
5
4
6main :: IO ()
5main :: IO ()
7main = do
6main = do
8 -- 1. create a ConnectionInfo
7 -- 1. create a ConnectionInfo
9− let connInfo = RemoteConnectionInfo "mytestdb" "127.0.0.1" (show defaultServerPort) emptyNotificationCallback
8+ let connInfo = RemoteProcessConnectionInfo "mytestdb" (createNodeId "127.0.0.1" defaultServerPort) emptyNotificationCallback
10 -- 2. conncted to the remote database
9 -- 2. conncted to the remote database
11 eConn <- connectProjectM36 connInfo
10 eConn <- connectProjectM36 connInfo
12 case eConn of
11 case eConn of
@@ -33,7 +32,7 @@ main = do
33 eRel <- executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "person" ()))
32 eRel <- executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "person" ()))
34 case eRel of
33 case eRel of
35 Left err -> print err
34 Left err -> print err
36− Right rel -> TIO.putStrLn (showRelation rel)
35+ Right rel -> print (showRelation rel)
37
36
38 --7. close the connection
37 --7. close the connection
39 close conn
38 close conn
examples/blog.hsdeleted−221
@@ -1,221 +0,0 @@
1−-- a simple example of a blog schema
2−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, OverloadedStrings, CPP, DerivingVia #-}
3−
4−import ProjectM36.Client
5−import ProjectM36.Base
6−import ProjectM36.Relation
7−import ProjectM36.Tupleable
8−import ProjectM36.Atom (relationForAtom)
9−import ProjectM36.Tuple (atomForAttributeName)
10−
11−import Data.Either
12−import GHC.Generics
13−import qualified Data.Text as T
14−import qualified Data.Text.Lazy as TL
15−import Data.Time.Clock
16−import Data.Time.Calendar
17−import 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
33−
34−--define your data types
35−data Blog = Blog {
36− title :: T.Text,
37− entry :: T.Text,
38− tstamp :: UTCTime,
39− category :: Category --note that this type is an algebraic data type
40− }
41− deriving (Generic, Show) --derive Generic so that Tupleable can use default instances
42−
43−--instantiate default Tupleable instances
44−instance Tupleable Blog
45−
46−data Comment = Comment {
47− blogTitle :: T.Text,
48− commentTime :: UTCTime,
49− contents :: T.Text
50− } deriving (Generic, Show)
51−
52−instance Tupleable Comment
53−
54−data Category = Food | Cats | Photos | Other T.Text -- note that this data type could not be represented by an "enumeration" as found in SQL databases
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
57−
58−-- add some short-hand error handling- your application should have proper handling
59−handleIOError :: Show e => IO (Either e a) -> IO a
60−handleIOError m = do
61− v <- m
62− handleError v
63−
64−handleError :: Show e => Either e a -> IO a
65−handleError eErr = case eErr of
66− Left err -> print err >> error "Died due to errors."
67− Right v -> pure v
68−
69−handleIOErrors :: Show e => IO [Either e a] -> IO [a]
70−handleIOErrors m = do
71− eErrs <- m
72− case lefts eErrs of
73− [] -> pure (rights eErrs)
74− err:_ -> handleError (Left err)
75−
76−main :: IO ()
77−main = do
78− --connect to the database
79− let connInfo = InProcessConnectionInfo NoPersistence emptyNotificationCallback []
80− conn <- handleIOError $ connectProjectM36 connInfo
81−
82− sessionId <- handleIOError $ createSessionAtHead conn "master"
83−
84− createSchema sessionId conn
85− insertSampleData sessionId conn
86− --create the web routes
87− scotty 3000 $ do
88− S.get "/" (listBlogs sessionId conn)
89− S.get "/blog/:blogid" (showBlogEntry sessionId conn)
90− S.post "/comment" (addComment sessionId conn)
91−
92−--define the schema with the new Category atom (data) type, blog relvar, a comment relvar, and a foreign key relationship between them
93−createSchema :: SessionId -> Connection -> IO ()
94−createSchema sessionId conn = do
95− _ <- handleIOErrors $ mapM (executeDatabaseContextExpr sessionId conn) [
96− toAddTypeExpr (Proxy :: Proxy Category),
97− toDefineExpr (Proxy :: Proxy Blog) "blog",
98− toDefineExpr (Proxy :: Proxy Comment) "comment",
99− databaseContextExprForForeignKey "blog_comment" ("comment", ["blogTitle"]) ("blog", ["title"]),
100− databaseContextExprForUniqueKey "blog" ["title"]
101− ]
102− pure ()
103−
104−--create some sample values and insert them into the database's relation variables
105−insertSampleData :: SessionId -> Connection -> IO ()
106−insertSampleData sessionId conn = do
107− let blogs = [Blog { title = "Haskell Lenses",
108− entry = "I wear Haskell rose-colored lenses.",
109− tstamp = UTCTime (fromGregorian 2017 5 8) (secondsToDiffTime 1000),
110− category = Food },
111− Blog { title = "Haskell Monad Analogy",
112− entry = "Monads are like burritos going through intestines.",
113− tstamp = UTCTime (fromGregorian 2017 6 10) (secondsToDiffTime 2000),
114− category = Cats }
115− ]
116− comments = [Comment { blogTitle = "Haskell Lenses",
117− commentTime = UTCTime (fromGregorian 2017 7 8) (secondsToDiffTime 3000),
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− ]
123− insertBlogsExpr <- handleError $ toInsertExpr blogs "blog"
124− handleIOError $ executeDatabaseContextExpr sessionId conn insertBlogsExpr
125−
126− insertCommentsExpr <- handleError $ toInsertExpr comments "comment"
127− handleIOError $ executeDatabaseContextExpr sessionId conn insertCommentsExpr
128−
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
205−addComment :: SessionId -> Connection -> ActionM ()
206−addComment sessionId conn = do
207− blogid <- param "blogid"
208− commentText <- param "contents"
209− now <- liftIO getCurrentTime
210−
211− case toInsertExpr [Comment {blogTitle = blogid,
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+7−11
@@ -1,17 +1,15 @@
1−{-# LANGUAGE DeriveGeneric, DeriveAnyClass, OverloadedStrings, DerivingVia #-}
1+{-# LANGUAGE DeriveGeneric, DeriveAnyClass, OverloadedStrings #-}
2import ProjectM36.Client
2import ProjectM36.Client
3import ProjectM36.Relation.Show.Term
3import ProjectM36.Relation.Show.Term
4import GHC.Generics
4import GHC.Generics
5import Data.Text
5import Data.Text
6+import Data.Binary
6import Control.DeepSeq
7import Control.DeepSeq
7import qualified Data.Map as M
8import qualified Data.Map as M
8import qualified Data.Text.IO as TIO
9import qualified Data.Text.IO as TIO
9−import Data.Proxy
10−import Codec.Winery
11
10
12data Hair = Bald | Brown | Blond | OtherColor Text
11data Hair = Bald | Brown | Blond | OtherColor Text
13− deriving (Generic, Show, Eq, NFData, Atomable)
12+ deriving (Generic, Show, Eq, Binary, NFData, Atomable)
14− deriving Serialise via WineryVariant Hair
15
13
16main :: IO ()
14main :: IO ()
17main = do
15main = do
@@ -28,17 +26,15 @@ main = do
28 sessionId <- eCheck $ createSessionAtHead conn "master"
26 sessionId <- eCheck $ createSessionAtHead conn "master"
29
27
30 --create the data type in the database context
28 --create the data type in the database context
31− eCheck $ executeDatabaseContextExpr sessionId conn (toAddTypeExpr (Proxy :: Proxy Hair))
29+ eCheck $ executeDatabaseContextExpr sessionId conn (toDatabaseContextExpr (undefined :: Hair))
32
30
33 --create a relation with the new Hair AtomType
31 --create a relation with the new Hair AtomType
34 let blond = NakedAtomExpr (toAtom Blond)
32 let blond = NakedAtomExpr (toAtom Blond)
35− eCheck $ executeDatabaseContextExpr sessionId conn
33+ eCheck $ executeDatabaseContextExpr sessionId conn (Assign "people" (MakeRelationFromExprs Nothing [
36− (Assign "people"
37− (MakeRelationFromExprs Nothing $ TupleExprs () [
38− TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))
34+ TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))
39
35
40 let restrictionPredicate = AttributeEqualityPredicate "hair" blond
36 let restrictionPredicate = AttributeEqualityPredicate "hair" blond
41 peopleRel <- eCheck $ executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "people" ()))
37 peopleRel <- eCheck $ executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "people" ()))
42
38
43 TIO.putStrLn (showRelation peopleRel)
39 TIO.putStrLn (showRelation peopleRel)
44−
40+
examples/out_of_the_tarpit.hs+85−199
@@ -1,41 +1,51 @@
1-- the Out-of-the-Tarpit example in Haskell and Project:M36
1-- the Out-of-the-Tarpit example in Haskell and Project:M36
2−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, OverloadedStrings, DerivingVia #-}
2+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, OverloadedStrings #-}
3import ProjectM36.Client
3import ProjectM36.Client
4import ProjectM36.DataTypes.Primitive
4import ProjectM36.DataTypes.Primitive
5−import ProjectM36.Tupleable
5+import qualified Data.Map as M
6−import ProjectM36.Relation
7−import ProjectM36.Error
8import Data.Either
6import Data.Either
7+import Control.Monad
9import GHC.Generics
8import GHC.Generics
9+import Data.Binary
10import Control.DeepSeq
10import Control.DeepSeq
11−import qualified Data.Text as T
12−import Data.Time.Calendar
13−import Data.Proxy
14−import Codec.Winery
15
11
16--create various database value (atom) types
12--create various database value (atom) types
17−type Price = Double
13+addressAtomType :: AtomType
14+addressAtomType = TextAtomType
18
15
19−type Name = T.Text
16+nameAtomType :: AtomType
17+nameAtomType = TextAtomType
20
18
21−type Address = T.Text
19+priceAtomType :: AtomType
20+priceAtomType = DoubleAtomType
22
21
22+fileNameAtomType :: AtomType
23+fileNameAtomType = TextAtomType
24+
23−data RoomType = Kitchen | Bathroom | LivingRoom
25+data Room = Kitchen | Bathroom | LivingRoom
24− deriving (Generic, Atomable, Eq, Show, NFData)
26+ deriving (Generic, Atomable, Eq, Show, Binary, NFData)
25− deriving Serialise via WineryVariant RoomType
27+
28+roomAtomType :: AtomType
29+roomAtomType = toAtomType (undefined :: Room)
26
30
27data PriceBand = Low | Medium | High | Premium
31data PriceBand = Low | Medium | High | Premium
28− deriving (Generic, Atomable, Eq, Show, NFData)
32+ deriving (Generic, Atomable, Eq, Show, Binary, NFData)
29− deriving Serialise via WineryVariant PriceBand
30
33
34+priceBandAtomType :: AtomType
35+priceBandAtomType = toAtomType (undefined :: PriceBand)
36+
31data AreaCode = City | Suburban | Rural
37data AreaCode = City | Suburban | Rural
32− deriving (Generic, Atomable, Eq, Show, NFData)
38+ deriving (Generic, Atomable, Eq, Show, Binary, NFData)
33− deriving Serialise via WineryVariant AreaCode
39+
40+areaCodeAtomType :: AtomType
41+areaCodeAtomType = ConstructedAtomType "AreaCode" M.empty
34
42
35data SpeedBand = VeryFastBand | FastBand | MediumBand | SlowBand
43data SpeedBand = VeryFastBand | FastBand | MediumBand | SlowBand
36− deriving (Generic, Atomable, Eq, Show, NFData)
44+ deriving (Generic, Atomable, Eq, Show, Binary, NFData)
37− deriving Serialise via WineryVariant SpeedBand
38
45
46+speedBandAtomType :: AtomType
47+speedBandAtomType = ConstructedAtomType "SpeedBand" M.empty
48+
39main :: IO ()
49main :: IO ()
40main = do
50main = do
41 --connect to the database
51 --connect to the database
@@ -51,113 +61,77 @@ main = do
51 let sessionId = check eSessionId
61 let sessionId = check eSessionId
52
62
53 createSchema sessionId conn
63 createSchema sessionId conn
54− insertSampleData sessionId conn
55
64
56−data Property = Property {
57− address :: T.Text,
58− price :: Price,
59− photo :: T.Text,
60− dateRegistered :: Day
61− }
62− deriving (Generic, Eq, Show)
63−
64−instance Tupleable Property
65−
66−data Offer = Offer {
67− offerAddress :: Address,
68− offerPrice :: Price,
69− offerDate :: Day,
70− bidderName :: Name,
71− bidderAddress :: Address,
72− decisionDate :: Day,
73− accepted :: Bool
74− }
75− deriving (Generic, Eq)
76−
77−instance Tupleable Offer
78−
79−data Decision = Decision {
80− decAddress :: Address,
81− decOfferDate :: Day, --the dec prefix is needed until OverloadedRecordFields is available
82− decBidderName :: Name,
83− decBidderAddress :: Address,
84− decDecisionDate :: Day,
85− decAccepted :: Bool
86− }
87− deriving (Generic, Eq)
88−
89−instance Tupleable Decision
90−
91−data Room = Room {
92− roomAddress :: Address,
93− roomName :: Name,
94− width :: Double,
95− breadth :: Double,
96− roomType :: RoomType
97− }
98− deriving (Generic, Eq)
99−
100−instance Tupleable Room
101−
102−data Floor = Floor {
103− floorAddress :: Address,
104− floorRoomName :: Name,
105− floorNum :: Integer
106− }
107− deriving (Generic, Eq)
108−
109−instance Tupleable Floor
110−
111−data Commission = Commission {
112− priceBand :: PriceBand,
113− areaCode :: AreaCode,
114− saleSpeed :: SpeedBand,
115− commission :: Price
116− } deriving (Generic, Eq)
117−
118−instance Tupleable Commission
119−
120createSchema :: SessionId -> Connection -> IO ()
65createSchema :: SessionId -> Connection -> IO ()
121createSchema sessionId conn = do
66createSchema sessionId conn = do
122 --create attributes for relvars
67 --create attributes for relvars
123− let
68+ let propertyAttrs = [Attribute "address" addressAtomType,
69+ Attribute "price" priceAtomType,
70+ Attribute "photo" fileNameAtomType,
71+ Attribute "dateRegistered" DayAtomType]
72+ offerAttrs = [Attribute "address" addressAtomType,
73+ Attribute "offerPrice" priceAtomType,
74+ Attribute "offerDate" DayAtomType,
75+ Attribute "bidderName" nameAtomType,
76+ Attribute "bidderAddress" addressAtomType,
77+ Attribute "decisionDate" DayAtomType,
78+ Attribute "accepted" BoolAtomType]
79+ decisionAttrs = [Attribute "address" addressAtomType,
80+ Attribute "offerDate" DayAtomType,
81+ Attribute "bidderName" nameAtomType,
82+ Attribute "bidderAddress" addressAtomType,
83+ Attribute "decisionDate" DayAtomType,
84+ Attribute "accepted" BoolAtomType]
85+ roomAttrs = [Attribute "address" addressAtomType,
86+ Attribute "roomName" TextAtomType,
87+ Attribute "width" DoubleAtomType,
88+ Attribute "breadth" DoubleAtomType,
89+ Attribute "type" roomAtomType]
90+ floorAttrs = [Attribute "address" addressAtomType,
91+ Attribute "roomName" TextAtomType,
92+ Attribute "floor" IntAtomType]
93+ commissionAttrs = [Attribute "priceBand" priceBandAtomType,
94+ Attribute "areaCode" areaCodeAtomType,
95+ Attribute "saleSpeed" speedBandAtomType,
96+ Attribute "commission" DoubleAtomType]
124 --create uniqueness constraints
97 --create uniqueness constraints
125 incDepKeys = map (uncurry databaseContextExprForUniqueKey)
98 incDepKeys = map (uncurry databaseContextExprForUniqueKey)
126 [("property", ["address"]),
99 [("property", ["address"]),
127− ("offer", ["offerAddress", "offerDate", "bidderName", "bidderAddress"]),
100+ ("offer", ["address", "offerDate", "bidderName", "bidderAddress"]),
128− ("decision", ["decAddress", "decOfferDate", "decBidderName", "decBidderAddress"]),
101+ ("decision", ["address", "offerDate", "bidderName", "bidderAddress"]),
129− ("room", ["roomAddress", "roomName"]),
102+ ("room", ["address", "roomName"]),
130− ("floor", ["floorAddress", "floorRoomName"]),
103+ ("floor", ["address", "roomName"]),
131 --"commision" misspelled in OotT
104 --"commision" misspelled in OotT
132 ("commission", ["priceBand", "areaCode", "saleSpeed"])
105 ("commission", ["priceBand", "areaCode", "saleSpeed"])
133 ]
106 ]
134 --create foreign key constraints
107 --create foreign key constraints
135 foreignKeys = [("offer_property_fk",
108 foreignKeys = [("offer_property_fk",
136− ("offer", ["offerAddress"]),
109+ ("offer", ["address"]),
137 ("property", ["address"])),
110 ("property", ["address"])),
138 ("decision_offer_fk",
111 ("decision_offer_fk",
139− ("decision", ["decAddress", "decOfferDate", "decBidderName", "decBidderAddress"]),
112+ ("decision", ["address", "offerDate", "bidderName", "bidderAddress"]),
140− ("offer", ["offerAddress", "offerDate", "bidderName", "bidderAddress"])),
113+ ("offer", ["address", "offerDate", "bidderName", "bidderAddress"])),
141 ("room_property_fk",
114 ("room_property_fk",
142− ("room", ["roomAddress"]),
115+ ("room", ["address"]),
143 ("property", ["address"])),
116 ("property", ["address"])),
144 ("floor_property_fk",
117 ("floor_property_fk",
145− ("floor", ["floorAddress"]),
118+ ("floor", ["address"]),
146 ("property", ["address"]))
119 ("property", ["address"]))
147 ]
120 ]
148 incDepForeignKeys = map (\(n, a, b) -> databaseContextExprForForeignKey n a b) foreignKeys
121 incDepForeignKeys = map (\(n, a, b) -> databaseContextExprForForeignKey n a b) foreignKeys
149 --define the relvars
122 --define the relvars
150− rvExprs = [toDefineExpr (Proxy :: Proxy Property) "property",
123+ relvarMap = [("property", propertyAttrs),
151− toDefineExpr (Proxy :: Proxy Offer) "offer",
124+ ("offer", offerAttrs),
152− toDefineExpr (Proxy :: Proxy Decision) "decision",
125+ ("decision", decisionAttrs),
153− toDefineExpr (Proxy :: Proxy Room) "room",
126+ ("room", roomAttrs),
154− toDefineExpr (Proxy :: Proxy Floor) "floor",
127+ ("floor", floorAttrs),
155− toDefineExpr (Proxy :: Proxy Commission) "commission"]
128+ ("commission", commissionAttrs)]
129+ rvDefs = map (\(name, attrs) -> Define name (map NakedAttributeExpr attrs)) relvarMap
156 --create the new algebraic data types
130 --create the new algebraic data types
157− new_adts = [toAddTypeExpr (Proxy :: Proxy RoomType),
131+ new_adts = [toDatabaseContextExpr (undefined :: Room),
158− toAddTypeExpr (Proxy :: Proxy PriceBand),
132+ toDatabaseContextExpr (undefined :: PriceBand),
159− toAddTypeExpr (Proxy :: Proxy AreaCode),
133+ toDatabaseContextExpr (undefined :: AreaCode),
160− toAddTypeExpr (Proxy :: Proxy SpeedBand)]
134+ toDatabaseContextExpr (undefined :: SpeedBand)]
161 --create the stored atom functions
135 --create the stored atom functions
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"
136 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"
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"
137 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"
@@ -167,98 +141,10 @@ createSchema sessionId conn = do
167 createScriptedAtomFunction "datesToSpeedBand" [dayTypeConstructor, dayTypeConstructor] (ADTypeConstructor "SpeedBand" []) speedBandScript
141 createScriptedAtomFunction "datesToSpeedBand" [dayTypeConstructor, dayTypeConstructor] (ADTypeConstructor "SpeedBand" []) speedBandScript
168 ]
142 ]
169 --gather up and execute all database updates
143 --gather up and execute all database updates
170− putStrLn "load relvars"
171− _ <- handleIOErrors $ mapM (executeDatabaseContextExpr sessionId conn) (new_adts ++ rvExprs ++ incDepKeys ++ incDepForeignKeys)
144+ eErrs <- mapM (executeDatabaseContextExpr sessionId conn) (new_adts ++ rvDefs ++ incDepKeys ++ incDepForeignKeys)
172−
145+ let errs = lefts eErrs
173− putStrLn "load atom functions"
146+ unless (null errs) (error (show errs))
174− _ <- handleIOErrors $ mapM (executeDatabaseContextIOExpr sessionId conn) atomFuncs
175− pure ()
176−
177−insertSampleData :: SessionId -> Connection -> IO ()
178−insertSampleData sessionId conn = do
179− --insert a bunch of records
180− putStrLn "load data"
181− let properties = [Property { address = "123 Main St.",
182− price = 200000,
183− photo = "123_main.jpg",
184− dateRegistered = fromGregorian 2016 4 3},
185− Property { address = "456 Main St.",
186− price = 150000,
187− photo = "456_main.jpg",
188− dateRegistered = fromGregorian 2016 5 6}]
189− insertPropertiesExpr <- handleError $ toInsertExpr properties "property"
190− handleIOError $ executeDatabaseContextExpr sessionId conn insertPropertiesExpr
191−
192− let offers = [Offer { offerAddress = "123 Main St.",
193− offerPrice = 180000,
194− offerDate = fromGregorian 2017 1 2,
195− bidderName = "Steve",
196− bidderAddress = "789 Main St.",
197− decisionDate = fromGregorian 2017 2 2,
198− accepted = False }]
199−
200− insertOffersExpr <- handleError $ toInsertExpr offers "offer"
201− handleIOError $ executeDatabaseContextExpr sessionId conn insertOffersExpr
202−
203− let rooms = [Room { roomAddress = "123 Main St.",
204− roomName = "Fabulous Kitchen",
205− width = 10,
206− breadth = 10,
207− roomType = Kitchen },
208− Room { roomAddress = "123 Main St.",
209− roomName = "Clean Bathroom",
210− width = 7,
211− breadth = 5,
212− roomType = Bathroom }]
213−
214− insertRoomsExpr <- handleError $ toInsertExpr rooms "room"
215− handleIOError $ executeDatabaseContextExpr sessionId conn insertRoomsExpr
216−
217− let decisions = [Decision { decAddress = "123 Main St.",
218− decOfferDate = fromGregorian 2017 1 2,
219− decBidderName = "Steve",
220− decBidderAddress = "789 Main St.",
221− decDecisionDate = fromGregorian 2017 05 04,
222− decAccepted = False }]
223− insertDecisionsExpr <- handleError $ toInsertExpr decisions "decision"
224− handleIOError $ executeDatabaseContextExpr sessionId conn insertDecisionsExpr
225−
226− let floors = [Floor { floorAddress = "123 Main St.",
227− floorRoomName = "Bathroom",
228− floorNum = 1
229− }]
230− insertFloorsExpr <- handleError $ toInsertExpr floors "floor"
231− handleIOError $ executeDatabaseContextExpr sessionId conn insertFloorsExpr
232−
233− let commissions = [Commission { priceBand = Medium,
234− areaCode = City,
235− saleSpeed = MediumBand,
236− commission = 10000 }]
237− insertCommissionsExpr <- handleError $ toInsertExpr commissions "commission"
238− handleIOError $ executeDatabaseContextExpr sessionId conn insertCommissionsExpr
239−
240− --query some records, marshal them back to Haskell
241−
242− properties' <- handleIOError $ executeRelationalExpr sessionId conn (RelationVariable "property" ())
243−
244− props <- toList properties' >>= mapM (handleError . fromTuple) :: IO [Property]
245− print props
246−
247−handleError :: Either RelationalError a -> IO a
248−handleError eErr = case eErr of
249− Left err -> print err >> error "Died due to errors."
250− Right v -> pure v
251−
252−handleIOError :: IO (Either RelationalError a) -> IO a
253−handleIOError m = do
254− e <- m
255− handleError e
256−
257−handleIOErrors :: IO [Either RelationalError a] -> IO [a]
258−handleIOErrors m = do
259− eErrs <- m
260− case lefts eErrs of
261− [] -> pure (rights eErrs)
262− errs -> handleError (Left (someErrors errs))
263−
264
147
148+ eErrs' <- mapM (executeDatabaseContextIOExpr sessionId conn) atomFuncs
149+ let errs' = lefts eErrs'
150+ unless (null errs') (error (show errs'))
examples/out_of_the_tarpit.tutd+4−4
@@ -3,9 +3,9 @@
3data Address = Address Text
3data Address = Address Text
4data Agent = Agent Text
4data Agent = Agent Text
5data Name = Name Text
5data Name = Name Text
6−data Price = Price Integer --dollars
6+data Price = Price Double
7data RoomType = Kitchen | Bathroom | LivingRoom
7data RoomType = Kitchen | Bathroom | LivingRoom
8−data PriceBand = Low | Med | High | Premium
8+data PriceBand = Low | Medium | High | Premium
9data AreaCode = City | Suburban | Rural
9data AreaCode = City | Suburban | Rural
10data SpeedBand = VeryFast | Fast | Medium | Slow
10data SpeedBand = VeryFast | Fast | Medium | Slow
11
11
@@ -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)
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
58--2. remove the properties which have been sold
59--3. group and count sub-relation and restrict by greater than 50
59--3. group and count sub-relation and restrict by greater than 50
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
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
61
61
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
63
63
64-- sample data
64-- sample data
65
65
jupyter/TutorialD Notebook Walkthrough.ipynbdeleted−794
@@ -1,794 +0,0 @@
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.pydeleted−179
@@ -1,179 +0,0 @@
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__.pydeleted−1
@@ -1 +0,0 @@
1−
jupyter/itutd/__main__.pydeleted−4
@@ -1,4 +0,0 @@
1−from ipykernel.kernelapp import IPKernelApp
2−from . import ITutorialDKernel
3−
4−IPKernelApp.launch_instance(kernel_class=ITutorialDKernel)
jupyter/kernel.jsondeleted−5
@@ -1,5 +0,0 @@
1−{
2− "language":"TutorialD",
3− "display_name":"TutorialD (Project:M36)",
4− "argv":["python", "-m", "itutd.ITutorialDKernel", "-f", "{connection_file}"]
5−}
jupyter/setup.pydeleted−19
@@ -1,19 +0,0 @@
1−from setuptools import setup
2−
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.jsondeleted−50
@@ -1,50 +0,0 @@
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.nixdeleted−171
@@ -1,171 +0,0 @@
1−# This file has been generated by Niv.
2−
3−let
4−
5− #
6− # The fetchers. fetch_<type> fetches specs of type <type>.
7− #
8−
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+220−241
@@ -1,8 +1,6 @@
1−Cabal-Version: 2.2
2Name: project-m36
1Name: project-m36
3−Version: 0.9.3
2+Version: 0.1
4−License: MIT
3+License: PublicDomain
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
6Build-Type: Simple
4Build-Type: Simple
7Homepage: https://github.com/agentm/project-m36
5Homepage: https://github.com/agentm/project-m36
8Bug-Reports: https://github.com/agentm/project-m36/issues
6Bug-Reports: https://github.com/agentm/project-m36/issues
@@ -10,6 +8,7 @@ Author: AgentM
10Stability: experimental
8Stability: experimental
11Category: Relational Algebra
9Category: Relational Algebra
12Maintainer: agentm@themactionfaction.com
10Maintainer: agentm@themactionfaction.com
11+Cabal-Version: >= 1.10
13Synopsis: Relational Algebra Engine
12Synopsis: Relational Algebra Engine
14Description: A relational algebra engine which can be used to persist and query Haskell data types.
13Description: A relational algebra engine which can be used to persist and query Haskell data types.
15Extra-Source-Files: Changelog.markdown README.markdown
14Extra-Source-Files: Changelog.markdown README.markdown
@@ -23,27 +22,63 @@ Flag profiler
23 Default: False
22 Default: False
24 Manual: True
23 Manual: True
25
24
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−
37Library
25Library
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
26+ Build-Depends: base>=4.8 && < 6.0
39− if flag(haskell-scripting)
27+ ,ghc >= 7.8 && < 8.3
40− Build-Depends: ghc >= 8.2 && < 8.11
28+ ,ghc-paths
41− CPP-Options: -DPM36_HASKELL_SCRIPTING
29+ ,mtl
42− if impl(ghc>= 8) && flag(haskell-scripting)
30+ ,containers
43− build-depends:
31+ ,unordered-containers
44− ghc-boot, ghci
32+ ,hashable
45− if impl(ghc>= 8.6)
33+ ,haskeline
46− Build-Depends: deferred-folds
34+ ,directory
35+ ,MonadRandom
36+ ,random-shuffle
37+ --critical uuid bug in lesser versions https://www.reddit.com/r/haskell/comments/4myot5/psa_make_sure_to_use_uuid_1312/
38+ ,uuid >= 1.3.12
39+ ,cassava >= 0.5 && < 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
65+ ,path-pieces
66+ ,conduit
67+ ,resourcet
68+ ,http-api-data
69+--needed for remote access
70+ ,distributed-process-client-server >= 0.2.3
71+ ,distributed-process >= 0.6.6
72+ ,distributed-process-extras >= 0.3.2
73+ ,distributed-process-async >= 0.2.4
74+ ,network-transport-tcp
75+ ,network-transport
76+ ,list-t
77+ ,stm-containers >= 0.2.15
78+ ,optparse-applicative
79+ ,Glob
80+--used for hashing the transaction graph file to check for differences
81+ ,cryptohash-sha256
47 Exposed-Modules: ProjectM36.Error,
82 Exposed-Modules: ProjectM36.Error,
48 ProjectM36.Transaction,
83 ProjectM36.Transaction,
49 ProjectM36.TransactionGraph,
84 ProjectM36.TransactionGraph,
@@ -52,9 +87,6 @@ Library
52 ProjectM36.TransactionGraph.Merge,
87 ProjectM36.TransactionGraph.Merge,
53 ProjectM36.TransGraphRelationalExpression,
88 ProjectM36.TransGraphRelationalExpression,
54 ProjectM36.Base,
89 ProjectM36.Base,
55− ProjectM36.Serialise.Base,
56− ProjectM36.Serialise.Error,
57− ProjectM36.DataFrame,
58 ProjectM36.Attribute,
90 ProjectM36.Attribute,
59 ProjectM36.AttributeNames,
91 ProjectM36.AttributeNames,
60 ProjectM36.Tuple,
92 ProjectM36.Tuple,
@@ -63,7 +95,6 @@ Library
63 ProjectM36.AtomFunction,
95 ProjectM36.AtomFunction,
64 ProjectM36.AtomFunctionError,
96 ProjectM36.AtomFunctionError,
65 ProjectM36.ScriptSession,
97 ProjectM36.ScriptSession,
66− ProjectM36.Shortcuts,
67 ProjectM36.DatabaseContextFunction,
98 ProjectM36.DatabaseContextFunction,
68 ProjectM36.DatabaseContextFunctionError,
99 ProjectM36.DatabaseContextFunctionError,
69 ProjectM36.DatabaseContextFunctionUtils,
100 ProjectM36.DatabaseContextFunctionUtils,
@@ -77,35 +108,25 @@ Library
77 ProjectM36.Relation.Show.HTML,
108 ProjectM36.Relation.Show.HTML,
78 ProjectM36.StaticOptimizer,
109 ProjectM36.StaticOptimizer,
79 ProjectM36.Relation.Show.Term,
110 ProjectM36.Relation.Show.Term,
80− ProjectM36.WCWidth,
81 ProjectM36.Relation.Show.CSV,
111 ProjectM36.Relation.Show.CSV,
82 ProjectM36.Relation.Show.Gnuplot,
112 ProjectM36.Relation.Show.Gnuplot,
83 ProjectM36.Relation.Parse.CSV,
113 ProjectM36.Relation.Parse.CSV,
84 ProjectM36.IsomorphicSchema,
114 ProjectM36.IsomorphicSchema,
85 ProjectM36.InclusionDependency,
115 ProjectM36.InclusionDependency,
86− ProjectM36.MerkleHash,
87 ProjectM36.Client,
116 ProjectM36.Client,
88− ProjectM36.Client.Simple,
89 ProjectM36.Persist,
117 ProjectM36.Persist,
90 ProjectM36.AtomType,
118 ProjectM36.AtomType,
91− ProjectM36.AttributeExpr,
92 ProjectM36.AtomFunctions.Basic,
119 ProjectM36.AtomFunctions.Basic,
93 ProjectM36.AtomFunctions.Primitive,
120 ProjectM36.AtomFunctions.Primitive,
94 ProjectM36.Atomable,
121 ProjectM36.Atomable,
95− ProjectM36.Tupleable,
96− ProjectM36.Tupleable.Deriving,
97 ProjectM36.DataConstructorDef,
122 ProjectM36.DataConstructorDef,
98 ProjectM36.DataTypes.Basic,
123 ProjectM36.DataTypes.Basic,
99− ProjectM36.DataTypes.Sorting,
100 ProjectM36.DataTypes.Day,
124 ProjectM36.DataTypes.Day,
101 ProjectM36.DataTypes.DateTime,
125 ProjectM36.DataTypes.DateTime,
102 ProjectM36.DataTypes.Either,
126 ProjectM36.DataTypes.Either,
103 ProjectM36.DataTypes.Maybe,
127 ProjectM36.DataTypes.Maybe,
104 ProjectM36.DataTypes.List,
128 ProjectM36.DataTypes.List,
105− ProjectM36.DataTypes.NonEmptyList,
106 ProjectM36.DataTypes.Primitive,
129 ProjectM36.DataTypes.Primitive,
107− ProjectM36.DataTypes.Interval,
108− ProjectM36.DataTypes.ByteString,
109 ProjectM36.MiscUtils,
130 ProjectM36.MiscUtils,
110 ProjectM36.Notifications,
131 ProjectM36.Notifications,
111 ProjectM36.Relation,
132 ProjectM36.Relation,
@@ -114,42 +135,30 @@ Library
114 ProjectM36.Server.EntryPoints,
135 ProjectM36.Server.EntryPoints,
115 ProjectM36.Server.ParseArgs,
136 ProjectM36.Server.ParseArgs,
116 ProjectM36.Server.RemoteCallTypes,
137 ProjectM36.Server.RemoteCallTypes,
117− ProjectM36.Serialise.AtomFunctionError,
118− ProjectM36.Serialise.DataFrame,
119− ProjectM36.Serialise.DatabaseContextFunctionError,
120− ProjectM36.Serialise.IsomorphicSchema,
121 ProjectM36.Session,
138 ProjectM36.Session,
122 ProjectM36.Sessions,
139 ProjectM36.Sessions,
123 ProjectM36.Transaction.Persist,
140 ProjectM36.Transaction.Persist,
124 ProjectM36.TypeConstructor,
141 ProjectM36.TypeConstructor,
125 ProjectM36.TypeConstructorDef,
142 ProjectM36.TypeConstructorDef,
126− ProjectM36.FileLock,
143+ ProjectM36.FileLock
127− ProjectM36.FSType,
128− ProjectM36.Arbitrary,
129− ProjectM36.GraphRefRelationalExpr,
130− ProjectM36.NormalizeExpr,
131− ProjectM36.TransactionInfo,
132− ProjectM36.WithNameExpr
133− GHC-Options: -Wall -rdynamic
144+ GHC-Options: -Wall
134 if os(windows)
145 if os(windows)
135− Build-Depends: Win32 >= 2.5.4.1
146+ Build-Depends: Win32 >= 2.3
136 Other-Modules: ProjectM36.Win32Handle
147 Other-Modules: ProjectM36.Win32Handle
137 else
148 else
138− --219- too many exported symbols under Windows and GHC 8.4
139− GHC-Options: -rdynamic -fexternal-interpreter
140− C-sources: cbits/DirectoryFsync.c, cbits/darwin_statfs.c
149+ C-sources: cbits/DirectoryFsync.c
141 Build-Depends: unix
150 Build-Depends: unix
142 CC-Options: -fPIC
151 CC-Options: -fPIC
143 Hs-Source-Dirs: ./src/lib
152 Hs-Source-Dirs: ./src/lib
144 Default-Language: Haskell2010
153 Default-Language: Haskell2010
145 Default-Extensions: OverloadedStrings, CPP
154 Default-Extensions: OverloadedStrings, CPP
146− if !flag(stack)
155+ if impl(ghc>= 8)
147− Build-Depends: deferred-folds
156+ build-depends:
157+ ghc-boot
148
158
149Executable tutd
159Executable tutd
150− if flag(haskell-scripting)
151− Build-Depends: ghc >= 8.2 && < 8.11
152 Build-Depends: base >=4.8 && <5.0,
160 Build-Depends: base >=4.8 && <5.0,
161+ ghc >= 7.8 && < 8.3,
153 ghc-paths,
162 ghc-paths,
154 project-m36,
163 project-m36,
155 containers,
164 containers,
@@ -160,14 +169,17 @@ Executable tutd
160 mtl,
169 mtl,
161 uuid,
170 uuid,
162 deepseq-generics,
171 deepseq-generics,
172+ scientific,
163 MonadRandom, MonadRandom,
173 MonadRandom, MonadRandom,
164 vector,
174 vector,
165 text,
175 text,
176+ vector-binary-instances,
166 time,
177 time,
167 hashable-time,
178 hashable-time,
168 bytestring,
179 bytestring,
169 stm,
180 stm,
170 deepseq,
181 deepseq,
182+ binary,
171 data-interval,
183 data-interval,
172 parallel,
184 parallel,
173 cassava,
185 cassava,
@@ -175,28 +187,21 @@ Executable tutd
175 directory,
187 directory,
176 filepath,
188 filepath,
177 temporary,
189 temporary,
178− megaparsec >= 5.2.0 && < 10,
190+ megaparsec >= 6.0.2 && < 7.0,
179 haskeline,
191 haskeline,
180 random, MonadRandom,
192 random, MonadRandom,
181 base64-bytestring,
193 base64-bytestring,
182 optparse-applicative,
194 optparse-applicative,
183 attoparsec,
195 attoparsec,
184− stm-containers >= 1.0.0,
196+ stm-containers,
185− list-t,
197+ 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
195 Other-Modules: TutorialD.Interpreter,
198 Other-Modules: TutorialD.Interpreter,
196 TutorialD.Interpreter.Base,
199 TutorialD.Interpreter.Base,
197 TutorialD.Interpreter.DatabaseContextExpr,
200 TutorialD.Interpreter.DatabaseContextExpr,
198 TutorialD.Interpreter.RODatabaseContextOperator,
201 TutorialD.Interpreter.RODatabaseContextOperator,
199 TutorialD.Interpreter.TransactionGraphOperator,
202 TutorialD.Interpreter.TransactionGraphOperator,
203+-- TutorialD.Interpreter.DataTypes.Interval,
204+ TutorialD.Interpreter.DataTypes.DateTime,
200 TutorialD.Interpreter.Import.BasicExamples,
205 TutorialD.Interpreter.Import.BasicExamples,
201 TutorialD.Interpreter.InformationOperator,
206 TutorialD.Interpreter.InformationOperator,
202 TutorialD.Interpreter.Export.Base,
207 TutorialD.Interpreter.Export.Base,
@@ -210,21 +215,28 @@ Executable tutd
210 TutorialD.Interpreter.SchemaOperator,
215 TutorialD.Interpreter.SchemaOperator,
211 TutorialD.Interpreter.TransGraphRelationalOperator,
216 TutorialD.Interpreter.TransGraphRelationalOperator,
212 TutorialD.Interpreter.SchemaOperator
217 TutorialD.Interpreter.SchemaOperator
213− TutorialD.Printer
214 main-is: TutorialD/tutd.hs
218 main-is: TutorialD/tutd.hs
219+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
215 CC-Options: -fPIC
220 CC-Options: -fPIC
216− GHC-Options: -Wall -threaded
221+ GHC-Options: -Wall
217 Hs-Source-Dirs: ./src/bin
222 Hs-Source-Dirs: ./src/bin
218 Default-Language: Haskell2010
223 Default-Language: Haskell2010
219 Default-Extensions: OverloadedStrings
224 Default-Extensions: OverloadedStrings
225+-- if os(windows)
226+-- Build-Depends: Win32 >= 2.3 && < 2.4
227+-- Other-Modules: ProjectM36.Win32Handle
228+-- else
229+-- C-sources: ProjectM36/DirectoryFsync.c
230+-- Build-Depends: unix
231+
220
232
221Executable project-m36-server
233Executable project-m36-server
222− if flag(haskell-scripting)
223− Build-Depends: ghc >= 8.2 && < 8.11
224 Build-Depends: base,
234 Build-Depends: base,
235+ ghc >= 7.8 && < 8.3,
225 ghc-paths,
236 ghc-paths,
226− transformers,
227 project-m36,
237 project-m36,
238+ binary,
239+ transformers,
228 temporary,
240 temporary,
229 data-interval,
241 data-interval,
230 deepseq,
242 deepseq,
@@ -237,6 +249,7 @@ Executable project-m36-server
237 optparse-applicative,
249 optparse-applicative,
238 hashable-time,
250 hashable-time,
239 time,
251 time,
252+ vector-binary-instances,
240 text,
253 text,
241 deepseq-generics,
254 deepseq-generics,
242 mtl,
255 mtl,
@@ -249,6 +262,7 @@ Executable project-m36-server
249 list-t,
262 list-t,
250 base64-bytestring
263 base64-bytestring
251 Main-Is: ./src/bin/ProjectM36/Server/project-m36-server.hs
264 Main-Is: ./src/bin/ProjectM36/Server/project-m36-server.hs
265+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
252 GHC-Options: -Wall -threaded -rtsopts
266 GHC-Options: -Wall -threaded -rtsopts
253 if flag(profiler)
267 if flag(profiler)
254 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
268 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
@@ -258,257 +272,222 @@ Executable project-m36-server
258Executable bigrel
272Executable bigrel
259 Default-Language: Haskell2010
273 Default-Language: Haskell2010
260 Default-Extensions: OverloadedStrings
274 Default-Extensions: OverloadedStrings
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
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
262 Other-Modules: TutorialD.Interpreter.Base,
276 Other-Modules: TutorialD.Interpreter.Base,
263 TutorialD.Interpreter.DatabaseContextExpr,
277 TutorialD.Interpreter.DatabaseContextExpr,
264 TutorialD.Interpreter.RelationalExpr,
278 TutorialD.Interpreter.RelationalExpr,
265 TutorialD.Interpreter.Types
279 TutorialD.Interpreter.Types
266 main-is: benchmark/bigrel.hs
280 main-is: benchmark/bigrel.hs
267 GHC-Options: -Wall -threaded -rtsopts
281 GHC-Options: -Wall -threaded -rtsopts
282+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
268 HS-Source-Dirs: ./src/bin
283 HS-Source-Dirs: ./src/bin
269 if flag(profiler)
284 if flag(profiler)
270 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
285 GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
271
286
272−Common commontest
287+Test-Suite test-tutoriald
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
275− Default-Extensions: OverloadedStrings
276− GHC-Options: -Wall -threaded
277− Hs-Source-Dirs: test, src/bin
278−
279−Benchmark basic-benchmark
280 Default-Language: Haskell2010
288 Default-Language: Haskell2010
281 Default-Extensions: OverloadedStrings
289 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
304 type: exitcode-stdio-1.0
290 type: exitcode-stdio-1.0
305− main-is: TutorialD/InterpreterTest.hs
291+ main-is: test/TutorialD/Interpreter.hs
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
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
292+ 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
293+ 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
294+ GHC-Options: -Wall
295+ Hs-Source-Dirs: ./src/bin, ., test
296+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
308
297
309Test-Suite test-tutoriald-atomfunctionscript
298Test-Suite test-tutoriald-atomfunctionscript
310− import: commontest
299+ Default-Language: Haskell2010
300+ Default-Extensions: OverloadedStrings
311 type: exitcode-stdio-1.0
301 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
302+ 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
313− main-is: TutorialD/Interpreter/AtomFunctionScript.hs
303+ main-is: test/TutorialD/Interpreter/AtomFunctionScript.hs
304+ Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time
305+ GHC-Options: -Wall
306+ Hs-Source-Dirs: ./src/bin, ./test, .
307+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
314
308
315Test-Suite test-tutoriald-databasecontextfunctionscript
309Test-Suite test-tutoriald-databasecontextfunctionscript
316− import: commontest
310+ Default-Language: Haskell2010
311+ Default-Extensions: OverloadedStrings
317 type: exitcode-stdio-1.0
312 type: exitcode-stdio-1.0
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
313+ 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
319− main-is: TutorialD/Interpreter/DatabaseContextFunctionScript.hs
314+ main-is: test/TutorialD/Interpreter/DatabaseContextFunctionScript.hs
315+ Build-Depends: base, HUnit, project-m36, uuid, containers, megaparsec, text, vector, directory, bytestring, mtl, haskeline, random, MonadRandom, semigroups, time
316+ GHC-Options: -Wall
317+ Hs-Source-Dirs: ./src/bin, ./test, .
318+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
320
319
321Test-Suite test-relation
320Test-Suite test-relation
322− import: commontest
321+ Default-Language: Haskell2010
322+ Default-Extensions: OverloadedStrings
323 type: exitcode-stdio-1.0
323 type: exitcode-stdio-1.0
324− main-is: Relation/Basic.hs
324+ main-is: test/Relation/Basic.hs
325+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36, transformers
326+ GHC-Options: -Wall
325
327
326Test-Suite test-static-optimizer
328Test-Suite test-static-optimizer
327− import: commontest
329+ Default-Language: Haskell2010
330+ Default-Extensions: OverloadedStrings
328 type: exitcode-stdio-1.0
331 type: exitcode-stdio-1.0
329− main-is: Relation/StaticOptimizer.hs
332+ main-is: test/Relation/StaticOptimizer.hs
333+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36, transformers
334+ GHC-Options: -Wall
335+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
330
336
331Test-Suite test-transactiongraph-persist
337Test-Suite test-transactiongraph-persist
332− import: commontest
338+ Default-Language: Haskell2010
339+ Default-Extensions: OverloadedStrings
333 type: exitcode-stdio-1.0
340 type: exitcode-stdio-1.0
334− main-is: TransactionGraph/Persist.hs
341+ main-is: test/TransactionGraph/Persist.hs
342+ 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
335− Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Printer
343+ Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples
344+ Hs-Source-Dirs: ., ./src/bin
345+ GHC-Options: -Wall
336
346
337Test-Suite test-relation-import-csv
347Test-Suite test-relation-import-csv
338− import: commontest
348+ Default-Language: Haskell2010
349+ Default-Extensions: OverloadedStrings
339 type: exitcode-stdio-1.0
350 type: exitcode-stdio-1.0
340− main-is: Relation/Import/CSV.hs
351+ main-is: test/Relation/Import/CSV.hs
352+ 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
353+ GHC-Options: -Wall
354+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
341
355
342Test-Suite test-tutoriald-import-tutoriald
356Test-Suite test-tutoriald-import-tutoriald
343− import: commontest
357+ Default-Language: Haskell2010
358+ Default-Extensions: OverloadedStrings
344 type: exitcode-stdio-1.0
359 type: exitcode-stdio-1.0
345− main-is: TutorialD/Interpreter/Import/ImportTest.hs
360+ main-is: test/TutorialD/Interpreter/Import/TutorialD.hs
361+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, project-m36, random, MonadRandom, semigroups
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
362+ 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
363+ GHC-Options: -Wall
364+ Hs-Source-Dirs: ., ./src/bin
347
365
348Test-Suite test-relation-export-csv
366Test-Suite test-relation-export-csv
349− import: commontest
367+ Default-Language: Haskell2010
368+ Default-Extensions: OverloadedStrings
350 type: exitcode-stdio-1.0
369 type: exitcode-stdio-1.0
351− main-is: Relation/Export/CSV.hs
370+ main-is: test/Relation/Export/CSV.hs
371+ 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
372+ GHC-Options: -Wall
352
373
353Test-Suite test-transactiongraph-merge
374Test-Suite test-transactiongraph-merge
354− import: commontest
375+ Default-Language: Haskell2010
355− type: exitcode-stdio-1.0
376+ Default-Extensions: OverloadedStrings
356− main-is: TransactionGraph/Merge.hs
357−
358−
359−Test-Suite test-prettyprinter
360− import: commontest
361 type: exitcode-stdio-1.0
377 type: exitcode-stdio-1.0
362− main-is: TutorialD/PrinterTest.hs
378+ main-is: test/TransactionGraph/Merge.hs
363− Other-Modules: TutorialD.Printer, TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types
379+ 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
380+ GHC-Options: -Wall
364
381
365benchmark bench
382benchmark bench
366− import: commontest
383+ Default-Language: Haskell2010
384+ Default-Extensions: OverloadedStrings
367 type: exitcode-stdio-1.0
385 type: exitcode-stdio-1.0
368 main-is: benchmark/Relation.hs
386 main-is: benchmark/Relation.hs
387+ 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
388+ GHC-Options: -Wall -rtsopts
389+ Hs-Source-Dirs: ./src/bin
369
390
370Test-Suite test-server
391Test-Suite test-server
371− import: commontest
392+ Default-Language: Haskell2010
393+ Default-Extensions: OverloadedStrings
372 type: exitcode-stdio-1.0
394 type: exitcode-stdio-1.0
373− main-is: Server/Main.hs
395+ main-is: test/Server/Main.hs
374−
396+ 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
397+ HS-Source-Dirs: ., ./src/bin
398+ GHC-Options: -Wall
375
399
376Executable Example-SimpleClient
400Executable Example-SimpleClient
377 Default-Language: Haskell2010
401 Default-Language: Haskell2010
378 Default-Extensions: OverloadedStrings
402 Default-Extensions: OverloadedStrings
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
403+ 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
380 Main-Is: examples/SimpleClient.hs
404 Main-Is: examples/SimpleClient.hs
381− GHC-Options: -Wall -threaded
405+ GHC-Options: -Wall
382
406
383Executable Example-OutOfTheTarpit
407Executable Example-OutOfTheTarpit
384 Default-Language: Haskell2010
408 Default-Language: Haskell2010
385 Default-Extensions: OverloadedStrings
409 Default-Extensions: OverloadedStrings
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
410+ 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
387 Main-Is: examples/out_of_the_tarpit.hs
411 Main-Is: examples/out_of_the_tarpit.hs
388− GHC-Options: -Wall -threaded
412+ GHC-Options: -Wall
389−
413+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
390−Executable Example-Blog
391− Default-Language: Haskell2010
392− Default-Extensions: OverloadedStrings
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
394− Main-Is: examples/blog.hs
395− GHC-Options: -Wall -threaded
396
414
397Executable Example-Hair
415Executable Example-Hair
398 Default-Language: Haskell2010
416 Default-Language: Haskell2010
399 Default-Extensions: OverloadedStrings
417 Default-Extensions: OverloadedStrings
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
418+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, aeson, path-pieces, either, conduit, http-api-data, template-haskell, ghc, ghc-paths, project-m36
401 Main-Is: examples/hair.hs
419 Main-Is: examples/hair.hs
402− GHC-Options: -Wall -threaded
420+ GHC-Options: -Wall
403−
421+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
404−Executable Example-Plantfarm
405− Default-Language: Haskell2010
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
422
411−Executable Example-CustomTupleable
423+Test-Suite test-scripts
412 Default-Language: Haskell2010
424 Default-Language: Haskell2010
413 Default-Extensions: OverloadedStrings
425 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
430 type: exitcode-stdio-1.0
426 type: exitcode-stdio-1.0
431− main-is: scripts.hs
427+ main-is: test/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
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
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
430+ GHC-Options: -Wall
431+ Hs-Source-Dirs: ., ./src/bin
433
432
434Executable project-m36-websocket-server
433Executable project-m36-websocket-server
435 Default-Language: Haskell2010
434 Default-Language: Haskell2010
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
435+ Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, websockets, aeson, uuid-aeson, optparse-applicative, project-m36, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring, random, MonadRandom, time, network-transport-tcp, semigroups
437 Main-Is: ProjectM36/Server/WebSocket/websocket-server.hs
436 Main-Is: ProjectM36/Server/WebSocket/websocket-server.hs
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
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
439− GHC-Options: -Wall -threaded
438+ GHC-Options: -Wall
439+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
440 Hs-Source-Dirs: ./src/bin
440 Hs-Source-Dirs: ./src/bin
441 Default-Extensions: OverloadedStrings
441 Default-Extensions: OverloadedStrings
442
442
443Test-Suite test-websocket-server
443Test-Suite test-websocket-server
444− import: commontest
444+ Default-Language: Haskell2010
445 type: exitcode-stdio-1.0
445 type: exitcode-stdio-1.0
446− main-is: Server/WebSocket.hs
446+ main-is: test/Server/WebSocket.hs
447+ 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, uuid-aeson, project-m36, random, MonadRandom, network-transport-tcp, semigroups, time
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+ 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
449+ Default-Extensions: OverloadedStrings
450+ GHC-Options: -Wall
451+ Hs-Source-Dirs: ./src/bin, .
452+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
448
453
449Test-Suite test-isomorphic-schemas
454Test-Suite test-isomorphic-schemas
450− import: commontest
455+ Default-Language: Haskell2010
451 type: exitcode-stdio-1.0
456 type: exitcode-stdio-1.0
452− main-is: IsomorphicSchema.hs
457+ main-is: test/IsomorphicSchema.hs
458+ 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, uuid-aeson, project-m36
459+ Default-Extensions: OverloadedStrings
460+ GHC-Options: -Wall
461+ Hs-Source-Dirs: ./src/bin, .
462+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
453
463
454Test-Suite test-atomable
464Test-Suite test-atomable
455− import: commontest
465+ Default-Language: Haskell2010
456 type: exitcode-stdio-1.0
466 type: exitcode-stdio-1.0
457− main-is: Relation/Atomable.hs
467+ main-is: test/Relation/Atomable.hs
468+ 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, uuid-aeson, project-m36, random, MonadRandom, semigroups
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
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
470+ Default-Extensions: OverloadedStrings
471+ GHC-Options: -Wall
472+ Hs-Source-Dirs: ./src/bin, ., test/
473+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
459
474
460Test-Suite test-multiprocess-access
475Test-Suite test-multiprocess-access
461− import: commontest
476+ Default-Language: Haskell2010
462 type: exitcode-stdio-1.0
477 type: exitcode-stdio-1.0
463− main-is: MultiProcessDatabaseAccess.hs
478+ main-is: test/MultiProcessDatabaseAccess.hs
479+ 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, uuid-aeson, project-m36, random, MonadRandom
480+ Default-Extensions: OverloadedStrings
481+ GHC-Options: -Wall
482+ Hs-Source-Dirs: ./src/bin, ., test/
483+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
464
484
465Test-Suite test-transactiongraph-automerge
485Test-Suite test-transactiongraph-automerge
466− import: commontest
467− type: exitcode-stdio-1.0
468− main-is: TransactionGraph/Automerge.hs
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
470−
471−Test-Suite test-tupleable
472− import: commontest
473− type: exitcode-stdio-1.0
474− main-is: Relation/Tupleable.hs
475−
476−Test-Suite test-client-simple
477− import: commontest
478− Main-Is: Client/Simple.hs
479− type: exitcode-stdio-1.0
480−
481−-- test for file handle leaks
482−Executable handles
483 Default-Language: Haskell2010
486 Default-Language: Haskell2010
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
505− GHC-Options: -Wall -threaded -rtsopts
506− HS-Source-Dirs: ./src/bin
507− if flag(profiler)
508− GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall
509−
510−Test-Suite test-dataframe
511− import: commontest
512 type: exitcode-stdio-1.0
487 type: exitcode-stdio-1.0
513− Main-Is: DataFrame.hs
488+ main-is: test/TransactionGraph/Automerge.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
489+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, uuid-aeson, project-m36, random, MonadRandom, semigroups
490+ Default-Extensions: OverloadedStrings
491+ GHC-Options: -Wall
492+ Hs-Source-Dirs: ./src/bin, ., test/
493+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
release.nixdeleted−36
@@ -1,36 +0,0 @@
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
1#!/bin/sh
2−~/.cabal/bin/ghcid --command="cabal new-repl $1"
2+./.cabal-sandbox/bin/ghcid --command="cabal repl $1"
scripts/DateExamples.tutd+2−4
@@ -20,7 +20,5 @@ sp := relation{tuple{s# "S1",p# "P1",qty 300},
20 tuple{s# "S3",p# "P2",qty 200},
20 tuple{s# "S3",p# "P2",qty 200},
21 tuple{s# "S4",p# "P4",qty 300},
21 tuple{s# "S4",p# "P4",qty 300},
22 tuple{s# "S4",p# "P5",qty 400}};
22 tuple{s# "S4",p# "P5",qty 400}};
23−key s_pkey {s#} s;
24−key p_key {p#} p;
25−foreign key s_sp_fk sp{s#} in s{s#};
23+foreign key sp2s sp{s#} in s{s#};
26−foreign key p_sp_fk sp{p#} in p{p#};
24+foreign key sp2p sp{p#} in p{p#};
scripts/multiline.tutddeleted−2
@@ -1,2 +0,0 @@
1−x:=relation{
2−tuple{ x 2}} -- nice
shell.nixdeleted−1
@@ -1 +0,0 @@
1−(import ./release.nix { }).shell
src/bin/ProjectM36/Client/Json.hs+1−4
@@ -3,7 +3,6 @@ module ProjectM36.Client.Json where
3import Data.Aeson
3import Data.Aeson
4import ProjectM36.Server.RemoteCallTypes.Json ()
4import ProjectM36.Server.RemoteCallTypes.Json ()
5import ProjectM36.Client
5import ProjectM36.Client
6−import ProjectM36.TransactionGraph
7import Control.Exception (IOException)
6import Control.Exception (IOException)
8
7
9instance ToJSON EvaluatedNotification
8instance ToJSON EvaluatedNotification
@@ -12,6 +11,4 @@ instance FromJSON EvaluatedNotification
12instance ToJSON ConnectionError
11instance ToJSON ConnectionError
13
12
14instance ToJSON IOException where
13instance ToJSON IOException where
15− toJSON err = object ["IOException" .= show err]
14+ toJSON err = object ["IOException" .= show err]
16−
17−instance ToJSON MerkleValidationError
src/bin/ProjectM36/Server/RemoteCallTypes/Json.hs+15−62
@@ -1,19 +1,17 @@
1--create a bunch of orphan instances for use with the websocket server
1--create a bunch of orphan instances for use with the websocket server
2−{-# LANGUAGE FlexibleInstances #-}
2+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
4module ProjectM36.Server.RemoteCallTypes.Json where
4module ProjectM36.Server.RemoteCallTypes.Json where
5−import ProjectM36.AtomFunctionError
5+import ProjectM36.Server.RemoteCallTypes
6import ProjectM36.Base
6import ProjectM36.Base
7−import ProjectM36.DataFrame
8−import ProjectM36.DatabaseContextFunctionError
9−import ProjectM36.DataTypes.Primitive
10import ProjectM36.Error
7import ProjectM36.Error
8+import ProjectM36.DataTypes.Primitive
11import ProjectM36.IsomorphicSchema
9import ProjectM36.IsomorphicSchema
12−import ProjectM36.Server.RemoteCallTypes
10+import ProjectM36.DatabaseContextFunctionError
13−import ProjectM36.MerkleHash
11+import ProjectM36.AtomFunctionError
14−import ProjectM36.Attribute as A
15
12
16import Data.Aeson
13import Data.Aeson
14+import Data.UUID.Aeson ()
17import Data.ByteString.Base64 as B64
15import Data.ByteString.Base64 as B64
18import Data.Text.Encoding
16import Data.Text.Encoding
19import Data.Time.Calendar
17import Data.Time.Calendar
@@ -24,9 +22,6 @@ instance FromJSON RelationalExpr
24instance ToJSON TupleExpr
22instance ToJSON TupleExpr
25instance FromJSON TupleExpr
23instance FromJSON TupleExpr
26
24
27−instance ToJSON TupleExprs
28−instance FromJSON TupleExprs
29−
30instance ToJSON RestrictionPredicateExpr
25instance ToJSON RestrictionPredicateExpr
31instance FromJSON RestrictionPredicateExpr
26instance FromJSON RestrictionPredicateExpr
32
27
@@ -45,11 +40,8 @@ instance FromJSON ExecuteRelationalExpr
45instance ToJSON Relation
40instance ToJSON Relation
46instance FromJSON Relation
41instance FromJSON Relation
47
42
48−instance ToJSON Attribute where
43+instance ToJSON Attribute
49− toJSON (Attribute attrName aType) = object [ "name" .= attrName
50− , "type" .= toJSON aType ]
51−instance FromJSON Attribute where
44+instance FromJSON Attribute
52− parseJSON = withObject "Attribute" $ \v -> Attribute <$> v .: "name" <*> v .: "type"
53
45
54instance ToJSON ExtendTupleExpr
46instance ToJSON ExtendTupleExpr
55instance FromJSON ExtendTupleExpr
47instance FromJSON ExtendTupleExpr
@@ -72,21 +64,7 @@ instance FromJSON SchemaExpr
72instance ToJSON SchemaIsomorph
64instance ToJSON SchemaIsomorph
73instance FromJSON SchemaIsomorph
65instance FromJSON SchemaIsomorph
74
66
75−instance ToJSON DataFrame
67+instance ToJSON Atom where
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−
87−instance ToJSON Atom where
88− toJSON atom@(IntegerAtom i) = object [ "type" .= atomTypeForAtom atom,
89− "val" .= i ]
90 toJSON atom@(IntAtom i) = object [ "type" .= atomTypeForAtom atom,
68 toJSON atom@(IntAtom i) = object [ "type" .= atomTypeForAtom atom,
91 "val" .= i ]
69 "val" .= i ]
92 toJSON atom@(DoubleAtom i) = object [ "type" .= atomTypeForAtom atom,
70 toJSON atom@(DoubleAtom i) = object [ "type" .= atomTypeForAtom atom,
@@ -103,23 +81,22 @@ instance ToJSON Atom where
103 "val" .= i ]
81 "val" .= i ]
104 toJSON atom@(RelationAtom i) = object [ "type" .= atomTypeForAtom atom,
82 toJSON atom@(RelationAtom i) = object [ "type" .= atomTypeForAtom atom,
105 "val" .= i ]
83 "val" .= i ]
106− toJSON atom@(RelationalExprAtom i) = object [ "type" .= atomTypeForAtom atom,
107− "val" .= i ]
108 toJSON (ConstructedAtom dConsName atomtype atomlist) = object [
84 toJSON (ConstructedAtom dConsName atomtype atomlist) = object [
109 "dataconstructorname" .= dConsName,
85 "dataconstructorname" .= dConsName,
110 "type" .= toJSON atomtype,
86 "type" .= toJSON atomtype,
111 "atomlist" .= toJSON atomlist
87 "atomlist" .= toJSON atomlist
112 ]
88 ]
113−
89+
114instance FromJSON Atom where
90instance FromJSON Atom where
115 parseJSON = withObject "atom" $ \o -> do
91 parseJSON = withObject "atom" $ \o -> do
116− atype <- o .: "type"
92+ atype <- o .: "type"
117 case atype of
93 case atype of
118− TypeVariableType _ -> fail "cannot pass TypeVariableType over the wire"
94+ TypeVariableType _ -> fail "cannot pass AnyAtomType over the wire"
119 caType@(ConstructedAtomType _ _) -> ConstructedAtom <$> o .: "dataconstructorname" <*> pure caType <*> o .: "atom"
95 caType@(ConstructedAtomType _ _) -> ConstructedAtom <$> o .: "dataconstructorname" <*> pure caType <*> o .: "atom"
120− RelationAtomType _ -> RelationAtom <$> o .: "val"
96+ RelationAtomType _ -> do
97+ rel <- o .: "val"
98+ pure $ RelationAtom rel
121 IntAtomType -> IntAtom <$> o .: "val"
99 IntAtomType -> IntAtom <$> o .: "val"
122− IntegerAtomType -> IntegerAtom <$> o .: "val"
123 DoubleAtomType -> DoubleAtom <$> o .: "val"
100 DoubleAtomType -> DoubleAtom <$> o .: "val"
124 TextAtomType -> TextAtom <$> o .: "val"
101 TextAtomType -> TextAtom <$> o .: "val"
125 DayAtomType -> do
102 DayAtomType -> do
@@ -132,7 +109,6 @@ instance FromJSON Atom where
132 Left err -> fail ("Failed to parse base64-encoded ByteString: " ++ err)
109 Left err -> fail ("Failed to parse base64-encoded ByteString: " ++ err)
133 Right bs -> pure (ByteStringAtom bs)
110 Right bs -> pure (ByteStringAtom bs)
134 BoolAtomType -> BoolAtom <$> o .: "val"
111 BoolAtomType -> BoolAtom <$> o .: "val"
135− RelationalExprAtomType -> RelationalExprAtom <$> o .: "val"
136
112
137instance ToJSON Notification
113instance ToJSON Notification
138instance FromJSON Notification
114instance FromJSON Notification
@@ -140,21 +116,6 @@ instance FromJSON Notification
140instance ToJSON ScriptCompilationError
116instance ToJSON ScriptCompilationError
141instance FromJSON ScriptCompilationError
117instance FromJSON ScriptCompilationError
142
118
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−
158instance ToJSON RelationalError
119instance ToJSON RelationalError
159instance FromJSON RelationalError
120instance FromJSON RelationalError
160
121
@@ -164,9 +125,6 @@ instance FromJSON SchemaError
164instance ToJSON MergeError
125instance ToJSON MergeError
165instance FromJSON MergeError
126instance FromJSON MergeError
166
127
167−instance ToJSON ImportError'
168−instance FromJSON ImportError'
169−
170instance ToJSON DatabaseContextFunctionError
128instance ToJSON DatabaseContextFunctionError
171instance FromJSON DatabaseContextFunctionError
129instance FromJSON DatabaseContextFunctionError
172
130
@@ -178,8 +136,3 @@ instance FromJSON PersistenceError
178
136
179instance ToJSON AtomFunctionError
137instance ToJSON AtomFunctionError
180instance FromJSON AtomFunctionError
138instance FromJSON AtomFunctionError
181−
182−instance ToJSON WithNameExpr
183−instance FromJSON WithNameExpr
184−
185−
src/bin/ProjectM36/Server/WebSocket.hs+34−86
@@ -1,4 +1,3 @@
1−{-# LANGUAGE LambdaCase, CPP #-}
2module ProjectM36.Server.WebSocket where
1module ProjectM36.Server.WebSocket where
3-- while the tutd client performs TutorialD parsing on the client, the websocket server will pass tutd to be parsed and executed on the server- otherwise I have to pull in ghcjs as a dependency to allow client-side parsing- that's not appealing because then the frontend is not language-agnostic, but this could change in the future, perhaps by sending different messages over the websocket
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
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
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
@@ -10,26 +9,14 @@ import qualified Data.Text as T
10import qualified Network.WebSockets as WS
9import qualified Network.WebSockets as WS
11import ProjectM36.Server.RemoteCallTypes.Json ()
10import ProjectM36.Server.RemoteCallTypes.Json ()
12import ProjectM36.Client.Json ()
11import ProjectM36.Client.Json ()
13−import ProjectM36.DataFrame
14−import ProjectM36.Relation.Show.Term
15−import ProjectM36.Relation.Show.HTML
16import Data.Aeson
12import Data.Aeson
17import TutorialD.Interpreter
13import TutorialD.Interpreter
18−import TutorialD.Interpreter.Base (TutorialDOperatorResult(..))
14+import TutorialD.Interpreter.Base
19import ProjectM36.Client
15import ProjectM36.Client
20import Control.Exception
16import 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
30
17
31websocketProxyServer :: Port -> Hostname -> WS.ServerApp
18websocketProxyServer :: Port -> Hostname -> WS.ServerApp
32−websocketProxyServer port host pending = do
19+websocketProxyServer port host pending = do
33 conn <- WS.acceptRequest pending
20 conn <- WS.acceptRequest pending
34 let unexpectedMsg = WS.sendTextData conn ("messagenotexpected" :: T.Text)
21 let unexpectedMsg = WS.sendTextData conn ("messagenotexpected" :: T.Text)
35 --phase 1- accept database name for connection
22 --phase 1- accept database name for connection
@@ -38,10 +25,11 @@ websocketProxyServer port host pending = do
38 if not (connectdbmsg `T.isPrefixOf` dbmsg) then unexpectedMsg >> WS.sendClose conn ("" :: T.Text)
25 if not (connectdbmsg `T.isPrefixOf` dbmsg) then unexpectedMsg >> WS.sendClose conn ("" :: T.Text)
39 else do
26 else do
40 let dbname = T.unpack $ T.drop (T.length connectdbmsg) dbmsg
27 let dbname = T.unpack $ T.drop (T.length connectdbmsg) dbmsg
41− bracket (createConnection conn dbname port host)
28+ bracket (createConnection conn dbname port host)
42− (\case
29+ (\eDBconn -> case eDBconn of
43− Right dbconn -> close dbconn
30+ Right dbconn -> close dbconn
44− Left _ -> pure ()) $ \case
31+ Left _ -> pure ()) $ \eDBconn ->
32+ case eDBconn of
45 Left err -> sendError conn err
33 Left err -> sendError conn err
46 Right dbconn -> do
34 Right dbconn -> do
47 eSessionId <- createSessionAtHead dbconn "master"
35 eSessionId <- createSessionAtHead dbconn "master"
@@ -52,95 +40,55 @@ websocketProxyServer port host pending = do
52 _ <- forever $ do
40 _ <- forever $ do
53 pInfo <- promptInfo sessionId dbconn
41 pInfo <- promptInfo sessionId dbconn
54 --figure out why sending three times during startup is necessary
42 --figure out why sending three times during startup is necessary
55− sendPromptInfo pInfo conn
43+ sendPromptInfo pInfo conn
56 sendPromptInfo pInfo conn
44 sendPromptInfo pInfo conn
57 msg <- WS.receiveData conn :: IO T.Text
45 msg <- WS.receiveData conn :: IO T.Text
58− case parseOnly parseExecuteMessage msg of
46+ let tutdprefix = "executetutd:"
59− Left _ -> unexpectedMsg
47+ case msg of
60− Right (presentation, tutdString) ->
48+ _ | tutdprefix `T.isPrefixOf` msg -> do
49+ let tutdString = T.drop (T.length tutdprefix) msg
61 case parseTutorialD tutdString of
50 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
68− (DisplayErrorResult ("parse error: " `T.append` T.pack (parseErrorPretty err)))
51+ Left err -> handleOpResult conn dbconn (DisplayErrorResult ("parse error: " `T.append` T.pack (show err)))
69−#endif
70 Right parsed -> do
52 Right parsed -> do
71− let timeoutFilter exc = if exc == RequestTimeoutException
53+ let timeoutFilter exc = if exc == RequestTimeoutException
72− then Just exc
54+ then Just exc
73 else Nothing
55 else Nothing
74 responseHandler = do
56 responseHandler = do
75 result <- evalTutorialD sessionId dbconn SafeEvaluation parsed
57 result <- evalTutorialD sessionId dbconn SafeEvaluation parsed
76 pInfo' <- promptInfo sessionId dbconn
58 pInfo' <- promptInfo sessionId dbconn
77− sendPromptInfo pInfo' conn
59+ sendPromptInfo pInfo' conn
78− handleOpResult conn dbconn presentation result
60+ handleOpResult conn dbconn result
79− catchJust timeoutFilter responseHandler (\_ -> handleOpResult conn dbconn presentation (DisplayErrorResult "Request Timed Out."))
61+ catchJust timeoutFilter responseHandler (\_ -> handleOpResult conn dbconn (DisplayErrorResult "Request Timed Out."))
62+ _ -> unexpectedMsg
80 pure ()
63 pure ()
81−
64+
82−notificationCallback :: WS.Connection -> NotificationCallback
65+notificationCallback :: WS.Connection -> NotificationCallback
83notificationCallback conn notifName evaldNotif = WS.sendTextData conn (encode (object ["notificationname" .= notifName,
66notificationCallback conn notifName evaldNotif = WS.sendTextData conn (encode (object ["notificationname" .= notifName,
84 "evaldnotification" .= evaldNotif
67 "evaldnotification" .= evaldNotif
85 ]))
68 ]))
86−
69+
87--this creates a new database for each connection- perhaps not what we want (?)
70--this creates a new database for each connection- perhaps not what we want (?)
88createConnection :: WS.Connection -> DatabaseName -> Port -> Hostname -> IO (Either ConnectionError Connection)
71createConnection :: WS.Connection -> DatabaseName -> Port -> Hostname -> IO (Either ConnectionError Connection)
89−createConnection wsconn dbname port host = connectProjectM36 (RemoteConnectionInfo dbname host (show port) (notificationCallback wsconn))
72+createConnection wsconn dbname port host = connectProjectM36 (RemoteProcessConnectionInfo dbname (createNodeId host port) (notificationCallback wsconn))
90
73
91sendError :: (ToJSON a) => WS.Connection -> a -> IO ()
74sendError :: (ToJSON a) => WS.Connection -> a -> IO ()
92sendError conn err = WS.sendTextData conn (encode (object ["displayerror" .= err]))
75sendError conn err = WS.sendTextData conn (encode (object ["displayerror" .= err]))
93
76
94−handleOpResult :: WS.Connection -> Connection -> Presentation -> TutorialDOperatorResult -> IO ()
77+handleOpResult :: WS.Connection -> Connection -> TutorialDOperatorResult -> IO ()
95−handleOpResult conn db _ QuitResult = WS.sendClose conn ("close" :: T.Text) >> close db
78+handleOpResult conn db QuitResult = WS.sendClose conn ("close" :: T.Text) >> close db
96−handleOpResult conn _ _ (DisplayResult out) = WS.sendTextData conn (encode (object ["display" .= out]))
79+handleOpResult conn _ (DisplayResult out) = WS.sendTextData conn (encode (object ["display" .= out]))
97−handleOpResult _ _ _ (DisplayIOResult ioout) = ioout
80+handleOpResult _ _ (DisplayIOResult ioout) = ioout
98−handleOpResult conn _ presentation (DisplayErrorResult err) = do
81+handleOpResult conn _ (DisplayErrorResult err) = WS.sendTextData conn (encode (object ["displayerror" .= err]))
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)]))
103−handleOpResult conn _ _ (DisplayParseErrorResult _ err) = WS.sendTextData conn (encode (object ["displayparseerrorresult" .= show err]))
82+handleOpResult conn _ (DisplayParseErrorResult _ err) = WS.sendTextData conn (encode (object ["displayparseerrorresult" .= show err]))
104−handleOpResult conn _ _ QuietSuccessResult = WS.sendTextData conn (encode (object ["acknowledged" .= True]))
83+handleOpResult conn _ QuietSuccessResult = WS.sendTextData conn (encode (object ["acknowledged" .= True]))
105−handleOpResult conn _ presentation (DisplayRelationResult rel) = do
84+handleOpResult conn _ (DisplayRelationResult rel) = WS.sendTextData conn (encode (object ["displayrelation" .= rel]))
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
85
116-- get current schema and head name for client
86-- get current schema and head name for client
117promptInfo :: SessionId -> Connection -> IO (HeadName, SchemaName)
87promptInfo :: SessionId -> Connection -> IO (HeadName, SchemaName)
118promptInfo sessionId conn = do
88promptInfo sessionId conn = do
119− eHeadName <- headName sessionId conn
89+ eHeadName <- headName sessionId conn
120 eSchemaName <- currentSchemaName sessionId conn
90 eSchemaName <- currentSchemaName sessionId conn
121− pure (fromRight "<unknown>" eHeadName, fromRight "<no schema>" eSchemaName)
91+ pure (either (const "<unknown>") id eHeadName, either (const "<no schema>") id eSchemaName)
122−
92+
123sendPromptInfo :: (HeadName, SchemaName) -> WS.Connection -> IO ()
93sendPromptInfo :: (HeadName, SchemaName) -> WS.Connection -> IO ()
124sendPromptInfo (hName, sName) conn = WS.sendTextData conn (encode (object ["promptInfo" .= object ["headname" .= hName, "schemaname" .= sName]]))
94sendPromptInfo (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+8−55
@@ -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).
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.
11* @param {closeCallback} closeCallback - A function called once the connection is closed.
12*/
12*/
13−var ProjectM36Connection = function (protocol, host, port, path, dbname, openCallback, errorCallback, statusCallback, promptCallback, notificationCallback, closeCallback) {
13+var ProjectM36Connection = function (protocol, host, port, path, dbname, openCallback, errorCallback, statusCallback, promptCallback, closeCallback) {
14 this.protocol = protocol;
14 this.protocol = protocol;
15 this.host = host;
15 this.host = host;
16 this.port = port;
16 this.port = port;
@@ -44,7 +44,6 @@ var ProjectM36Connection = function (protocol, host, port, path, dbname, openCal
44 };
44 };
45 this.statuscallback = statusCallback;
45 this.statuscallback = statusCallback;
46 this.promptcallback = promptCallback;
46 this.promptcallback = promptCallback;
47− this.notificationcallback = notificationCallback;
48 this.socket = socket;
47 this.socket = socket;
49}
48}
50
49
@@ -55,10 +54,9 @@ var ProjectM36Connection = function (protocol, host, port, path, dbname, openCal
55* @param {Object} acknowledgementresult - The status update containing an acknowledgement that the query was executed or null.
54* @param {Object} acknowledgementresult - The status update containing an acknowledgement that the query was executed or null.
56* @param {Object} errorResult - The status update containing the error information or null.
55* @param {Object} errorResult - The status update containing the error information or null.
57*/
56*/
58−var ProjectM36Status = function (relationResult, dataFrameResult, acknowledgementResult, errorResult)
57+var ProjectM36Status = function (relationResult, acknowledgementResult, errorResult)
59{
58{
60 this.relation = relationResult;
59 this.relation = relationResult;
61− this.dataframe = dataFrameResult;
62 this.acknowledgement = acknowledgementResult;
60 this.acknowledgement = acknowledgementResult;
63 this.error = errorResult;
61 this.error = errorResult;
64}
62}
@@ -76,25 +74,18 @@ ProjectM36Connection.prototype.readyState = function()
76ProjectM36Connection.prototype.handleResponse = function(message)
74ProjectM36Connection.prototype.handleResponse = function(message)
77{
75{
78 var relation = message["displayrelation"];
76 var relation = message["displayrelation"];
79− var dataframe = message["displaydataframe"];
80 var acknowledged = message["acknowledged"];
77 var acknowledged = message["acknowledged"];
81 var error = message["displayerror"];
78 var error = message["displayerror"];
82 var prompt = message["promptInfo"];
79 var prompt = message["promptInfo"];
83− var notification = message["notificationname"]
84
80
85 if(relation)
81 if(relation)
86 {
82 {
87− this.statuscallback(new ProjectM36Status(relation['json'], null, null, null));
83+ this.statuscallback(new ProjectM36Status(relation, null, null));
88− }
89−
90− if(dataframe)
91− {
92− this.statuscallback(new ProjectM36Status(null, dataframe['json'], null, null));
93 }
84 }
94
85
95 if(acknowledged)
86 if(acknowledged)
96 {
87 {
97− this.statuscallback(new ProjectM36Status(null, null, true, null));
88+ this.statuscallback(new ProjectM36Status(null, true, null));
98 }
89 }
99
90
100 if(error)
91 if(error)
@@ -103,19 +94,13 @@ ProjectM36Connection.prototype.handleResponse = function(message)
103 {
94 {
104 error=error.tag; // for error objects
95 error=error.tag; // for error objects
105 }
96 }
106− this.statuscallback(new ProjectM36Status(null, null, null, error['json']));
97+ this.statuscallback(new ProjectM36Status(null, null, error));
107 }
98 }
108
99
109 if(prompt)
100 if(prompt)
110 {
101 {
111 this.promptcallback(prompt["headname"], prompt["schemaname"]);
102 this.promptcallback(prompt["headname"], prompt["schemaname"]);
112 }
103 }
113−
114− if(notification)
115− {
116− var evaldnotif = message.evaldnotification;
117− this.notificationcallback(message.notificationname, evaldnotif);
118− }
119}
104}
120
105
121/**
106/**
@@ -124,7 +109,7 @@ ProjectM36Connection.prototype.handleResponse = function(message)
124*/
109*/
125ProjectM36Connection.prototype.executeTutorialD = function(tutd)
110ProjectM36Connection.prototype.executeTutorialD = function(tutd)
126{
111{
127− this.socket.send("executetutd/json:" + tutd);
112+ this.socket.send("executetutd:" + tutd);
128}
113}
129
114
130/**
115/**
@@ -168,7 +153,6 @@ ProjectM36Connection.prototype.generateAtomType = function(attr)
168{
153{
169 var atomType = attr[1]["tag"];
154 var atomType = attr[1]["tag"];
170 var attrName = attr[0];
155 var attrName = attr[0];
171− var accessory = attr[2];
172 var element = document.createElement("span");
156 var element = document.createElement("span");
173 element.textContent = attrName + "::";
157 element.textContent = attrName + "::";
174 if (atomType == "RelationAtomType")
158 if (atomType == "RelationAtomType")
@@ -193,11 +177,7 @@ ProjectM36Connection.prototype.generateAtomType = function(attr)
193 var readableType = atomType.slice(0,-8);
177 var readableType = atomType.slice(0,-8);
194 element.textContent += readableType;
178 element.textContent += readableType;
195 }
179 }
196− if(accessory)
197− {
198− element.textContent += accessory;
199− }
200− return element;
180+ return element
201}
181}
202
182
203ProjectM36Connection.prototype.generateRelationBody = function (body)
183ProjectM36Connection.prototype.generateRelationBody = function (body)
@@ -242,33 +222,6 @@ ProjectM36Connection.prototype.generateAtom = function(atom)
242 return element;
222 return element;
243}
223}
244
224
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−
272//special case to make sure that a table appears for "true" and "false"
225//special case to make sure that a table appears for "true" and "false"
273function mungeEmptyRows()
226function mungeEmptyRows()
274{
227{
@@ -288,4 +241,4 @@ function mungeEmptyRows()
288 empty.appendChild(dudHeader);
241 empty.appendChild(dudHeader);
289 }
242 }
290 }
243 }
291−}
244+}
src/bin/ProjectM36/Server/WebSocket/websocket-client.html+2−3
@@ -108,7 +108,7 @@ margin-bottom: 5pt;
108 <option value="ws">ws://</option>
108 <option value="ws">ws://</option>
109 </select>
109 </select>
110 <input type="text" name="host" value="localhost" placeholder="Host"/>:
110 <input type="text" name="host" value="localhost" placeholder="Host"/>:
111− <input id="port" type="number" placeholder="Port" name="port" min="0" max="65535" value="8888"/>/
111+ <input id="port" type="number" placeholder="Port" name="port" min="0" max="32767" value="8888"/>/
112 <input type="text" name="path" placeholder="path" value=""/>
112 <input type="text" name="path" placeholder="path" value=""/>
113 <label>database:</label><input type="text" placeholder="Database Name" name="dbname" value="test"/>
113 <label>database:</label><input type="text" placeholder="Database Name" name="dbname" value="test"/>
114 <input type="submit" name="connect" value="Connect"/>
114 <input type="submit" name="connect" value="Connect"/>
@@ -123,10 +123,9 @@ 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>
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>
124</span>
125 <ul id="samples">
125 <ul id="samples">
126− <li>:showrelvars</li>
127 <li>:showexpr true</li>
126 <li>:showexpr true</li>
128 <li>:showexpr false</li>
127 <li>:showexpr false</li>
129− <li>:importexample cjdate</li>
128+ <li>:importexample date</li>
130 <li>:showexpr s join sp</li>
129 <li>:showexpr s join sp</li>
131 <li>update s where city=&quot;Paris&quot; (status:=10)</li>
130 <li>update s where city=&quot;Paris&quot; (status:=10)</li>
132 <li>:showexpr s</li>
131 <li>:showexpr s</li>
src/bin/ProjectM36/Server/WebSocket/websocket-client.js+1−50
@@ -30,12 +30,6 @@ function updateStatus(status)
30 appendResult(tutd, relastable);
30 appendResult(tutd, relastable);
31 mungeEmptyRows();
31 mungeEmptyRows();
32 }
32 }
33− if(status.dataframe)
34− {
35− var dataframeastable = conn.generateDataFrame(status.dataframe);
36− appendResult(tutd, dataframeastable);
37− mungeEmptyRows();
38− }
39 if(status.acknowledgement)
33 if(status.acknowledgement)
40 {
34 {
41 var ok = document.createElement("span");
35 var ok = document.createElement("span");
@@ -55,48 +49,6 @@ function promptUpdate(headName, schemaName)
55 document.getElementById("promptinfo").textContent = "Current Branch: (" + headName + ") Schema: (" + schemaName + ")";
49 document.getElementById("promptinfo").textContent = "Current Branch: (" + headName + ") Schema: (" + schemaName + ")";
56}
50}
57
51
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−
100var conn;
52var conn;
101
53
102function connectOrDisconnect(form)
54function connectOrDisconnect(form)
@@ -130,7 +82,6 @@ function connectOrDisconnect(form)
130 connectionError,
82 connectionError,
131 updateStatus,
83 updateStatus,
132 promptUpdate,
84 promptUpdate,
133− notificationUpdate,
134 connectionClosed);
85 connectionClosed);
135 toggleConnectionFields(form, false, "Connecting...");
86 toggleConnectionFields(form, false, "Connecting...");
136 }
87 }
@@ -259,4 +210,4 @@ function pageload()
259{
210{
260 installSampleHandlers();
211 installSampleHandlers();
261 setupDefaultConfig();
212 setupDefaultConfig();
262−}
213+}
src/bin/ProjectM36/Server/WebSocket/websocket-server.hs+12−49
@@ -1,63 +1,26 @@
1−{-# LANGUAGE CPP #-}
2−
3−import Control.Concurrent
4−import 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
1+import ProjectM36.Server.WebSocket
16import ProjectM36.Server.Config
2import ProjectM36.Server.Config
17import ProjectM36.Server.ParseArgs
3import ProjectM36.Server.ParseArgs
18−import ProjectM36.Server.WebSocket
4+import ProjectM36.Server
5+import Control.Concurrent
6+import qualified Network.WebSockets as WS
7+import Network.Transport.TCP (decodeEndPointAddress)
8+import Control.Exception
19
9
20main :: IO ()
10main :: IO ()
21main = do
11main = do
22 -- launch normal project-m36-server
12 -- launch normal project-m36-server
23 addressMVar <- newEmptyMVar
13 addressMVar <- newEmptyMVar
24− wsConfig <- parseWSConfigWithDefaults (defaultServerConfig {bindPort = 8000, bindHost = "127.0.0.1"})
14+ serverConfig <- parseConfigWithDefaults (defaultServerConfig { bindPort = 8000, bindHost = "127.0.0.1" })
25−
26 --usurp the serverConfig for our websocket server and make the proxied server run locally
15 --usurp the serverConfig for our websocket server and make the proxied server run locally
27− let serverConfig = wsServerConfig wsConfig
28− wsHost = bindHost serverConfig
16+ let wsHost = bindHost serverConfig
29 wsPort = bindPort serverConfig
17 wsPort = bindPort serverConfig
30 serverHost = "127.0.0.1"
18 serverHost = "127.0.0.1"
31 serverConfig' = serverConfig {bindPort = 0, bindHost = serverHost}
19 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−
38 _ <- forkFinally (launchServer serverConfig' (Just addressMVar) >> pure ()) (either throwIO pure)
20 _ <- forkFinally (launchServer serverConfig' (Just addressMVar) >> pure ()) (either throwIO pure)
39 --wait for server to be listening
21 --wait for server to be listening
40− addr <- takeMVar addressMVar
22+ address <- takeMVar addressMVar
41− let port =
23+ let Just (_, serverPort, _) = decodeEndPointAddress address
42− case addr of
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
43− SockAddrInet port' _ -> fromIntegral port'
25+ WS.runServer wsHost (fromIntegral wsPort) (websocketProxyServer (read serverPort) serverHost)
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"
55
26
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+49−112
@@ -1,4 +1,4 @@
1−{-# LANGUAGE GADTs, LambdaCase, CPP #-}
1+{-# LANGUAGE GADTs #-}
2module TutorialD.Interpreter where
2module TutorialD.Interpreter where
3import TutorialD.Interpreter.Base
3import TutorialD.Interpreter.Base
4import TutorialD.Interpreter.RODatabaseContextOperator
4import TutorialD.Interpreter.RODatabaseContextOperator
@@ -24,17 +24,14 @@ import ProjectM36.TransactionGraph
24import qualified ProjectM36.Client as C
24import qualified ProjectM36.Client as C
25import ProjectM36.Relation (attributes)
25import ProjectM36.Relation (attributes)
26
26
27+import Text.Megaparsec
27import System.Console.Haskeline
28import System.Console.Haskeline
28import System.Directory (getHomeDirectory)
29import System.Directory (getHomeDirectory)
29import qualified Data.Text as T
30import qualified Data.Text as T
30import System.IO (hPutStrLn, stderr)
31import System.IO (hPutStrLn, stderr)
31−#if __GLASGOW_HASKELL__ < 804
32import Data.Monoid
32import Data.Monoid
33−#endif
34−import Data.List (isPrefixOf)
35import Control.Exception
33import Control.Exception
36−import System.Exit
34+import Data.Void
37−import Data.Either (fromRight)
38
35
39{-
36{-
40context ops are read-only operations which only operate on the database context (relvars and constraints)
37context ops are read-only operations which only operate on the database context (relvars and constraints)
@@ -46,7 +43,6 @@ data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |
46 DatabaseContextIOExprOp DatabaseContextIOExpr |
43 DatabaseContextIOExprOp DatabaseContextIOExpr |
47 InfoOp InformationOperator |
44 InfoOp InformationOperator |
48 GraphOp TransactionGraphOperator |
45 GraphOp TransactionGraphOperator |
49− ConvenienceGraphOp ConvenienceTransactionGraphOperator |
50 ROGraphOp ROTransactionGraphOperator |
46 ROGraphOp ROTransactionGraphOperator |
51 ImportRelVarOp RelVarDataImportOperator |
47 ImportRelVarOp RelVarDataImportOperator |
52 ImportDBContextOp DatabaseContextDataImportOperator |
48 ImportDBContextOp DatabaseContextDataImportOperator |
@@ -62,13 +58,12 @@ interpreterParserP = safeInterpreterParserP <|>
62 fmap ImportDBContextOp (tutdImportP <* eof) <|>
58 fmap ImportDBContextOp (tutdImportP <* eof) <|>
63 fmap RelVarExportOp (exportCSVP <* eof) <|>
59 fmap RelVarExportOp (exportCSVP <* eof) <|>
64 fmap DatabaseContextIOExprOp (dbContextIOExprP <* eof)
60 fmap DatabaseContextIOExprOp (dbContextIOExprP <* eof)
65−
61+
66-- the safe interpreter never reads or writes the file system
62-- the safe interpreter never reads or writes the file system
67safeInterpreterParserP :: Parser ParsedOperation
63safeInterpreterParserP :: Parser ParsedOperation
68safeInterpreterParserP = fmap RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>
64safeInterpreterParserP = fmap RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>
69 fmap InfoOp (infoOpP <* eof) <|>
65 fmap InfoOp (infoOpP <* eof) <|>
70 fmap GraphOp (transactionGraphOpP <* eof) <|>
66 fmap GraphOp (transactionGraphOpP <* eof) <|>
71− fmap ConvenienceGraphOp (convenienceTransactionGraphOpP <* eof) <|>
72 fmap ROGraphOp (roTransactionGraphOpP <* eof) <|>
67 fmap ROGraphOp (roTransactionGraphOpP <* eof) <|>
73 fmap DatabaseContextExprOp (databaseExprOpP <* eof) <|>
68 fmap DatabaseContextExprOp (databaseExprOpP <* eof) <|>
74 fmap ImportBasicExampleOp (importBasicExampleOperatorP <* eof) <|>
69 fmap ImportBasicExampleOp (importBasicExampleOperatorP <* eof) <|>
@@ -78,86 +73,47 @@ safeInterpreterParserP = fmap RODatabaseContextOp (roDatabaseContextOperatorP <*
78promptText :: Either RelationalError HeadName -> Either RelationalError SchemaName -> StringType
73promptText :: Either RelationalError HeadName -> Either RelationalError SchemaName -> StringType
79promptText eHeadName eSchemaName = "TutorialD (" <> transInfo <> "): "
74promptText eHeadName eSchemaName = "TutorialD (" <> transInfo <> "): "
80 where
75 where
81− transInfo = fromRight "<unknown>" eHeadName <> "/" <> fromRight "<no schema>" eSchemaName
76+ transInfo = either (const "<unknown>") id eHeadName <> "/" <> either (const "<no schema>") id eSchemaName
82−
77+
83−parseTutorialD :: T.Text -> Either ParserError ParsedOperation
78+parseTutorialD :: T.Text -> Either (ParseError Char Void) ParsedOperation
84parseTutorialD = parse interpreterParserP ""
79parseTutorialD = parse interpreterParserP ""
85
80
86--only parse tutoriald which doesn't result in file I/O
81--only parse tutoriald which doesn't result in file I/O
87−safeParseTutorialD :: T.Text -> Either ParserError ParsedOperation
82+safeParseTutorialD :: T.Text -> Either (ParseError Char Void) ParsedOperation
88safeParseTutorialD = parse safeInterpreterParserP ""
83safeParseTutorialD = parse safeInterpreterParserP ""
89
84
90data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)
85data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)
91
86
92−type InteractiveConsole = Bool
93−
94−evalTutorialD :: C.SessionId -> C.Connection -> SafeEvaluationFlag -> ParsedOperation -> IO TutorialDOperatorResult
95−evalTutorialD sessionId conn safe = evalTutorialDInteractive sessionId conn safe False
96−
97--execute the operation and display result
87--execute the operation and display result
98−evalTutorialDInteractive :: C.SessionId -> C.Connection -> SafeEvaluationFlag -> InteractiveConsole -> ParsedOperation -> IO TutorialDOperatorResult
88+evalTutorialD :: C.SessionId -> C.Connection -> SafeEvaluationFlag -> ParsedOperation -> IO TutorialDOperatorResult
99−evalTutorialDInteractive sessionId conn safe interactive expr = case expr of
89+evalTutorialD sessionId conn safe expr = case expr of
100 --this does not pass through the ProjectM36.Client library because the operations
90 --this does not pass through the ProjectM36.Client library because the operations
101 --are specific to the interpreter, though some operations may be of general use in the future
91 --are specific to the interpreter, though some operations may be of general use in the future
102− (RODatabaseContextOp execOp) -> do
92+ (RODatabaseContextOp execOp) ->
103− res <- evalRODatabaseContextOp sessionId conn execOp
93+ evalRODatabaseContextOp sessionId conn execOp
104− case res of
94+
105− QuitResult -> if safe == UnsafeEvaluation && interactive then
106− putStrLn "Goodbye." >> exitSuccess
107− else
108− pure res
109− _ -> pure res
110−
111− (DatabaseContextExprOp execOp) ->
95+ (DatabaseContextExprOp execOp) ->
112− eHandler $ C.executeDatabaseContextExpr sessionId conn execOp
96+ eHandler $ C.executeDatabaseContextExpr sessionId conn execOp
113−
97+
114− (DatabaseContextIOExprOp execOp) ->
98+ (DatabaseContextIOExprOp execOp) ->
115 if needsSafe then
99 if needsSafe then
116 unsafeError
100 unsafeError
117 else
101 else
118 eHandler $ C.executeDatabaseContextIOExpr sessionId conn execOp
102 eHandler $ C.executeDatabaseContextIOExpr sessionId conn execOp
119−
103+
120− (GraphOp execOp) -> do
104+ (GraphOp execOp) ->
121− -- warn if the graph op could cause uncommited changes to be discarded
122− eIsDirty <- C.disconnectedTransactionIsDirty sessionId conn
123− let runGraphOp = eHandler $ C.executeGraphExpr sessionId conn execOp
105+ eHandler $ C.executeGraphExpr sessionId conn execOp
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−
148− (ConvenienceGraphOp execOp) ->
149− eHandler $ evalConvenienceGraphOp sessionId conn execOp
150
106
151 (ROGraphOp execOp) -> do
107 (ROGraphOp execOp) -> do
152 opResult <- evalROGraphOp sessionId conn execOp
108 opResult <- evalROGraphOp sessionId conn execOp
153− case opResult of
109+ case opResult of
154 Left err -> barf err
110 Left err -> barf err
155 Right rel -> pure (DisplayRelationResult rel)
111 Right rel -> pure (DisplayRelationResult rel)
156−
112+
157 (SchemaOp execOp) ->
113 (SchemaOp execOp) ->
158 eHandler $ evalSchemaOperator sessionId conn execOp
114 eHandler $ evalSchemaOperator sessionId conn execOp
159−
115+
160− (ImportRelVarOp execOp@(RelVarDataImportOperator relVarName _ _)) ->
116+ (ImportRelVarOp execOp@(RelVarDataImportOperator relVarName _ _)) ->
161 if needsSafe then
117 if needsSafe then
162 unsafeError
118 unsafeError
163 else do
119 else do
@@ -167,16 +123,12 @@ evalTutorialDInteractive sessionId conn safe interactive expr = case expr of
167 case eImportType of
123 case eImportType of
168 Left err -> barf err
124 Left err -> barf err
169 Right importType -> do
125 Right importType -> do
170− eTConsMap <- C.typeConstructorMapping sessionId conn
126+ exprErr <- evalRelVarDataImportOperator execOp (attributes importType)
171− case eTConsMap of
127+ case exprErr of
172 Left err -> barf err
128 Left err -> barf err
173− Right tConsMap -> do
174− exprErr <- evalRelVarDataImportOperator execOp tConsMap (attributes importType)
175− case exprErr of
176− Left err -> barf err
177− Right dbexpr -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexpr)
129+ Right dbexpr -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexpr)
178−
130+
179− (ImportDBContextOp execOp) ->
131+ (ImportDBContextOp execOp) ->
180 if needsSafe then
132 if needsSafe then
181 unsafeError
133 unsafeError
182 else do
134 else do
@@ -184,15 +136,15 @@ evalTutorialDInteractive sessionId conn safe interactive expr = case expr of
184 case eErr of
136 case eErr of
185 Left err -> barf err
137 Left err -> barf err
186 Right dbexprs -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexprs)
138 Right dbexprs -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexprs)
187−
139+
188− (InfoOp execOp) ->
140+ (InfoOp execOp) ->
189 if needsSafe then
141 if needsSafe then
190 unsafeError
142 unsafeError
191 else
143 else
192 case evalInformationOperator execOp of
144 case evalInformationOperator execOp of
193 Left err -> pure (DisplayErrorResult err)
145 Left err -> pure (DisplayErrorResult err)
194 Right info -> pure (DisplayResult info)
146 Right info -> pure (DisplayResult info)
195−
147+
196 (RelVarExportOp execOp@(RelVarDataExportOperator relExpr _ _)) ->
148 (RelVarExportOp execOp@(RelVarDataExportOperator relExpr _ _)) ->
197 --eval relexpr to relation and pass to export function
149 --eval relexpr to relation and pass to export function
198 if needsSafe then
150 if needsSafe then
@@ -216,29 +168,24 @@ evalTutorialDInteractive sessionId conn safe interactive expr = case expr of
216 unsafeError = pure $ DisplayErrorResult "File I/O operation prohibited."
168 unsafeError = pure $ DisplayErrorResult "File I/O operation prohibited."
217 barf :: RelationalError -> IO TutorialDOperatorResult
169 barf :: RelationalError -> IO TutorialDOperatorResult
218 barf (ScriptError (OtherScriptCompilationError errStr)) = pure (DisplayErrorResult (T.pack errStr))
170 barf (ScriptError (OtherScriptCompilationError errStr)) = pure (DisplayErrorResult (T.pack errStr))
219− barf (ParseError err) = pure (DisplayErrorResult err)
220 barf err = return $ DisplayErrorResult (T.pack (show err))
171 barf err = return $ DisplayErrorResult (T.pack (show err))
221 eHandler io = do
172 eHandler io = do
222 eErr <- io
173 eErr <- io
223 case eErr of
174 case eErr of
224 Left err -> barf err
175 Left err -> barf err
225 Right () -> return QuietSuccessResult
176 Right () -> return QuietSuccessResult
226−
177+
227−type GhcPkgPath = String
178+type GhcPkgPath = String
228−type TutorialDExec = String
229−type CheckFS = Bool
230−
231−data InterpreterConfig = LocalInterpreterConfig PersistenceStrategy HeadName (Maybe TutorialDExec) [GhcPkgPath] CheckFS |
179+data InterpreterConfig = LocalInterpreterConfig PersistenceStrategy HeadName [GhcPkgPath] |
232− RemoteInterpreterConfig C.Hostname C.Port C.DatabaseName HeadName (Maybe TutorialDExec) CheckFS
180+ RemoteInterpreterConfig C.NodeId C.DatabaseName HeadName
233
181
234outputNotificationCallback :: C.NotificationCallback
182outputNotificationCallback :: C.NotificationCallback
235−outputNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received " ++ show notName ++ ":\n" ++ "\n" ++ prettyEvaluatedNotification evaldNot
183+outputNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received " ++ show notName ++ ":\n" ++ show (reportExpr (C.notification evaldNot)) ++ "\n" ++ prettyEvaluatedNotification evaldNot
236
184
237prettyEvaluatedNotification :: C.EvaluatedNotification -> String
185prettyEvaluatedNotification :: C.EvaluatedNotification -> String
238−prettyEvaluatedNotification eNotif = let eRelShow eRel = case eRel of
186+prettyEvaluatedNotification eNotif = case C.reportRelation eNotif of
239− Left err -> show err
187+ Left err -> show err
240− Right reportRel -> T.unpack (showRelation reportRel) in
188+ Right reportRel -> T.unpack (showRelation reportRel)
241− eRelShow (C.reportOldRelation eNotif) <> "\n" <> eRelShow (C.reportNewRelation eNotif)
242
189
243reprLoop :: InterpreterConfig -> C.SessionId -> C.Connection -> IO ()
190reprLoop :: InterpreterConfig -> C.SessionId -> C.Connection -> IO ()
244reprLoop config sessionId conn = do
191reprLoop config sessionId conn = do
@@ -247,26 +194,16 @@ reprLoop config sessionId conn = do
247 eHeadName <- C.headName sessionId conn
194 eHeadName <- C.headName sessionId conn
248 eSchemaName <- C.currentSchemaName sessionId conn
195 eSchemaName <- C.currentSchemaName sessionId conn
249 let prompt = promptText eHeadName eSchemaName
196 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 ""))
255− maybeLine <- catchInterrupt $ runInputT settings $ getInputLine (T.unpack prompt)
197+ maybeLine <- runInputT settings $ getInputLine (T.unpack prompt)
256 case maybeLine of
198 case maybeLine of
257 Nothing -> return ()
199 Nothing -> return ()
258 Just line -> do
200 Just line -> do
259− runTutorialD sessionId conn (Just (T.length prompt)) (T.pack line)
201+ case parseTutorialD (T.pack line) of
202+ Left err ->
203+ displayOpResult $ DisplayParseErrorResult (T.length prompt) err
204+ Right parsed ->
205+ catchJust (\exc -> if exc == C.RequestTimeoutException then Just exc else Nothing) (do
206+ evald <- evalTutorialD sessionId conn UnsafeEvaluation parsed
207+ displayOpResult evald)
208+ (\_ -> displayOpResult (DisplayErrorResult "Request timed out."))
260 reprLoop config sessionId conn
209 reprLoop config sessionId conn
261−
262−
263−runTutorialD :: C.SessionId -> C.Connection -> Maybe PromptLength -> T.Text -> IO ()
264−runTutorialD sessionId conn mPromptLength tutd =
265− case parseTutorialD tutd of
266− Left err ->
267− displayOpResult $ DisplayParseErrorResult mPromptLength err
268− Right parsed ->
269− catchJust (\exc -> if exc == C.RequestTimeoutException then Just exc else Nothing) (do
270− evald <- evalTutorialDInteractive sessionId conn UnsafeEvaluation True parsed
271− displayOpResult evald)
272− (\_ -> displayOpResult (DisplayErrorResult "Request timed out."))
src/bin/TutorialD/Interpreter/Base.hs+49−135
@@ -1,99 +1,56 @@
1{-# LANGUAGE DeriveGeneric, CPP #-}
1{-# LANGUAGE DeriveGeneric, CPP #-}
2−module TutorialD.Interpreter.Base (
2+module TutorialD.Interpreter.Base where
3− module TutorialD.Interpreter.Base,
3+import Text.Megaparsec
4− module Text.Megaparsec,
4+import qualified Text.Megaparsec.Char.Lexer as Lex
5−#if MIN_VERSION_megaparsec(6,0,0)
5+import Text.Megaparsec.Char
6− module Text.Megaparsec.Char,
7− module Control.Applicative
8−#else
9− module Text.Megaparsec.Text
10−#endif
11− )
12− where
13import ProjectM36.Base
6import ProjectM36.Base
14import ProjectM36.AtomType
7import ProjectM36.AtomType
15−import ProjectM36.Attribute as A
16−import ProjectM36.Relation
17−import ProjectM36.DataFrame
18−
19−#if MIN_VERSION_megaparsec(6,0,0)
20−import Text.Megaparsec.Char
21−import qualified Text.Megaparsec.Char.Lexer as Lex
22−import Text.Megaparsec
23−import Data.Void
24−import Control.Applicative hiding (many, some)
25−#else
26−import Text.Megaparsec.Text
27−import qualified Text.Megaparsec.Lexer as Lex
28−#endif
29−
30import Data.Text hiding (count)
8import Data.Text hiding (count)
31import System.Random
9import System.Random
32import qualified Data.Text as T
10import qualified Data.Text as T
33import qualified Data.List as L
11import qualified Data.List as L
12+import qualified Data.Vector as V
34import qualified Data.Text.IO as TIO
13import qualified Data.Text.IO as TIO
35import System.IO
14import System.IO
36import ProjectM36.Relation.Show.Term
15import ProjectM36.Relation.Show.Term
37import GHC.Generics
16import GHC.Generics
38−#if __GLASGOW_HASKELL__ < 804
39import Data.Monoid
17import Data.Monoid
40−#endif
41import qualified Data.UUID as U
18import qualified Data.UUID as U
19+import ProjectM36.Relation
42import Control.Monad.Random
20import Control.Monad.Random
43import Data.List.NonEmpty as NE
21import Data.List.NonEmpty as NE
44−import Data.Time.Clock
22+import Data.Void
45−import Data.Time.Format
46−import Control.Monad (void)
47−import Data.Char
48
23
49−#if !MIN_VERSION_megaparsec(7,0,0)
50−anySingle :: Parsec Void Text (Token Text)
24+type Parser = Parsec Void Text
51−anySingle = anyChar
52−#endif
53
25
54displayOpResult :: TutorialDOperatorResult -> IO ()
26displayOpResult :: TutorialDOperatorResult -> IO ()
55displayOpResult QuitResult = return ()
27displayOpResult QuitResult = return ()
56displayOpResult (DisplayResult out) = TIO.putStrLn out
28displayOpResult (DisplayResult out) = TIO.putStrLn out
57displayOpResult (DisplayIOResult ioout) = ioout
29displayOpResult (DisplayIOResult ioout) = ioout
58−displayOpResult (DisplayErrorResult err) = let outputf = if T.length err > 0 && T.last err /= '\n' then TIO.hPutStrLn else TIO.hPutStr in
30+displayOpResult (DisplayErrorResult err) = let outputf = if T.length err > 0 && T.last err /= '\n' then TIO.hPutStrLn else TIO.hPutStr in
59 outputf stderr ("ERR: " <> err)
31 outputf stderr ("ERR: " <> err)
60displayOpResult QuietSuccessResult = return ()
32displayOpResult QuietSuccessResult = return ()
61displayOpResult (DisplayRelationResult rel) = do
33displayOpResult (DisplayRelationResult rel) = do
62 gen <- newStdGen
34 gen <- newStdGen
63 let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen
35 let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen
64 TIO.putStrLn (showRelation randomlySortedRel)
36 TIO.putStrLn (showRelation randomlySortedRel)
65−displayOpResult (DisplayParseErrorResult mPromptLength err) = do
37+displayOpResult (DisplayParseErrorResult promptLength err) = TIO.putStrLn pointyString >> TIO.putStr ("ERR:" <> errString)
66−#if MIN_VERSION_megaparsec(7,0,0)
38+ where
67− let errorIndent = errorOffset . NE.head . bundleErrors $ err
68− errString = T.pack (parseErrorPretty . NE.head . bundleErrors $ err)
39+ errString = T.pack (parseErrorPretty err)
69−#else
70− let errorIndent = unPos (sourceColumn (NE.head (errorPos err)))
40+ errorIndent = unPos (sourceColumn (NE.head (errorPos err)))
71− errString = T.pack (parseErrorPretty err)
72−#endif
73− pointyString len = T.justifyRight (len + fromIntegral errorIndent) '_' "^"
41+ pointyString = T.justifyRight (promptLength + fromIntegral errorIndent) '_' "^"
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
42
85−-- consumes only horizontal spaces
86spaceConsumer :: Parser ()
43spaceConsumer :: Parser ()
87−spaceConsumer = Lex.space space1 (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")
44+spaceConsumer = Lex.space (void spaceChar) (Lex.skipLineComment "--") (Lex.skipBlockComment "{-" "-}")
88−
45+
89opChar :: Parser Char
46opChar :: Parser Char
90opChar = oneOf (":!#$%&*+./<=>?\\^|-~" :: String)-- remove "@" so it can be used as attribute marker without spaces
47opChar = oneOf (":!#$%&*+./<=>?\\^|-~" :: String)-- remove "@" so it can be used as attribute marker without spaces
91
48
92−reserved :: ParseStr -> Parser ()
49+reserved :: Text -> Parser ()
93reserved word = try (string word *> notFollowedBy opChar *> spaceConsumer)
50reserved word = try (string word *> notFollowedBy opChar *> spaceConsumer)
94
51
95−reservedOp :: ParseStr -> Parser ()
52+reservedOp :: Text -> Parser ()
96−reservedOp op = try (spaceConsumer *> string op *> notFollowedBy opChar *> spaceConsumer)
53+reservedOp op = try (string op *> notFollowedBy opChar *> spaceConsumer)
97
54
98parens :: Parser a -> Parser a
55parens :: Parser a -> Parser a
99parens = between (symbol "(") (symbol ")")
56parens = between (symbol "(") (symbol ")")
@@ -104,20 +61,12 @@ braces = between (symbol "{") (symbol "}")
104identifier :: Parser Text
61identifier :: Parser Text
105identifier = do
62identifier = do
106 istart <- letterChar <|> char '_'
63 istart <- letterChar <|> char '_'
107− identifierRemainder istart
108−
109−identifierRemainder :: Char -> Parser Text
110−identifierRemainder c = do
111− rest <- many (alphaNumChar <|> char '_' <|> char '#')
64+ irest <- many (alphaNumChar <|> char '_' <|> char '#')
112 spaceConsumer
65 spaceConsumer
113− pure (pack (c:rest))
66+ pure (pack (istart:irest))
114
67
115−symbol :: ParseStr -> Parser Text
68+symbol :: Text -> Parser Text
116−#if MIN_VERSION_megaparsec(6,0,0)
117−symbol sym = Lex.symbol spaceConsumer sym
118−#else
119−symbol sym = pack <$> Lex.symbol spaceConsumer sym
69+symbol = Lex.symbol spaceConsumer
120−#endif
121
70
122comma :: Parser Text
71comma :: Parser Text
123comma = symbol ","
72comma = symbol ","
@@ -137,80 +86,65 @@ arrow = symbol "->"
137semi :: Parser Text
86semi :: Parser Text
138semi = symbol ";"
87semi = symbol ";"
139
88
140−nline :: Parser Text
89+{-
141−nline = (T.singleton <$> newline) <|> crlf
90+whiteSpace :: Parser ()
91+whiteSpace = Token.whiteSpace lexer
92+-}
142
93
143integer :: Parser Integer
94integer :: Parser Integer
144−#if MIN_VERSION_megaparsec(6,0,0)
145−integer = Lex.signed (pure ()) Lex.decimal <* spaceConsumer
95+integer = Lex.decimal
146−#else
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
96
157float :: Parser Double
97float :: Parser Double
158−float = Lex.float <* spaceConsumer
98+float = Lex.float
159
99
160capitalizedIdentifier :: Parser Text
100capitalizedIdentifier :: Parser Text
161−capitalizedIdentifier =
101+capitalizedIdentifier = do
162− upperChar >>= identifierRemainder
102+ fletter <- upperChar
163−
103+ restOfIdentifier_ fletter
104+
105+restOfIdentifier_ :: Char -> Parser Text
106+restOfIdentifier_ fletter = do
107+ rest <- option "" identifier
108+ spaceConsumer
109+ pure (T.cons fletter rest)
110+
164uncapitalizedIdentifier :: Parser Text
111uncapitalizedIdentifier :: Parser Text
165−uncapitalizedIdentifier =
112+uncapitalizedIdentifier = do
166− lowerChar >>= identifierRemainder
113+ fletter <- lowerChar
114+ restOfIdentifier_ fletter
167
115
168showRelationAttributes :: Attributes -> Text
116showRelationAttributes :: Attributes -> Text
169showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ L.map showAttribute attrsL) <> "}"
117showRelationAttributes attrs = "{" <> T.concat (L.intersperse ", " $ L.map showAttribute attrsL) <> "}"
170 where
118 where
171− showAttribute (Attribute name atomType') = name <> " " <> prettyAtomType atomType'
119+ showAttribute (Attribute name atomType) = name <> " " <> prettyAtomType atomType
172− attrsL = A.toList attrs
120+ attrsL = V.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
183
121
184data TutorialDOperatorResult = QuitResult |
122data TutorialDOperatorResult = QuitResult |
185 DisplayResult StringType |
123 DisplayResult StringType |
186 DisplayIOResult (IO ()) |
124 DisplayIOResult (IO ()) |
187 DisplayRelationResult Relation |
125 DisplayRelationResult Relation |
188− DisplayDataFrameResult DataFrame |
189 DisplayErrorResult StringType |
126 DisplayErrorResult StringType |
190− DisplayParseErrorResult (Maybe PromptLength) ParserError | -- PromptLength refers to length of prompt text
127+ DisplayParseErrorResult Int (ParseError Char Void) | -- Int refers to length of prompt text
191 QuietSuccessResult
128 QuietSuccessResult
192 deriving (Generic)
129 deriving (Generic)
193−
130+
194type TransactionGraphWasUpdated = Bool
131type TransactionGraphWasUpdated = Bool
195
132
196--allow for python-style triple quoting because guessing the correct amount of escapes in different contexts is annoying
133--allow for python-style triple quoting because guessing the correct amount of escapes in different contexts is annoying
197tripleQuotedString :: Parser Text
134tripleQuotedString :: Parser Text
198tripleQuotedString = do
135tripleQuotedString = do
199 _ <- tripleQuote
136 _ <- tripleQuote
200− pack <$> manyTill anySingle (try (tripleQuote >> notFollowedBy quote))
137+ pack <$> manyTill anyChar (try (tripleQuote >> notFollowedBy quote))
201−
138+
202normalQuotedString :: Parser Text
139normalQuotedString :: Parser Text
203normalQuotedString = quote *> (T.pack <$> manyTill Lex.charLiteral quote)
140normalQuotedString = quote *> (T.pack <$> manyTill Lex.charLiteral quote)
204
141
205quotedString :: Parser Text
142quotedString :: Parser Text
206quotedString = try tripleQuotedString <|> normalQuotedString
143quotedString = try tripleQuotedString <|> normalQuotedString
207
144
208−quoted :: Parser a -> Parser a
209−quoted = between quote quote
210−
211uuidP :: Parser U.UUID
145uuidP :: Parser U.UUID
212uuidP = do
146uuidP = do
213− uuidStart <- count 8 hexDigitChar
147+ uuidStart <- count 8 hexDigitChar
214 _ <- char '-' -- min 28 with no dashes, maximum 4 dashes
148 _ <- char '-' -- min 28 with no dashes, maximum 4 dashes
215 uuidMid1 <- count 4 hexDigitChar
149 uuidMid1 <- count 4 hexDigitChar
216 _ <- char '-'
150 _ <- char '-'
@@ -223,23 +157,3 @@ uuidP = do
223 case U.fromString uuidStr of
157 case U.fromString uuidStr of
224 Nothing -> fail "Invalid uuid string"
158 Nothing -> fail "Invalid uuid string"
225 Just uuid -> return uuid
159 Just uuid -> return uuid
226−
227−utcTimeP :: Parser UTCTime
228−utcTimeP = do
229− timeStr <- quotedString
230− case parseTimeM True defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack timeStr) of
231− Nothing -> fail "invalid datetime input, use \"YYYY-MM-DD HH:MM:SS\""
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'))
245−
src/bin/TutorialD/Interpreter/DataTypes/DateTime.hsnew file+22
@@ -0,0 +1,22 @@
1+module TutorialD.Interpreter.DataTypes.DateTime where
2+import Text.Megaparsec
3+import ProjectM36.Base
4+import TutorialD.Interpreter.Base
5+import Data.Time.Clock
6+import Data.Time.Format
7+import qualified Data.Text as T
8+
9+dateTimeAtomP :: Parser Atom
10+dateTimeAtomP = do
11+ dateTime' <- try $ do
12+ dateTime <- dateTimeStringP
13+ reserved "::datetime"
14+ return dateTime
15+ return $ DateTimeAtom dateTime'
16+
17+dateTimeStringP :: Parser UTCTime
18+dateTimeStringP = do
19+ dateTimeString <- quotedString
20+ case parseTimeM False defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack dateTimeString) of
21+ Just utctime -> pure (utctime :: UTCTime)
22+ Nothing -> fail $ "Failed to parse datetime from " ++ T.unpack dateTimeString
src/bin/TutorialD/Interpreter/DataTypes/Interval.hsnew file+35
@@ -0,0 +1,35 @@
1+module TutorialD.Interpreter.DataTypes.Interval where
2+import Text.Parsec
3+import Text.Parsec.String
4+import ProjectM36.Base hiding (Finite)
5+import ProjectM36.DataTypes.Interval ()
6+import TutorialD.Interpreter.Base
7+import TutorialD.Interpreter.DataTypes.DateTime
8+import Data.Interval
9+import Data.Time.Clock
10+
11+intervalP :: (Ord a) => Parser (Extended a) -> Parser (Interval a)
12+intervalP unitP = do
13+ lBoundClosed <- string "(" *> return False <|>
14+ string "[" *> return True
15+ lBound <- unitP
16+ reservedOp ","
17+ uBound <- unitP
18+
19+ uBoundClosed <- string ")" *> return False <|>
20+ string "]" *> return True
21+
22+ return $ interval (lBound, lBoundClosed) (uBound, uBoundClosed)
23+
24+intervalDateTimeUnitP :: Parser (Extended UTCTime)
25+intervalDateTimeUnitP = Finite <$> dateTimeStringP <|>
26+ (reserved "inf" *> return PosInf) <|>
27+ (reserved "-inf" *> return NegInf)
28+
29+intervalDateTimeAtomP :: Parser Atom
30+intervalDateTimeAtomP = do
31+ reserved "interval_datetime("
32+ intv <- intervalP intervalDateTimeUnitP
33+ reserved ")"
34+ return $ Atom intv
35+
src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs+36−36
@@ -1,21 +1,20 @@
1−{-# LANGUAGE CPP #-}
2module TutorialD.Interpreter.DatabaseContextExpr where
1module TutorialD.Interpreter.DatabaseContextExpr where
2+import Text.Megaparsec
3+import Text.Megaparsec.Char
3import ProjectM36.Base
4import ProjectM36.Base
4import TutorialD.Interpreter.Base
5import TutorialD.Interpreter.Base
5import qualified Data.Text as T
6import qualified Data.Text as T
6import TutorialD.Interpreter.RelationalExpr
7import TutorialD.Interpreter.RelationalExpr
7import TutorialD.Interpreter.Types
8import TutorialD.Interpreter.Types
8import qualified Data.Map as M
9import qualified Data.Map as M
10+import Control.Monad.State
9import ProjectM36.StaticOptimizer
11import ProjectM36.StaticOptimizer
10import qualified ProjectM36.Error as PM36E
12import qualified ProjectM36.Error as PM36E
11import ProjectM36.Error
13import ProjectM36.Error
12import qualified ProjectM36.RelationalExpression as RE
14import qualified ProjectM36.RelationalExpression as RE
13import ProjectM36.Key
15import ProjectM36.Key
14import ProjectM36.FunctionalDependency
16import ProjectM36.FunctionalDependency
15−#if __GLASGOW_HASKELL__ < 804
16import Data.Monoid
17import Data.Monoid
17−#endif
18−import Data.Functor
19
18
20--parsers which create "database expressions" which modify the database context (such as relvar assignment)
19--parsers which create "database expressions" which modify the database context (such as relvar assignment)
21databaseContextExprP :: Parser DatabaseContextExpr
20databaseContextExprP :: Parser DatabaseContextExpr
@@ -44,47 +43,53 @@ nothingP = spaceConsumer >> pure NoOperation
44assignP :: Parser DatabaseContextExpr
43assignP :: Parser DatabaseContextExpr
45assignP = do
44assignP = do
46 relVarName <- try $ do
45 relVarName <- try $ do
47− relVarName <- relVarNameP
46+ relVarName <- identifier
48 reservedOp ":="
47 reservedOp ":="
49 return relVarName
48 return relVarName
49+ expr <- relExprP
50− Assign relVarName <$> relExprP
50+ pure $ Assign relVarName expr
51
51
52multilineSep :: Parser T.Text
52multilineSep :: Parser T.Text
53multilineSep = newline >> pure "\n"
53multilineSep = newline >> pure "\n"
54
54
55multipleDatabaseContextExprP :: Parser DatabaseContextExpr
55multipleDatabaseContextExprP :: Parser DatabaseContextExpr
56multipleDatabaseContextExprP = do
56multipleDatabaseContextExprP = do
57− exprs <- filter (/= NoOperation) <$> sepBy1 databaseContextExprP semi
57+ exprs <- sepBy1 databaseContextExprP semi
58− pure (MultipleExpr exprs)
58+ pure $ MultipleExpr exprs
59
59
60insertP :: Parser DatabaseContextExpr
60insertP :: Parser DatabaseContextExpr
61insertP = do
61insertP = do
62 reservedOp "insert"
62 reservedOp "insert"
63− relvar <- relVarNameP
63+ relvar <- identifier
64− Insert relvar <$> relExprP
64+ expr <- relExprP
65+ pure $ Insert relvar expr
65
66
66defineP :: Parser DatabaseContextExpr
67defineP :: Parser DatabaseContextExpr
67defineP = do
68defineP = do
68 relVarName <- try $ do
69 relVarName <- try $ do
69− relVarName <- relVarNameP
70+ relVarName <- identifier
70 reservedOp "::"
71 reservedOp "::"
71 return relVarName
72 return relVarName
73+ attributeSet <- makeAttributeExprsP
72− Define relVarName <$> makeAttributeExprsP
74+ pure $ Define relVarName attributeSet
73
75
74undefineP :: Parser DatabaseContextExpr
76undefineP :: Parser DatabaseContextExpr
75undefineP = do
77undefineP = do
76 reservedOp "undefine"
78 reservedOp "undefine"
77− Undefine <$> relVarNameP
79+ relVarName <- identifier
80+ return $ Undefine relVarName
78
81
79deleteP :: Parser DatabaseContextExpr
82deleteP :: Parser DatabaseContextExpr
80deleteP = do
83deleteP = do
81 reservedOp "delete"
84 reservedOp "delete"
85+ relVarName <- identifier
82− Delete <$> relVarNameP <*> option TruePredicate (reservedOp "where" *> restrictionPredicateP)
86+ predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP)
87+ return $ Delete relVarName predicate
83
88
84updateP :: Parser DatabaseContextExpr
89updateP :: Parser DatabaseContextExpr
85updateP = do
90updateP = do
86 reservedOp "update"
91 reservedOp "update"
87− relVarName <- relVarNameP
92+ relVarName <- identifier
88 predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP <* spaceConsumer)
93 predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP <* spaceConsumer)
89 attributeAssignments <- M.fromList <$> parens (sepBy attributeAssignmentP comma)
94 attributeAssignments <- M.fromList <$> parens (sepBy attributeAssignmentP comma)
90 return $ Update relVarName attributeAssignments predicate
95 return $ Update relVarName attributeAssignments predicate
@@ -96,7 +101,7 @@ addConstraintP = do
96 reservedOp "constraint" <|> reservedOp "foreign key"
101 reservedOp "constraint" <|> reservedOp "foreign key"
97 constraintName <- identifier
102 constraintName <- identifier
98 subset <- relExprP
103 subset <- relExprP
99− op <- (reservedOp "in" $> SubsetOp) <|> (reservedOp "equals" $> EqualityOp)
104+ op <- (reservedOp "in" *> pure SubsetOp) <|> (reservedOp "equals" *> pure EqualityOp)
100 superset <- relExprP
105 superset <- relExprP
101 let subsetA = incDepSet constraintName subset superset
106 let subsetA = incDepSet constraintName subset superset
102 subsetB = incDepSet (constraintName <> "_eqInvert") superset subset --inverted args for equality constraint
107 subsetB = incDepSet (constraintName <> "_eqInvert") superset subset --inverted args for equality constraint
@@ -108,7 +113,8 @@ addConstraintP = do
108deleteConstraintP :: Parser DatabaseContextExpr
113deleteConstraintP :: Parser DatabaseContextExpr
109deleteConstraintP = do
114deleteConstraintP = do
110 reserved "deleteconstraint"
115 reserved "deleteconstraint"
116+ constraintName <- identifier
111− RemoveInclusionDependency <$> identifier
117+ pure $ RemoveInclusionDependency constraintName
112
118
113-- key <constraint name> {<uniqueness attributes>} <uniqueness relexpr>
119-- key <constraint name> {<uniqueness attributes>} <uniqueness relexpr>
114keyP :: Parser DatabaseContextExpr
120keyP :: Parser DatabaseContextExpr
@@ -147,13 +153,14 @@ addNotificationP = do
147 reserved "notify"
153 reserved "notify"
148 notName <- identifier
154 notName <- identifier
149 triggerExpr <- relExprP
155 triggerExpr <- relExprP
150− resultOldExpr <- relExprP
156+ resultExpr <- relExprP
151− AddNotification notName triggerExpr resultOldExpr <$> relExprP
157+ pure $ AddNotification notName triggerExpr resultExpr
152
158
153removeNotificationP :: Parser DatabaseContextExpr
159removeNotificationP :: Parser DatabaseContextExpr
154removeNotificationP = do
160removeNotificationP = do
155 reserved "unnotify"
161 reserved "unnotify"
162+ notName <- identifier
156− RemoveNotification <$> identifier
163+ pure $ RemoveNotification notName
157
164
158-- | data Hair = Bald | Color Text
165-- | data Hair = Bald | Color Text
159addTypeConstructorP :: Parser DatabaseContextExpr
166addTypeConstructorP :: Parser DatabaseContextExpr
@@ -167,7 +174,7 @@ addTypeConstructorP = do
167removeTypeConstructorP :: Parser DatabaseContextExpr
174removeTypeConstructorP :: Parser DatabaseContextExpr
168removeTypeConstructorP = do
175removeTypeConstructorP = do
169 reserved "undata"
176 reserved "undata"
170− RemoveTypeConstructor <$> typeConstructorNameP
177+ RemoveTypeConstructor <$> identifier
171
178
172removeAtomFunctionP :: Parser DatabaseContextExpr
179removeAtomFunctionP :: Parser DatabaseContextExpr
173removeAtomFunctionP = do
180removeAtomFunctionP = do
@@ -179,35 +186,28 @@ removeDatabaseContextFunctionP = do
179 reserved "removedatabasecontextfunction"
186 reserved "removedatabasecontextfunction"
180 RemoveDatabaseContextFunction <$> quotedString
187 RemoveDatabaseContextFunction <$> quotedString
181
188
182−functionNameP :: Parser AtomFunctionName
183−functionNameP = uncapitalizedIdentifier
184−
185executeDatabaseContextFunctionP :: Parser DatabaseContextExpr
189executeDatabaseContextFunctionP :: Parser DatabaseContextExpr
186executeDatabaseContextFunctionP = do
190executeDatabaseContextFunctionP = do
187 reserved "execute"
191 reserved "execute"
188− funcName <- functionNameP
192+ funcName <- identifier
189 args <- parens (sepBy atomExprP comma)
193 args <- parens (sepBy atomExprP comma)
190 pure (ExecuteDatabaseContextFunction funcName args)
194 pure (ExecuteDatabaseContextFunction funcName args)
191
195
192databaseExprOpP :: Parser DatabaseContextExpr
196databaseExprOpP :: Parser DatabaseContextExpr
193databaseExprOpP = multipleDatabaseContextExprP
197databaseExprOpP = multipleDatabaseContextExprP
194
198
195−{-
196evalDatabaseContextExpr :: Bool -> DatabaseContext -> DatabaseContextExpr -> Either RelationalError DatabaseContext
199evalDatabaseContextExpr :: Bool -> DatabaseContext -> DatabaseContextExpr -> Either RelationalError DatabaseContext
197evalDatabaseContextExpr useOptimizer context expr = do
200evalDatabaseContextExpr useOptimizer context expr = do
198 optimizedExpr <- evalState (applyStaticDatabaseOptimization expr) (RE.freshDatabaseState context)
201 optimizedExpr <- evalState (applyStaticDatabaseOptimization expr) (RE.freshDatabaseState context)
199 case runState (RE.evalDatabaseContextExpr (if useOptimizer then optimizedExpr else expr)) (RE.freshDatabaseState context) of
202 case runState (RE.evalDatabaseContextExpr (if useOptimizer then optimizedExpr else expr)) (RE.freshDatabaseState context) of
200− (Right (), (context',_, _)) -> Right context'
203+ (Nothing, (context',_, _)) -> Right context'
201− (Left err, _) -> Left err
204+ (Just err, _) -> Left err
202−-}
205+
203
206
204−interpretDatabaseContextExpr :: DatabaseContext -> TransactionId -> TransactionGraph -> T.Text -> Either RelationalError DatabaseContext
207+interpretDatabaseContextExpr :: DatabaseContext -> T.Text -> Either RelationalError DatabaseContext
205−interpretDatabaseContextExpr context transId graph tutdstring =
208+interpretDatabaseContextExpr context tutdstring = case parse databaseExprOpP "" tutdstring of
206− case parse databaseExprOpP "" tutdstring of
207− Left err -> Left $ PM36E.ParseError (T.pack (show err))
209+ Left err -> Left $ PM36E.ParseError (T.pack (show err))
208− Right parsed -> do
210+ Right parsed -> evalDatabaseContextExpr True context parsed
209− let env = RE.mkDatabaseContextEvalEnv transId graph
210− RE.dbc_context <$> RE.runDatabaseContextEvalMonad context env (optimizeAndEvalDatabaseContextExpr True parsed)
211
211
212{-
212{-
213--no optimization
213--no optimization
src/bin/TutorialD/Interpreter/DatabaseContextIOOperator.hs+7−27
@@ -1,8 +1,10 @@
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.
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
2module TutorialD.Interpreter.DatabaseContextIOOperator where
3import ProjectM36.Base
3import ProjectM36.Base
4+
4import TutorialD.Interpreter.Base
5import TutorialD.Interpreter.Base
5import TutorialD.Interpreter.Types
6import TutorialD.Interpreter.Types
7+import Text.Megaparsec
6import Data.Text
8import Data.Text
7
9
8addAtomFunctionExprP :: Parser DatabaseContextIOExpr
10addAtomFunctionExprP :: Parser DatabaseContextIOExpr
@@ -10,41 +12,19 @@ addAtomFunctionExprP = dbioexprP "addatomfunction" AddAtomFunction
10
12
11addDatabaseContextFunctionExprP :: Parser DatabaseContextIOExpr
13addDatabaseContextFunctionExprP :: Parser DatabaseContextIOExpr
12addDatabaseContextFunctionExprP = dbioexprP "adddatabasecontextfunction" AddDatabaseContextFunction
14addDatabaseContextFunctionExprP = 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')
23
15
24−dbioexprP :: ParseStr -> (Text -> [TypeConstructor] -> Text -> DatabaseContextIOExpr) -> Parser DatabaseContextIOExpr
16+dbioexprP :: Text -> (Text -> [TypeConstructor] -> Text -> DatabaseContextIOExpr) -> Parser DatabaseContextIOExpr
25dbioexprP res adt = do
17dbioexprP res adt = do
26 reserved res
18 reserved res
27 funcName <- quotedString
19 funcName <- quotedString
28 funcType <- atomTypeSignatureP
20 funcType <- atomTypeSignatureP
21+ funcScript <- quotedString
29− adt funcName funcType <$> quotedString
22+ pure $ adt funcName funcType funcScript
30
23
31atomTypeSignatureP :: Parser [TypeConstructor]
24atomTypeSignatureP :: Parser [TypeConstructor]
32atomTypeSignatureP = sepBy typeConstructorP arrow
25atomTypeSignatureP = sepBy typeConstructorP arrow
33
26
34dbContextIOExprP :: Parser DatabaseContextIOExpr
27dbContextIOExprP :: Parser DatabaseContextIOExpr
35−dbContextIOExprP = addAtomFunctionExprP <|>
28+dbContextIOExprP = addAtomFunctionExprP <|> addDatabaseContextFunctionExprP
36− addDatabaseContextFunctionExprP <|>
29+
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
50
30
src/bin/TutorialD/Interpreter/Export/Base.hs−3
@@ -1,10 +1,7 @@
1−{-# LANGUAGE CPP #-}
2module TutorialD.Interpreter.Export.Base where
1module TutorialD.Interpreter.Export.Base where
3import ProjectM36.Base
2import ProjectM36.Base
4import ProjectM36.Error
3import ProjectM36.Error
5−#if __GLASGOW_HASKELL__ < 804
6import Data.Monoid
4import Data.Monoid
7−#endif
8
5
9data RelVarDataExportOperator = RelVarDataExportOperator RelationalExpr FilePath (RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError))
6data RelVarDataExportOperator = RelVarDataExportOperator RelationalExpr FilePath (RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError))
10
7
src/bin/TutorialD/Interpreter/Export/CSV.hs+1−1
@@ -2,7 +2,7 @@ module TutorialD.Interpreter.Export.CSV where
2import ProjectM36.Relation.Show.CSV
2import ProjectM36.Relation.Show.CSV
3import TutorialD.Interpreter.Export.Base
3import TutorialD.Interpreter.Export.Base
4import TutorialD.Interpreter.RelationalExpr
4import TutorialD.Interpreter.RelationalExpr
5−import TutorialD.Interpreter.Base hiding (try)
5+import TutorialD.Interpreter.Base
6import ProjectM36.Base
6import ProjectM36.Base
7import ProjectM36.Error
7import ProjectM36.Error
8import qualified Data.ByteString.Lazy as BS
8import qualified Data.ByteString.Lazy as BS
src/bin/TutorialD/Interpreter/Import/Base.hs+6−14
@@ -1,32 +1,24 @@
1−{-# LANGUAGE CPP #-}
2module TutorialD.Interpreter.Import.Base where
1module TutorialD.Interpreter.Import.Base where
3import ProjectM36.Base
2import ProjectM36.Base
4import ProjectM36.Error
3import ProjectM36.Error
5−import Text.URI (URI)
6−import Data.Text (Text)
7−#if __GLASGOW_HASKELL__ < 804
8import Data.Monoid
4import Data.Monoid
9−#endif
10
5
11-- | import data into a relation variable
6-- | import data into a relation variable
12−data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> TypeConstructorMapping -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr))
7+data RelVarDataImportOperator = RelVarDataImportOperator RelVarName FilePath (RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr))
13
8
14instance Show RelVarDataImportOperator where
9instance Show RelVarDataImportOperator where
15 show (RelVarDataImportOperator rv path _) = "RelVarDataImportOperator " <> show rv <> " " <> path
10 show (RelVarDataImportOperator rv path _) = "RelVarDataImportOperator " <> show rv <> " " <> path
16
11
17−type HashVerification = Maybe Text
18−
19-- | import data into a database context
12-- | import data into a database context
20−data DatabaseContextDataImportOperator = DatabaseContextDataImportOperator URI HashVerification (URI -> HashVerification -> IO (Either RelationalError DatabaseContextExpr))
13+data DatabaseContextDataImportOperator = DatabaseContextDataImportOperator FilePath (FilePath -> IO (Either RelationalError DatabaseContextExpr))
21
14
22instance Show DatabaseContextDataImportOperator where
15instance Show DatabaseContextDataImportOperator where
23− show (DatabaseContextDataImportOperator uri hash _) =
16+ show (DatabaseContextDataImportOperator path _) = "DatabaseContextDataImportOperator " <> path
24− "DatabaseContextDataImportOperator " <> show uri <> " " <> show hash
25
17
26-- perhaps create a structure to import a whole transaction graph section in the future
18-- perhaps create a structure to import a whole transaction graph section in the future
27
19
28−evalRelVarDataImportOperator :: RelVarDataImportOperator -> TypeConstructorMapping -> Attributes -> IO (Either RelationalError DatabaseContextExpr)
20+evalRelVarDataImportOperator :: RelVarDataImportOperator -> Attributes -> IO (Either RelationalError DatabaseContextExpr)
29−evalRelVarDataImportOperator (RelVarDataImportOperator relVarName path importFunc) tConsMap attrs = importFunc relVarName tConsMap attrs path
21+evalRelVarDataImportOperator (RelVarDataImportOperator relVarName path importFunc) attrs = importFunc relVarName attrs path
30
22
31evalDatabaseContextDataImportOperator :: DatabaseContextDataImportOperator -> IO (Either RelationalError DatabaseContextExpr)
23evalDatabaseContextDataImportOperator :: DatabaseContextDataImportOperator -> IO (Either RelationalError DatabaseContextExpr)
32−evalDatabaseContextDataImportOperator (DatabaseContextDataImportOperator uri hash importFunc) = importFunc uri hash
24+evalDatabaseContextDataImportOperator (DatabaseContextDataImportOperator path importFunc) = importFunc path
src/bin/TutorialD/Interpreter/Import/BasicExamples.hs+2−7
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
2--includes some hardcoded examples which can be imported even during safe evaluation (no file I/O)
1--includes some hardcoded examples which can be imported even during safe evaluation (no file I/O)
3module TutorialD.Interpreter.Import.BasicExamples where
2module TutorialD.Interpreter.Import.BasicExamples where
4import ProjectM36.DateExamples
3import ProjectM36.DateExamples
@@ -6,10 +5,6 @@ import ProjectM36.Base
6import ProjectM36.DatabaseContext
5import ProjectM36.DatabaseContext
7import TutorialD.Interpreter.Base
6import TutorialD.Interpreter.Base
8
7
9−#if !MIN_VERSION_megaparsec(6,0,0)
10−import Text.Megaparsec.Text
11−#endif
12−
13data ImportBasicExampleOperator = ImportBasicDateExampleOperator
8data ImportBasicExampleOperator = ImportBasicDateExampleOperator
14 deriving (Show)
9 deriving (Show)
15
10
@@ -20,8 +15,8 @@ importBasicExampleOperatorP :: Parser ImportBasicExampleOperator
20importBasicExampleOperatorP = do
15importBasicExampleOperatorP = do
21 reservedOp ":importexample"
16 reservedOp ":importexample"
22 example <- identifier
17 example <- identifier
23− if example == "cjdate" then
18+ if example == "date" then
24 pure ImportBasicDateExampleOperator
19 pure ImportBasicDateExampleOperator
25 else
20 else
26 fail "Unknown example name"
21 fail "Unknown example name"
27−
22+
src/bin/TutorialD/Interpreter/Import/CSV.hs+8−9
@@ -1,23 +1,22 @@
1−{-# LANGUAGE CPP #-}
2module TutorialD.Interpreter.Import.CSV where
1module TutorialD.Interpreter.Import.CSV where
3import TutorialD.Interpreter.Import.Base
2import TutorialD.Interpreter.Import.Base
4import ProjectM36.Base
3import ProjectM36.Base
5import ProjectM36.Error
4import ProjectM36.Error
6−import ProjectM36.Relation.Parse.CSV hiding (quotedString)
5+import ProjectM36.Relation.Parse.CSV
7import qualified Data.ByteString.Lazy as BS
6import qualified Data.ByteString.Lazy as BS
8import qualified Data.Text as T
7import qualified Data.Text as T
9−import TutorialD.Interpreter.Base hiding (try)
8+import TutorialD.Interpreter.Base
10import Control.Exception
9import Control.Exception
11
10
12−importCSVRelation :: RelVarName -> TypeConstructorMapping -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr)
11+importCSVRelation :: RelVarName -> Attributes -> FilePath -> IO (Either RelationalError DatabaseContextExpr)
13−importCSVRelation relVarName tConsMap attrs pathIn = do
12+importCSVRelation relVarName attrs pathIn = do
14 --TODO: handle filesystem errors
13 --TODO: handle filesystem errors
15 csvData <- try (BS.readFile pathIn) :: IO (Either IOError BS.ByteString)
14 csvData <- try (BS.readFile pathIn) :: IO (Either IOError BS.ByteString)
16 case csvData of
15 case csvData of
17− Left err -> pure $ Left (ImportError (ImportFileError (T.pack (show err))))
16+ Left err -> return $ Left (ImportError $ T.pack (show err))
18− Right csvData' -> case csvAsRelation attrs tConsMap csvData' of
17+ Right csvData' -> case csvAsRelation csvData' attrs of
19− Left err -> pure $ Left (ParseError $ T.pack (show err))
18+ Left err -> return $ Left (ParseError $ T.pack (show err))
20− Right csvRel -> pure $ Right (Insert relVarName (ExistingRelation csvRel))
19+ Right csvRel -> return $ Right (Insert relVarName (ExistingRelation csvRel))
21
20
22importCSVP :: Parser RelVarDataImportOperator
21importCSVP :: Parser RelVarDataImportOperator
23importCSVP = do
22importCSVP = do
src/bin/TutorialD/Interpreter/Import/TutorialD.hs+14−70
@@ -1,86 +1,30 @@
1module TutorialD.Interpreter.Import.TutorialD where
1module TutorialD.Interpreter.Import.TutorialD where
2import ProjectM36.Base
2import ProjectM36.Base
3import TutorialD.Interpreter.Import.Base
3import TutorialD.Interpreter.Import.Base
4−import TutorialD.Interpreter.Base hiding (try)
4+import TutorialD.Interpreter.Base
5import TutorialD.Interpreter.DatabaseContextExpr
5import TutorialD.Interpreter.DatabaseContextExpr
6+import Text.Megaparsec hiding (try)
6import ProjectM36.Error
7import ProjectM36.Error
7import qualified ProjectM36.Error as PM36E
8import qualified ProjectM36.Error as PM36E
8import qualified Data.Text as T
9import qualified Data.Text as T
9import Control.Exception
10import Control.Exception
10−import qualified Data.ByteString as BS
11+import qualified Data.Text.IO as TIO
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
18−--import a file containing TutorialD database context expressions via local files or HTTP/HTTPS
12+--import a file containing TutorialD database context expressions
19
13
20−importTutorialDFromFile :: URI -> HashVerification -> IO (Either RelationalError DatabaseContextExpr)
14+importTutorialD :: FilePath -> IO (Either RelationalError DatabaseContextExpr)
21−importTutorialDFromFile fileURI mHash = do
15+importTutorialD pathIn = do
22− case URI.uriPath fileURI of
23− Just (False, _) -> do
24− eTutdBytes <- try (BS.readFile filePath) :: IO (Either IOError BS.ByteString)
16+ tutdData <- try (TIO.readFile pathIn) :: IO (Either IOError T.Text)
25− case eTutdBytes of
17+ case tutdData of
26− Left err -> pure $ Left (ImportError (ImportFileError (T.pack (show err))))
18+ Left err -> return $ Left (ImportError $ T.pack (show err))
27− Right tutdBytes ->
19+ Right tutdData' ->
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
39− Left err -> pure (Left (ImportError (ImportFileDecodeError (T.pack (show err)))))
40− Right tutdUtf8 ->
41− case parse (multipleDatabaseContextExprP <* eof) "import" tutdUtf8 of
20+ case parse multipleDatabaseContextExprP "import" tutdData' of
42 --parseErrorPretty is new in megaparsec 5
21 --parseErrorPretty is new in megaparsec 5
43− Left err -> pure (Left (PM36E.ParseError (T.pack (errorBundlePretty err))))
22+ Left err -> pure (Left (PM36E.ParseError (T.pack (show err))))
44 Right expr -> pure (Right expr)
23 Right expr -> pure (Right expr)
45
24
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−
75tutdImportP :: Parser DatabaseContextDataImportOperator
25tutdImportP :: Parser DatabaseContextDataImportOperator
76tutdImportP = do
26tutdImportP = do
77 reserved ":importtutd"
27 reserved ":importtutd"
78− uri <- quoted URI.parser
28+ path <- quotedString
79 spaceConsumer
29 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)
86− pure $ DatabaseContextDataImportOperator uri mhash handler
30+ return $ DatabaseContextDataImportOperator (T.unpack path) importTutorialD
src/bin/TutorialD/Interpreter/InformationOperator.hs+1−6
@@ -3,11 +3,6 @@ module TutorialD.Interpreter.InformationOperator where
3import Data.Text
3import Data.Text
4import Text.Megaparsec
4import Text.Megaparsec
5import 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
11
6
12-- this module provides information about the current interpreter
7-- this module provides information about the current interpreter
13
8
@@ -25,7 +20,7 @@ getVersionP :: Parser InformationOperator
25getVersionP = reserved ":version" >> pure GetVersionOperator
20getVersionP = reserved ":version" >> pure GetVersionOperator
26
21
27evalInformationOperator :: InformationOperator -> Either Text Text
22evalInformationOperator :: InformationOperator -> Either Text Text
28−evalInformationOperator GetVersionOperator = Right ("tutd " `append` VERSION_project_m36)
23+evalInformationOperator GetVersionOperator = Right ("tutd " `append` PROJECTM36_VERSION)
29-- display generic help
24-- display generic help
30evalInformationOperator HelpOperator = Right $ intercalate "\n" help
25evalInformationOperator HelpOperator = Right $ intercalate "\n" help
31 where
26 where
src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+24−94
@@ -1,16 +1,13 @@
1{-# LANGUAGE GADTs #-}
1{-# LANGUAGE GADTs #-}
2module TutorialD.Interpreter.RODatabaseContextOperator where
2module TutorialD.Interpreter.RODatabaseContextOperator where
3import ProjectM36.Base
3import ProjectM36.Base
4−import ProjectM36.Relation
5−import qualified ProjectM36.DataFrame as DF
6import ProjectM36.Error
4import ProjectM36.Error
7−import ProjectM36.Tuple
8import ProjectM36.InclusionDependency
5import ProjectM36.InclusionDependency
9import qualified ProjectM36.Client as C
6import qualified ProjectM36.Client as C
7+import Text.Megaparsec
10import TutorialD.Interpreter.Base
8import TutorialD.Interpreter.Base
11import TutorialD.Interpreter.RelationalExpr
9import TutorialD.Interpreter.RelationalExpr
12import TutorialD.Interpreter.DatabaseContextExpr
10import TutorialD.Interpreter.DatabaseContextExpr
13−import TutorialD.Printer
14import Control.Monad.State
11import Control.Monad.State
15import qualified Data.Text as T
12import qualified Data.Text as T
16import ProjectM36.Relation.Show.Gnuplot
13import ProjectM36.Relation.Show.Gnuplot
@@ -22,57 +19,53 @@ data RODatabaseContextOperator where
22 ShowRelation :: RelationalExpr -> RODatabaseContextOperator
19 ShowRelation :: RelationalExpr -> RODatabaseContextOperator
23 PlotRelation :: RelationalExpr -> RODatabaseContextOperator
20 PlotRelation :: RelationalExpr -> RODatabaseContextOperator
24 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator
21 ShowRelationType :: RelationalExpr -> RODatabaseContextOperator
25− ShowConstraints :: StringType -> RODatabaseContextOperator
22+ ShowConstraint :: StringType -> RODatabaseContextOperator
26 ShowPlan :: DatabaseContextExpr -> RODatabaseContextOperator
23 ShowPlan :: DatabaseContextExpr -> RODatabaseContextOperator
27 ShowTypes :: RODatabaseContextOperator
24 ShowTypes :: RODatabaseContextOperator
28 ShowRelationVariables :: RODatabaseContextOperator
25 ShowRelationVariables :: RODatabaseContextOperator
29− ShowAtomFunctions :: RODatabaseContextOperator
30− ShowDatabaseContextFunctions :: RODatabaseContextOperator
31− ShowDataFrame :: DF.DataFrameExpr -> RODatabaseContextOperator
32 Quit :: RODatabaseContextOperator
26 Quit :: RODatabaseContextOperator
33 deriving (Show)
27 deriving (Show)
34
28
35typeP :: Parser RODatabaseContextOperator
29typeP :: Parser RODatabaseContextOperator
36typeP = do
30typeP = do
37− colonOp ":type"
31+ reservedOp ":type"
38− ShowRelationType <$> relExprP
32+ expr <- relExprP
33+ return $ ShowRelationType expr
39
34
40showRelP :: Parser RODatabaseContextOperator
35showRelP :: Parser RODatabaseContextOperator
41showRelP = do
36showRelP = do
42− colonOp ":showexpr"
37+ reservedOp ":showexpr"
43− ShowRelation <$> relExprP
38+ expr <- relExprP
39+ return $ ShowRelation expr
44
40
45showPlanP :: Parser RODatabaseContextOperator
41showPlanP :: Parser RODatabaseContextOperator
46showPlanP = do
42showPlanP = do
47− colonOp ":showplan"
43+ reservedOp ":showplan"
48− ShowPlan <$> databaseContextExprP
44+ expr <- databaseContextExprP
45+ return $ ShowPlan expr
49
46
50showTypesP :: Parser RODatabaseContextOperator
47showTypesP :: Parser RODatabaseContextOperator
51−showTypesP = colonOp ":showtypes" >> pure ShowTypes
48+showTypesP = reserved ":showtypes" >> pure ShowTypes
52
49
53showRelationVariables :: Parser RODatabaseContextOperator
50showRelationVariables :: Parser RODatabaseContextOperator
54−showRelationVariables = colonOp ":showrelvars" >> pure ShowRelationVariables
51+showRelationVariables = reserved ":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
61
52
62quitP :: Parser RODatabaseContextOperator
53quitP :: Parser RODatabaseContextOperator
63quitP = do
54quitP = do
64− colonOp ":quit"
55+ reservedOp ":quit"
65 return Quit
56 return Quit
66
57
67showConstraintsP :: Parser RODatabaseContextOperator
58showConstraintsP :: Parser RODatabaseContextOperator
68showConstraintsP = do
59showConstraintsP = do
69− colonOp ":constraints"
60+ reservedOp ":constraints"
70− ShowConstraints <$> option "" identifier
61+ constraintName <- option "" identifier
62+ return $ ShowConstraint constraintName
71
63
72plotRelExprP :: Parser RODatabaseContextOperator
64plotRelExprP :: Parser RODatabaseContextOperator
73plotRelExprP = do
65plotRelExprP = do
74− colonOp ":plotexpr"
66+ reserved ":plotexpr"
75− PlotRelation <$> relExprP
67+ expr <- relExprP
68+ return $ PlotRelation expr
76
69
77roDatabaseContextOperatorP :: Parser RODatabaseContextOperator
70roDatabaseContextOperatorP :: Parser RODatabaseContextOperator
78roDatabaseContextOperatorP = typeP
71roDatabaseContextOperatorP = typeP
@@ -82,9 +75,6 @@ roDatabaseContextOperatorP = typeP
82 <|> showConstraintsP
75 <|> showConstraintsP
83 <|> showPlanP
76 <|> showPlanP
84 <|> showTypesP
77 <|> showTypesP
85− <|> showAtomFunctionsP
86− <|> showDatabaseContextFunctionsP
87− <|> showDataFrameP
88 <|> quitP
78 <|> quitP
89
79
90--logically, these read-only operations could happen purely, but not if a remote call is required
80--logically, these read-only operations could happen purely, but not if a remote call is required
@@ -109,16 +99,15 @@ evalRODatabaseContextOp sessionId conn (PlotRelation expr) = do
109 err <- plotRelation rel
99 err <- plotRelation rel
110 when (isJust err) $ print err
100 when (isJust err) $ print err
111
101
112−evalRODatabaseContextOp sessionId conn (ShowConstraints name) = do
102+evalRODatabaseContextOp sessionId conn (ShowConstraint name) = do
113 eIncDeps <- C.inclusionDependencies sessionId conn
103 eIncDeps <- C.inclusionDependencies sessionId conn
114 let val = case eIncDeps of
104 let val = case eIncDeps of
115 Left err -> Left err
105 Left err -> Left err
116 Right incDeps -> case name of
106 Right incDeps -> case name of
117− "" -> inclusionDependenciesAsRelation incDeps >>= renderRelExprsInIncDeps
107+ "" -> inclusionDependenciesAsRelation incDeps
118 depName -> case M.lookup depName incDeps of
108 depName -> case M.lookup depName incDeps of
119 Nothing -> Left (InclusionDependencyNameNotInUseError depName)
109 Nothing -> Left (InclusionDependencyNameNotInUseError depName)
120− Just dep ->
121− inclusionDependenciesAsRelation (M.singleton depName dep) >>= renderRelExprsInIncDeps
110+ Just dep -> inclusionDependenciesAsRelation (M.singleton depName dep)
122 pure $ case val of
111 pure $ case val of
123 Left err -> DisplayErrorResult (T.pack (show err))
112 Left err -> DisplayErrorResult (T.pack (show err))
124 Right rel -> DisplayRelationResult rel
113 Right rel -> DisplayRelationResult rel
@@ -140,25 +129,7 @@ evalRODatabaseContextOp sessionId conn ShowRelationVariables = do
140 case eRel of
129 case eRel of
141 Left err -> pure $ DisplayErrorResult (T.pack (show err))
130 Left err -> pure $ DisplayErrorResult (T.pack (show err))
142 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))
131 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))
155
132
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−
162evalRODatabaseContextOp _ _ Quit = pure QuitResult
133evalRODatabaseContextOp _ _ Quit = pure QuitResult
163
134
164interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> T.Text -> IO TutorialDOperatorResult
135interpretRODatabaseContextOp :: C.SessionId -> C.Connection -> T.Text -> IO TutorialDOperatorResult
@@ -166,45 +137,4 @@ interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseCo
166 Left err -> pure $ DisplayErrorResult (T.pack (show err))
137 Left err -> pure $ DisplayErrorResult (T.pack (show err))
167 Right parsed -> evalRODatabaseContextOp sessionId conn parsed
138 Right parsed -> evalRODatabaseContextOp sessionId conn parsed
168
139
169−showDataFrameP :: Parser RODatabaseContextOperator
140+
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+80−114
@@ -1,52 +1,50 @@
1−{-# LANGUAGE CPP #-}
2module TutorialD.Interpreter.RelationalExpr where
1module TutorialD.Interpreter.RelationalExpr where
3import Text.Megaparsec
2import Text.Megaparsec
4−#if MIN_VERSION_megaparsec(7,0,0)
5−import Control.Monad.Combinators.Expr
6−#else
7import Text.Megaparsec.Expr
3import Text.Megaparsec.Expr
8−#endif
4+import Text.Megaparsec.Char
9import ProjectM36.Base
5import ProjectM36.Base
10import TutorialD.Interpreter.Base
6import TutorialD.Interpreter.Base
11import TutorialD.Interpreter.Types
7import TutorialD.Interpreter.Types
8+import TutorialD.Interpreter.DataTypes.DateTime
12import qualified Data.Text as T
9import qualified Data.Text as T
13import qualified Data.Set as S
10import qualified Data.Set as S
14import qualified Data.Map as M
11import qualified Data.Map as M
15import Data.List (sort)
12import Data.List (sort)
16import ProjectM36.MiscUtils
13import ProjectM36.MiscUtils
17
14
18−--used in projection
15+class RelationalMarkerExpr a where
19−attributeListP :: RelationalMarkerExpr a => Parser (AttributeNamesBase a)
16+ parseMarkerP :: Parser a
20−attributeListP =
21− (reservedOp "all but" >>
22− InvertedAttributeNames . S.fromList <$> sepBy attributeNameP comma) <|>
23−
24− (reservedOp "all from" >>
25− RelationalExprAttributeNames <$> relExprP) <|>
26
17
27− (reservedOp "union of" >>
18+instance RelationalMarkerExpr () where
28− UnionAttributeNames <$> braces attributeListP <*> braces attributeListP) <|>
19+ parseMarkerP = pure ()
29
20
30− (reservedOp "intersection of" >>
21+--used in projection
31− IntersectAttributeNames <$> braces attributeListP <*> braces attributeListP) <|>
22+attributeListP :: Parser AttributeNames
32−
23+attributeListP = do
33− (AttributeNames . S.fromList <$> sepBy attributeNameP comma)
24+ but <- try (string "all but " <* spaceConsumer) <|> string ""
34−
25+ let constructor = if but == "" then AttributeNames else InvertedAttributeNames
26+ attrs <- sepBy identifier comma
27+ pure $ constructor (S.fromList attrs)
35
28
36makeRelationP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)
29makeRelationP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)
37makeRelationP = do
30makeRelationP = do
38 reserved "relation"
31 reserved "relation"
39 attrExprs <- try (fmap Just makeAttributeExprsP) <|> pure Nothing
32 attrExprs <- try (fmap Just makeAttributeExprsP) <|> pure Nothing
40 tupleExprs <- braces (sepBy tupleExprP comma) <|> pure []
33 tupleExprs <- braces (sepBy tupleExprP comma) <|> pure []
41− marker <- parseMarkerP
42− pure $ MakeRelationFromExprs attrExprs (TupleExprs marker tupleExprs)
34+ pure $ MakeRelationFromExprs attrExprs tupleExprs
43
35
36+--used in relation creation
37+makeAttributeExprsP :: RelationalMarkerExpr a => Parser [AttributeExprBase a]
38+makeAttributeExprsP = braces (sepBy attributeAndTypeNameP comma)
44
39
40+attributeAndTypeNameP :: RelationalMarkerExpr a => Parser (AttributeExprBase a)
41+attributeAndTypeNameP = AttributeAndTypeNameExpr <$> identifier <*> typeConstructorP <*> parseMarkerP
42+
45--abstract data type parser- in this context, the type constructor must not include any type arguments
43--abstract data type parser- in this context, the type constructor must not include any type arguments
46--Either Text Int
44--Either Text Int
47adTypeConstructorP :: Parser TypeConstructor
45adTypeConstructorP :: Parser TypeConstructor
48adTypeConstructorP = do
46adTypeConstructorP = do
49− tConsName <- typeConstructorNameP
47+ tConsName <- capitalizedIdentifier
50 tConsArgs <- many typeConstructorP
48 tConsArgs <- many typeConstructorP
51 pure $ ADTypeConstructor tConsName tConsArgs
49 pure $ ADTypeConstructor tConsName tConsArgs
52
50
@@ -56,25 +54,27 @@ tupleExprP = do
56 attrAssocs <- braces (sepBy tupleAtomExprP comma)
54 attrAssocs <- braces (sepBy tupleAtomExprP comma)
57 --detect duplicate attribute names
55 --detect duplicate attribute names
58 let dupAttrNames = dupes (sort (map fst attrAssocs))
56 let dupAttrNames = dupes (sort (map fst attrAssocs))
59− if not (null dupAttrNames) then
57+ if not (null dupAttrNames) then
60 fail ("Attribute names duplicated: " ++ show dupAttrNames)
58 fail ("Attribute names duplicated: " ++ show dupAttrNames)
61 else
59 else
62 pure (TupleExpr (M.fromList attrAssocs))
60 pure (TupleExpr (M.fromList attrAssocs))
63
61
64tupleAtomExprP :: RelationalMarkerExpr a => Parser (AttributeName, AtomExprBase a)
62tupleAtomExprP :: RelationalMarkerExpr a => Parser (AttributeName, AtomExprBase a)
65tupleAtomExprP = do
63tupleAtomExprP = do
66− attributeName <- attributeNameP
64+ attributeName <- identifier
67 atomExpr <- atomExprP
65 atomExpr <- atomExprP
68 pure (attributeName, atomExpr)
66 pure (attributeName, atomExpr)
69−
67+
70−projectP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)
68+projectP :: Parser (RelationalExprBase a -> RelationalExprBase a)
69+projectP = do
71−projectP = Project <$> braces attributeListP
70+ attrs <- braces attributeListP
71+ pure $ Project attrs
72
72
73renameClauseP :: Parser (T.Text, T.Text)
73renameClauseP :: Parser (T.Text, T.Text)
74renameClauseP = do
74renameClauseP = do
75− oldAttr <- attributeNameP
75+ oldAttr <- identifier
76 reservedOp "as"
76 reservedOp "as"
77− newAttr <- attributeNameP
77+ newAttr <- identifier
78 pure (oldAttr, newAttr)
78 pure (oldAttr, newAttr)
79
79
80renameP :: Parser (RelationalExprBase a -> RelationalExprBase a)
80renameP :: Parser (RelationalExprBase a -> RelationalExprBase a)
@@ -83,20 +83,20 @@ renameP = do
83 renameList <- braces (sepBy renameClauseP comma)
83 renameList <- braces (sepBy renameClauseP comma)
84 case renameList of
84 case renameList of
85 [] -> pure (Restrict TruePredicate) --no-op when rename list is empty
85 [] -> pure (Restrict TruePredicate) --no-op when rename list is empty
86− renames ->
86+ renames ->
87 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
88
88
89whereClauseP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)
89whereClauseP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)
90whereClauseP = reservedOp "where" *> (Restrict <$> restrictionPredicateP)
90whereClauseP = reservedOp "where" *> (Restrict <$> restrictionPredicateP)
91
91
92−groupClauseP :: RelationalMarkerExpr a => Parser (AttributeNamesBase a, T.Text)
92+groupClauseP :: Parser (AttributeNames, T.Text)
93groupClauseP = do
93groupClauseP = do
94 attrs <- braces attributeListP
94 attrs <- braces attributeListP
95 reservedOp "as"
95 reservedOp "as"
96− newAttrName <- attributeNameP
96+ newAttrName <- identifier
97 pure (attrs, newAttrName)
97 pure (attrs, newAttrName)
98
98
99−groupP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)
99+groupP :: Parser (RelationalExprBase a -> RelationalExprBase a)
100groupP = do
100groupP = do
101 reservedOp "group"
101 reservedOp "group"
102 (groupAttrList, groupAttrName) <- parens groupClauseP
102 (groupAttrList, groupAttrName) <- parens groupClauseP
@@ -106,29 +106,14 @@ groupP = do
106ungroupP :: Parser (RelationalExprBase a -> RelationalExprBase a)
106ungroupP :: Parser (RelationalExprBase a -> RelationalExprBase a)
107ungroupP = do
107ungroupP = do
108 reservedOp "ungroup"
108 reservedOp "ungroup"
109− Ungroup <$> attributeNameP
109+ rvaAttrName <- identifier
110+ pure $ Ungroup rvaAttrName
110
111
111extendP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)
112extendP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)
112extendP = do
113extendP = do
113 reservedOp ":"
114 reservedOp ":"
114− extends <- braces (sepBy extendTupleExpressionP comma)
115+ tupleExpr <- braces extendTupleExpressionP
115− case extends of
116+ return $ Extend tupleExpr
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)))
132
117
133relOperators :: RelationalMarkerExpr a => [[Operator Parser (RelationalExprBase a)]]
118relOperators :: RelationalMarkerExpr a => [[Operator Parser (RelationalExprBase a)]]
134relOperators = [
119relOperators = [
@@ -138,27 +123,17 @@ relOperators = [
138 [Postfix groupP],
123 [Postfix groupP],
139 [Postfix ungroupP],
124 [Postfix ungroupP],
140 [InfixL (reservedOp "join" >> return Join)],
125 [InfixL (reservedOp "join" >> return Join)],
141− [InfixL semijoinP],
142− [InfixL antijoinP],
143 [InfixL (reservedOp "union" >> return Union)],
126 [InfixL (reservedOp "union" >> return Union)],
144 [InfixL (reservedOp "minus" >> return Difference)],
127 [InfixL (reservedOp "minus" >> return Difference)],
145− [InfixN (reservedOp "=" >> return Equals),
128+ [InfixN (reservedOp "=" >> return Equals)],
146− InfixN (reservedOp "/=" >> return NotEquals)],
147 [Postfix extendP]
129 [Postfix extendP]
148 ]
130 ]
149
131
150relExprP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)
132relExprP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)
151−relExprP = try withMacroExprP <|> makeExprParser relTerm relOperators
133+relExprP = makeExprParser relTerm relOperators
152−
153−--allow for additional characters
154−attributeNameP :: Parser AttributeName
155−attributeNameP = uncapitalizedIdentifier
156−
157−relVarNameP :: Parser RelVarName
158−relVarNameP = uncapitalizedIdentifier
159
134
160relVarP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)
135relVarP :: RelationalMarkerExpr a => Parser (RelationalExprBase a)
161−relVarP = RelationVariable <$> relVarNameP <*> parseMarkerP
136+relVarP = RelationVariable <$> identifier <*> parseMarkerP
162
137
163relTerm :: RelationalMarkerExpr a => Parser (RelationalExprBase a)
138relTerm :: RelationalMarkerExpr a => Parser (RelationalExprBase a)
164relTerm = parens relExprP
139relTerm = parens relExprP
@@ -176,23 +151,26 @@ restrictionPredicateP = makeExprParser predicateTerm predicateOperators
176 predicateTerm = try (parens restrictionPredicateP)
151 predicateTerm = try (parens restrictionPredicateP)
177 <|> try restrictionAtomExprP
152 <|> try restrictionAtomExprP
178 <|> try restrictionAttributeEqualityP
153 <|> try restrictionAttributeEqualityP
179− <|> relationalBooleanExprP
154+ <|> try relationalBooleanExprP
155+
180
156
181relationalBooleanExprP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)
157relationalBooleanExprP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)
182−relationalBooleanExprP =
158+relationalBooleanExprP = do
159+ relexpr <- parens relExprP <|> relTerm
183 --we can't actually detect if the type is relational boolean, so we just pass it to the next phase
160 --we can't actually detect if the type is relational boolean, so we just pass it to the next phase
184− RelationalExprPredicate <$> (parens relExprP <|> relTerm)
161+ return $ RelationalExprPredicate relexpr
185−
162+
186restrictionAttributeEqualityP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)
163restrictionAttributeEqualityP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)
187restrictionAttributeEqualityP = do
164restrictionAttributeEqualityP = do
188− attributeName <- attributeNameP
165+ attributeName <- identifier
189 reservedOp "="
166 reservedOp "="
167+ atomexpr <- atomExprP
190− AttributeEqualityPredicate attributeName <$> atomExprP
168+ return $ AttributeEqualityPredicate attributeName atomexpr
191
169
192restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"
170restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"
193restrictionAtomExprP = do
171restrictionAtomExprP = do
194 _ <- char '^' -- not ideal, but allows me to continue to use a context-free grammar
172 _ <- char '^' -- not ideal, but allows me to continue to use a context-free grammar
195− (try (char 't') >> pure TruePredicate) <|> (try (char 'f') >> pure (NotPredicate TruePredicate)) <|> AtomExprPredicate <$> atomExprP
173+ AtomExprPredicate <$> atomExprP
196
174
197multiTupleExpressionP :: RelationalMarkerExpr a => Parser [ExtendTupleExprBase a]
175multiTupleExpressionP :: RelationalMarkerExpr a => Parser [ExtendTupleExprBase a]
198multiTupleExpressionP = sepBy extendTupleExpressionP comma
176multiTupleExpressionP = sepBy extendTupleExpressionP comma
@@ -202,9 +180,10 @@ extendTupleExpressionP = attributeExtendTupleExpressionP
202
180
203attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)
181attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTupleExprBase a)
204attributeExtendTupleExpressionP = do
182attributeExtendTupleExpressionP = do
205− newAttr <- attributeNameP
183+ newAttr <- identifier
206 reservedOp ":="
184 reservedOp ":="
185+ atom <- atomExprP
207− AttributeExtendTupleExpr newAttr <$> atomExprP
186+ return $ AttributeExtendTupleExpr newAttr atom
208
187
209atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)
188atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)
210atomExprP = consumeAtomExprP True
189atomExprP = consumeAtomExprP True
@@ -214,34 +193,39 @@ consumeAtomExprP consume = try functionAtomExprP <|>
214 try (parens (constructedAtomExprP True)) <|>
193 try (parens (constructedAtomExprP True)) <|>
215 constructedAtomExprP consume <|>
194 constructedAtomExprP consume <|>
216 attributeAtomExprP <|>
195 attributeAtomExprP <|>
217− try nakedAtomExprP <|>
196+ nakedAtomExprP <|>
218 relationalAtomExprP
197 relationalAtomExprP
219−
220
198
221attributeAtomExprP :: Parser (AtomExprBase a)
199attributeAtomExprP :: Parser (AtomExprBase a)
222attributeAtomExprP = do
200attributeAtomExprP = do
223 _ <- string "@"
201 _ <- string "@"
202+ attrName <- identifier
224− AttributeAtomExpr <$> attributeNameP
203+ return $ AttributeAtomExpr attrName
225
204
226nakedAtomExprP :: Parser (AtomExprBase a)
205nakedAtomExprP :: Parser (AtomExprBase a)
227nakedAtomExprP = NakedAtomExpr <$> atomP
206nakedAtomExprP = NakedAtomExpr <$> atomP
228
207
229constructedAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)
208constructedAtomExprP :: RelationalMarkerExpr a => Bool -> Parser (AtomExprBase a)
230constructedAtomExprP consume = do
209constructedAtomExprP consume = do
231− dConsName <- dataConstructorNameP
210+ dConsName <- capitalizedIdentifier
232 dConsArgs <- if consume then sepBy (consumeAtomExprP False) spaceConsumer else pure []
211 dConsArgs <- if consume then sepBy (consumeAtomExprP False) spaceConsumer else pure []
212+ marker <- parseMarkerP
233− ConstructedAtomExpr dConsName dConsArgs <$> parseMarkerP
213+ pure $ ConstructedAtomExpr dConsName dConsArgs marker
234−
214+
235-- used only for primitive type parsing ?
215-- used only for primitive type parsing ?
236atomP :: Parser Atom
216atomP :: Parser Atom
237−atomP = stringAtomP <|>
217+atomP = stringAtomP <|>
218+ intAtomP <|>
238− try doubleAtomP <|>
219+ doubleAtomP <|>
239− integerAtomP <|>
240− boolAtomP
220+ boolAtomP <|>
241−
221+ dateTimeAtomP
222+
242functionAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)
223functionAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)
243−functionAtomExprP =
224+functionAtomExprP = do
225+ funcName <- identifier
244− FunctionAtomExpr <$> uncapitalizedIdentifier <*> parens (sepBy atomExprP comma) <*> parseMarkerP
226+ argList <- parens (sepBy atomExprP comma)
227+ marker <- parseMarkerP
228+ return $ FunctionAtomExpr funcName argList marker
245
229
246relationalAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)
230relationalAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)
247relationalAtomExprP = RelationAtomExpr <$> relExprP
231relationalAtomExprP = RelationAtomExpr <$> relExprP
@@ -249,36 +233,18 @@ relationalAtomExprP = RelationAtomExpr <$> relExprP
249stringAtomP :: Parser Atom
233stringAtomP :: Parser Atom
250stringAtomP = TextAtom <$> quotedString
234stringAtomP = TextAtom <$> quotedString
251
235
252−doubleAtomP :: Parser Atom
236+doubleAtomP :: Parser Atom
253doubleAtomP = DoubleAtom <$> float
237doubleAtomP = DoubleAtom <$> float
254
238
255−integerAtomP :: Parser Atom
239+intAtomP :: Parser Atom
256−integerAtomP = IntegerAtom <$> integer
240+intAtomP = do
241+ i <- try (integer <* notFollowedBy (char '.'))
242+ return $ IntAtom (fromIntegral i)
257
243
258boolAtomP :: Parser Atom
244boolAtomP :: Parser Atom
259boolAtomP = do
245boolAtomP = do
260− v <- identifier
246+ val <- char 't' <|> char 'f'
261− if v == "t" || v == "f" then
262− pure $ BoolAtom (v == "t")
247+ return $ BoolAtom (val == 't')
263− else
248+
264− fail "invalid boolAtom"
265−
266−
267relationAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)
249relationAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)
268relationAtomExprP = RelationAtomExpr <$> makeRelationP
250relationAtomExprP = 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+5−3
@@ -1,9 +1,11 @@
1module TutorialD.Interpreter.SchemaOperator where
1module TutorialD.Interpreter.SchemaOperator where
2import Text.Megaparsec
2import Text.Megaparsec
3+
3import ProjectM36.Base
4import ProjectM36.Base
4import ProjectM36.IsomorphicSchema
5import ProjectM36.IsomorphicSchema
5import ProjectM36.Session
6import ProjectM36.Session
6import ProjectM36.Client
7import ProjectM36.Client
8+import ProjectM36.Error
7import TutorialD.Interpreter.RelationalExpr
9import TutorialD.Interpreter.RelationalExpr
8import TutorialD.Interpreter.Base
10import TutorialD.Interpreter.Base
9
11
@@ -42,7 +44,7 @@ isoRestrictP = do
42 reserved "isorestrict"
44 reserved "isorestrict"
43 relVarIn <- qrelVarP
45 relVarIn <- qrelVarP
44 relvarsOut <- isoRestrictOutRelVarsP
46 relvarsOut <- isoRestrictOutRelVarsP
45− IsoRestrict relVarIn <$> restrictionPredicateP <*> pure relvarsOut
47+ IsoRestrict <$> pure relVarIn <*> restrictionPredicateP <*> pure relvarsOut
46
48
47isoRestrictOutRelVarsP :: Parser (RelVarName, RelVarName)
49isoRestrictOutRelVarsP :: Parser (RelVarName, RelVarName)
48isoRestrictOutRelVarsP = (,) <$> qrelVarP <*> qrelVarP
50isoRestrictOutRelVarsP = (,) <$> qrelVarP <*> qrelVarP
@@ -55,7 +57,7 @@ isoUnionP = do
55 reserved "isounion"
57 reserved "isounion"
56 relVarsIn <- isoUnionInRelVarsP
58 relVarsIn <- isoUnionInRelVarsP
57 relVarsOut <- qrelVarP
59 relVarsOut <- qrelVarP
58− IsoUnion relVarsIn <$> restrictionPredicateP <*> pure relVarsOut
60+ IsoUnion <$> pure relVarsIn <*> restrictionPredicateP <*> pure relVarsOut
59
61
60isoRenameP :: Parser SchemaIsomorph
62isoRenameP :: Parser SchemaIsomorph
61isoRenameP = do
63isoRenameP = do
@@ -74,4 +76,4 @@ isoUnionInRelVarsP = (,) <$> qrelVarP <*> qrelVarP
74evalSchemaOperator :: SessionId -> Connection -> SchemaOperator -> IO (Either RelationalError ())
76evalSchemaOperator :: SessionId -> Connection -> SchemaOperator -> IO (Either RelationalError ())
75evalSchemaOperator sessionId conn (ModifySchemaExpr expr) = executeSchemaExpr sessionId conn expr
77evalSchemaOperator sessionId conn (ModifySchemaExpr expr) = executeSchemaExpr sessionId conn expr
76evalSchemaOperator sessionId conn (SetCurrentSchema sname) = setCurrentSchemaName sessionId conn sname
78evalSchemaOperator sessionId conn (SetCurrentSchema sname) = setCurrentSchemaName sessionId conn sname
77−
79+
src/bin/TutorialD/Interpreter/TransGraphRelationalOperator.hs+10−7
@@ -1,19 +1,21 @@
1−{-# LANGUAGE FlexibleInstances #-}
1+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3module TutorialD.Interpreter.TransGraphRelationalOperator where
3module TutorialD.Interpreter.TransGraphRelationalOperator where
4import ProjectM36.TransGraphRelationalExpression
4import ProjectM36.TransGraphRelationalExpression
5import ProjectM36.TransactionGraph
5import ProjectM36.TransactionGraph
6−import TutorialD.Interpreter.Types
7import qualified ProjectM36.Client as C
6import qualified ProjectM36.Client as C
8
7
9import TutorialD.Interpreter.Base
8import TutorialD.Interpreter.Base
10import TutorialD.Interpreter.RelationalExpr
9import TutorialD.Interpreter.RelationalExpr
11
10
11+import Text.Megaparsec
12+import Text.Megaparsec.Char
13+
12import qualified Data.Text as T
14import qualified Data.Text as T
13
15
14instance RelationalMarkerExpr TransactionIdLookup where
16instance RelationalMarkerExpr TransactionIdLookup where
15 parseMarkerP = string "@" *> transactionIdLookupP
17 parseMarkerP = string "@" *> transactionIdLookupP
16−
18+
17newtype TransGraphRelationalOperator = ShowTransGraphRelation TransGraphRelationalExpr
19newtype TransGraphRelationalOperator = ShowTransGraphRelation TransGraphRelationalExpr
18 deriving Show
20 deriving Show
19
21
@@ -23,11 +25,12 @@ transactionIdLookupP = (TransactionIdLookup <$> uuidP) <|>
23
25
24transactionIdHeadBacktrackP :: Parser TransactionIdHeadBacktrack
26transactionIdHeadBacktrackP :: Parser TransactionIdHeadBacktrack
25transactionIdHeadBacktrackP = (string "~" *> (TransactionIdHeadParentBacktrack <$> backtrackP)) <|>
27transactionIdHeadBacktrackP = (string "~" *> (TransactionIdHeadParentBacktrack <$> backtrackP)) <|>
26− (string "^" *> (TransactionIdHeadBranchBacktrack <$> backtrackP)) <|>
28+ (string "^" *> (TransactionIdHeadBranchBacktrack <$> backtrackP))
27− (string "@" *> (TransactionStampHeadBacktrack <$> utcTimeP))
28
29
29backtrackP :: Parser Int
30backtrackP :: Parser Int
31+backtrackP = do
30−backtrackP = fromIntegral <$> integer <|> pure 1
32+ steps <- integer <|> pure 1
33+ pure (fromIntegral steps)
31
34
32transGraphRelationalOpP :: Parser TransGraphRelationalOperator
35transGraphRelationalOpP :: Parser TransGraphRelationalOperator
33transGraphRelationalOpP = showTransGraphRelationalOpP
36transGraphRelationalOpP = showTransGraphRelationalOpP
@@ -43,4 +46,4 @@ evalTransGraphRelationalOp sessionId conn (ShowTransGraphRelation expr) = do
43 case res of
46 case res of
44 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
47 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
45 Right rel -> pure $ DisplayRelationResult rel
48 Right rel -> pure $ DisplayRelationResult rel
46−
49+
src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+20−40
@@ -1,42 +1,29 @@
1{-# LANGUAGE GADTs #-}
1{-# LANGUAGE GADTs #-}
2module TutorialD.Interpreter.TransactionGraphOperator where
2module TutorialD.Interpreter.TransactionGraphOperator where
3import TutorialD.Interpreter.Base
3import TutorialD.Interpreter.Base
4+import Text.Megaparsec
4−import ProjectM36.TransactionGraph hiding (autoMergeToHead)
5+import ProjectM36.TransactionGraph
5−import ProjectM36.Client as C
6+import ProjectM36.Client
7+import ProjectM36.Error
6import ProjectM36.Base
8import ProjectM36.Base
7−import ProjectM36.Relation (relationTrue)
8−import Data.Functor
9−
10−data ConvenienceTransactionGraphOperator = AutoMergeToHead MergeStrategy HeadName
11− deriving (Show)
12−
13−convenienceTransactionGraphOpP :: Parser ConvenienceTransactionGraphOperator
14−convenienceTransactionGraphOpP = autoMergeToHeadP
15−
16−autoMergeToHeadP :: Parser ConvenienceTransactionGraphOperator
17−autoMergeToHeadP = do
18− reserved ":automergetohead"
19− AutoMergeToHead <$> mergeTransactionStrategyP <*> identifier
20
9
21jumpToHeadP :: Parser TransactionGraphOperator
10jumpToHeadP :: Parser TransactionGraphOperator
22jumpToHeadP = do
11jumpToHeadP = do
23 reservedOp ":jumphead"
12 reservedOp ":jumphead"
13+ headid <- identifier
24− JumpToHead <$> identifier
14+ return $ JumpToHead headid
25
15
26jumpToTransactionP :: Parser TransactionGraphOperator
16jumpToTransactionP :: Parser TransactionGraphOperator
27jumpToTransactionP = do
17jumpToTransactionP = do
28 reservedOp ":jump"
18 reservedOp ":jump"
19+ uuid <- uuidP
29− JumpToTransaction <$> uuidP
20+ return $ JumpToTransaction uuid
30−
31−walkBackToTimeP :: Parser TransactionGraphOperator
32−walkBackToTimeP = do
33− reservedOp ":walkbacktotime"
34− WalkBackToTime <$> utcTimeP
35
21
36branchTransactionP :: Parser TransactionGraphOperator
22branchTransactionP :: Parser TransactionGraphOperator
37branchTransactionP = do
23branchTransactionP = do
38 reservedOp ":branch"
24 reservedOp ":branch"
39− Branch <$> identifier
25+ branchName <- identifier
26+ return $ Branch branchName
40
27
41deleteBranchP :: Parser TransactionGraphOperator
28deleteBranchP :: Parser TransactionGraphOperator
42deleteBranchP = do
29deleteBranchP = do
@@ -59,27 +46,28 @@ showGraphP = do
59 return ShowGraph
46 return ShowGraph
60
47
61mergeTransactionStrategyP :: Parser MergeStrategy
48mergeTransactionStrategyP :: Parser MergeStrategy
62−mergeTransactionStrategyP = (reserved "union" $> UnionMergeStrategy) <|>
49+mergeTransactionStrategyP = (reserved "union" *> pure UnionMergeStrategy) <|>
63 (do
50 (do
64 reserved "selectedbranch"
51 reserved "selectedbranch"
65− SelectedBranchMergeStrategy <$> identifier) <|>
52+ branch <- identifier
53+ pure (SelectedBranchMergeStrategy branch)) <|>
66 (do
54 (do
67 reserved "unionpreferbranch"
55 reserved "unionpreferbranch"
68− UnionPreferMergeStrategy <$> identifier)
56+ branch <- identifier
57+ pure (UnionPreferMergeStrategy branch))
69
58
70mergeTransactionsP :: Parser TransactionGraphOperator
59mergeTransactionsP :: Parser TransactionGraphOperator
71mergeTransactionsP = do
60mergeTransactionsP = do
72 reservedOp ":mergetrans"
61 reservedOp ":mergetrans"
73− MergeTransactions <$> mergeTransactionStrategyP <*> identifier <*> identifier
62+ strategy <- mergeTransactionStrategyP
74−
63+ headA <- identifier
75−validateMerkleHashesP :: Parser ROTransactionGraphOperator
64+ headB <- identifier
76−validateMerkleHashesP = reservedOp ":validatemerklehashes" $> ValidateMerkleHashes
65+ pure (MergeTransactions strategy headA headB)
77
66
78transactionGraphOpP :: Parser TransactionGraphOperator
67transactionGraphOpP :: Parser TransactionGraphOperator
79transactionGraphOpP =
68transactionGraphOpP =
80 jumpToHeadP
69 jumpToHeadP
81 <|> jumpToTransactionP
70 <|> jumpToTransactionP
82− <|> walkBackToTimeP
83 <|> branchTransactionP
71 <|> branchTransactionP
84 <|> deleteBranchP
72 <|> deleteBranchP
85 <|> commitTransactionP
73 <|> commitTransactionP
@@ -87,7 +75,7 @@ transactionGraphOpP =
87 <|> mergeTransactionsP
75 <|> mergeTransactionsP
88
76
89roTransactionGraphOpP :: Parser ROTransactionGraphOperator
77roTransactionGraphOpP :: Parser ROTransactionGraphOperator
90−roTransactionGraphOpP = showGraphP <|> validateMerkleHashesP
78+roTransactionGraphOpP = showGraphP
91
79
92
80
93
81
@@ -105,11 +93,3 @@ interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instri
105
93
106evalROGraphOp :: SessionId -> Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)
94evalROGraphOp :: SessionId -> Connection -> ROTransactionGraphOperator -> IO (Either RelationalError Relation)
107evalROGraphOp sessionId conn ShowGraph = transactionGraphAsRelation sessionId conn
95evalROGraphOp 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−
114−evalConvenienceGraphOp :: SessionId -> Connection -> ConvenienceTransactionGraphOperator -> IO (Either RelationalError ())
115−evalConvenienceGraphOp sessionId conn (AutoMergeToHead strat head') = autoMergeToHead sessionId conn strat head'
src/bin/TutorialD/Interpreter/Types.hs+19−32
@@ -3,58 +3,45 @@ module TutorialD.Interpreter.Types where
3import ProjectM36.Base
3import ProjectM36.Base
4import Text.Megaparsec
4import Text.Megaparsec
5import TutorialD.Interpreter.Base
5import TutorialD.Interpreter.Base
6−
6+import ProjectM36.DataTypes.Primitive
7−class RelationalMarkerExpr a where
8− parseMarkerP :: Parser a
9−
10−instance RelationalMarkerExpr () where
11− parseMarkerP = pure ()
12−
13−typeConstructorNameP :: Parser TypeConstructorName
14−typeConstructorNameP = capitalizedIdentifier
15−
16−dataConstructorNameP :: Parser DataConstructorName
17−dataConstructorNameP = capitalizedIdentifier
18
7
19-- | Upper case names are type names while lower case names are polymorphic typeconstructor arguments.
8-- | Upper case names are type names while lower case names are polymorphic typeconstructor arguments.
20-- data *Either a b* = Left a | Right b
9-- data *Either a b* = Left a | Right b
21typeConstructorDefP :: Parser TypeConstructorDef
10typeConstructorDefP :: Parser TypeConstructorDef
22−typeConstructorDefP = ADTypeConstructorDef <$> typeConstructorNameP <*> typeVarNamesP
11+typeConstructorDefP = ADTypeConstructorDef <$> capitalizedIdentifier <*> typeVarNamesP
23
12
24typeVarNamesP :: Parser [TypeVarName]
13typeVarNamesP :: Parser [TypeVarName]
25typeVarNamesP = many uncapitalizedIdentifier
14typeVarNamesP = many uncapitalizedIdentifier
26
15
27-- data Either a b = *Left a* | *Right b*
16-- data Either a b = *Left a* | *Right b*
28dataConstructorDefP :: Parser DataConstructorDef
17dataConstructorDefP :: Parser DataConstructorDef
29−dataConstructorDefP = DataConstructorDef <$> typeConstructorNameP <*> many dataConstructorDefArgP
18+dataConstructorDefP = DataConstructorDef <$> capitalizedIdentifier <*> many dataConstructorDefArgP
30
19
31-- data *Either a b* = Left *a* | Right *b*
20-- data *Either a b* = Left *a* | Right *b*
32dataConstructorDefArgP :: Parser DataConstructorDefArg
21dataConstructorDefArgP :: Parser DataConstructorDefArg
33−dataConstructorDefArgP = DataConstructorDefTypeConstructorArg <$> (monoTypeConstructorP <|> parens typeConstructorP) <|>
22+dataConstructorDefArgP = parens (DataConstructorDefTypeConstructorArg <$> typeConstructorP) <|>
23+ DataConstructorDefTypeConstructorArg <$> typeConstructorP <|>
34 DataConstructorDefTypeVarNameArg <$> uncapitalizedIdentifier
24 DataConstructorDefTypeVarNameArg <$> uncapitalizedIdentifier
35
25
36−-- relation{a Int} in type construction (no tuples parsed)
26+--built-in, nullary type constructors
27+-- Int, Text, etc.
37−relationTypeConstructorP :: Parser TypeConstructor
28+primitiveTypeConstructorP :: Parser TypeConstructor
38−relationTypeConstructorP = do
29+primitiveTypeConstructorP = choice (map (\(PrimitiveTypeConstructorDef name typ, _) -> do
39− reserved "relation"
30+ tName <- try $ symbol name
40− RelationAtomTypeConstructor <$> makeAttributeExprsP
31+ pure $ PrimitiveTypeConstructor tName typ)
41−
32+ primitiveTypeConstructorMapping)
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
48
33
49-- *Either Int Text*, *Int*
34-- *Either Int Text*, *Int*
50typeConstructorP :: Parser TypeConstructor
35typeConstructorP :: Parser TypeConstructor
51−typeConstructorP = relationTypeConstructorP <|>
36+typeConstructorP = primitiveTypeConstructorP <|>
37+ TypeVariable <$> uncapitalizedIdentifier <|>
52− ADTypeConstructor <$> capitalizedIdentifier <*> many (monoTypeConstructorP <|> parens typeConstructorP) <|>
38+ ADTypeConstructor <$> capitalizedIdentifier <*> many (parens typeConstructorP <|>
53− monoTypeConstructorP
39+ monoTypeConstructorP)
54
40
55monoTypeConstructorP :: Parser TypeConstructor
41monoTypeConstructorP :: Parser TypeConstructor
42+monoTypeConstructorP = primitiveTypeConstructorP <|>
56−monoTypeConstructorP = ADTypeConstructor <$> typeConstructorNameP <*> pure [] <|>
43+ ADTypeConstructor <$> capitalizedIdentifier <*> pure [] <|>
57− TypeVariable <$> uncapitalizedIdentifier
44+ TypeVariable <$> uncapitalizedIdentifier
58
45
59
46
60
47
src/bin/TutorialD/Printer.hsdeleted−165
@@ -1,165 +0,0 @@
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+62−71
@@ -2,109 +2,100 @@
2import TutorialD.Interpreter
2import TutorialD.Interpreter
3import ProjectM36.Base
3import ProjectM36.Base
4import ProjectM36.Client
4import ProjectM36.Client
5−import ProjectM36.Server.ParseArgs
6−import ProjectM36.Server
7import System.IO
5import System.IO
8−import GHC.IO.Encoding
9import Options.Applicative
6import Options.Applicative
10import System.Exit
7import System.Exit
11−import Control.Monad
12−#if __GLASGOW_HASKELL__ < 804
13import Data.Monoid
8import Data.Monoid
14−#endif
15−import Data.Maybe
16−import qualified Data.Text as T
17−
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
9
23parseArgs :: Parser InterpreterConfig
10parseArgs :: Parser InterpreterConfig
24−parseArgs = LocalInterpreterConfig <$> parsePersistenceStrategy <*> parseHeadName <*> parseTutDExec <*> many parseGhcPkgPath <*> parseCheckFS <|>
11+parseArgs = LocalInterpreterConfig <$> parsePersistenceStrategy <*> parseHeadName <*> parseGhcPkgPaths <|>
25− RemoteInterpreterConfig <$> parseHostname "127.0.0.1" <*> parsePort defaultServerPort <*> parseDatabaseName <*> parseHeadName <*> parseTutDExec <*> parseCheckFS
12+ RemoteInterpreterConfig <$> parseNodeId <*> parseDatabaseName <*> parseHeadName
26
13
14+parsePersistenceStrategy :: Parser PersistenceStrategy
15+parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>
16+ MinimalPersistence <$> dbdirOpt <|>
17+ pure NoPersistence
18+ where
19+ dbdirOpt = strOption (short 'd' <>
20+ long "database-directory" <>
21+ metavar "DIRECTORY" <>
22+ showDefaultWith show
23+ )
24+ fsyncOpt = switch (short 'f' <>
25+ long "fsync" <>
26+ help "Fsync all new transactions.")
27+
27parseHeadName :: Parser HeadName
28parseHeadName :: Parser HeadName
28parseHeadName = option auto (long "head" <>
29parseHeadName = option auto (long "head" <>
29 help "Start session at head name." <>
30 help "Start session at head name." <>
30− metavar "GRAPH HEAD NAME" <>
31 value "master"
31 value "master"
32 )
32 )
33−
33+
34−--just execute some tutd and exit
34+parseDatabaseName :: Parser DatabaseName
35−parseTutDExec :: Parser (Maybe TutorialDExec)
35+parseDatabaseName = strOption (long "database" <>
36+ short 'n' <>
37+ help "Remote database name")
38+
39+parseNodeId :: Parser NodeId
40+parseNodeId = createNodeId <$>
36−parseTutDExec = optional $ strOption (long "exec-tutd" <>
41+ strOption (long "host" <>
37− short 'e' <>
42+ short 'h' <>
38− metavar "TUTORIALD" <>
43+ help "Remote host name" <>
39− help "Execute TutorialD expression and exit"
44+ value "127.0.0.1") <*>
40− )
45+ option auto (long "port" <>
46+ short 'p' <>
47+ help "Remote port" <>
48+ value defaultServerPort)
49+
50+parseGhcPkgPaths :: Parser [GhcPkgPath]
51+parseGhcPkgPaths = many (strOption (long "ghc-pkg-dir" <>
52+ metavar "GHC_PACKAGE_DIRECTORY"))
41
53
42opts :: ParserInfo InterpreterConfig
54opts :: ParserInfo InterpreterConfig
43−opts = info (parseArgs <**> helpOption) idm
55+opts = info parseArgs idm
44
56
45connectionInfoForConfig :: InterpreterConfig -> ConnectionInfo
57connectionInfoForConfig :: InterpreterConfig -> ConnectionInfo
46−connectionInfoForConfig (LocalInterpreterConfig pStrategy _ _ ghcPkgPaths _) = InProcessConnectionInfo pStrategy outputNotificationCallback ghcPkgPaths
58+connectionInfoForConfig (LocalInterpreterConfig pStrategy _ ghcPkgPaths) = InProcessConnectionInfo pStrategy outputNotificationCallback ghcPkgPaths
47−connectionInfoForConfig (RemoteInterpreterConfig remoteHost remotePort remoteDBName _ _ _) = RemoteConnectionInfo remoteDBName remoteHost (show remotePort) outputNotificationCallback
59+connectionInfoForConfig (RemoteInterpreterConfig remoteNodeId remoteDBName _) = RemoteProcessConnectionInfo remoteDBName remoteNodeId outputNotificationCallback
48
60
49headNameForConfig :: InterpreterConfig -> HeadName
61headNameForConfig :: InterpreterConfig -> HeadName
50−headNameForConfig (LocalInterpreterConfig _ headn _ _ _) = headn
62+headNameForConfig (LocalInterpreterConfig _ headn _) = headn
51−headNameForConfig (RemoteInterpreterConfig _ _ _ headn _ _) = headn
63+headNameForConfig (RemoteInterpreterConfig _ _ headn) = headn
52−
53−execTutDForConfig :: InterpreterConfig -> Maybe String
54−execTutDForConfig (LocalInterpreterConfig _ _ t _ _) = t
55−execTutDForConfig (RemoteInterpreterConfig _ _ _ _ t _) = t
56−
57−checkFSForConfig :: InterpreterConfig -> Bool
58−checkFSForConfig (LocalInterpreterConfig _ _ _ _ c) = c
59−checkFSForConfig (RemoteInterpreterConfig _ _ _ _ _ c) = c
60
64
61−persistenceStrategyForConfig :: InterpreterConfig -> Maybe PersistenceStrategy
65+{-
62−persistenceStrategyForConfig (LocalInterpreterConfig strat _ _ _ _) = Just strat
66+ghcPkgPathsForConfig :: InterpreterConfig -> [GhcPkgPath]
63−persistenceStrategyForConfig RemoteInterpreterConfig{} = Nothing
67+ghcPkgPathsForConfig (LocalInterpreterConfig _ _ paths) = paths
68+ghcPkgPathsForConfig _ = error "Clients cannot configure remote ghc package paths."
69+-}
64
70
65errDie :: String -> IO ()
71errDie :: String -> IO ()
66errDie err = hPutStrLn stderr err >> exitFailure
72errDie err = hPutStrLn stderr err >> exitFailure
67
73
68−#ifndef VERSION_project_m36
74+#ifndef PROJECTM36_VERSION
69−#error VERSION_project_m36 is not defined
75+#error PROJECTM36_VERSION is not defined
70#endif
76#endif
71printWelcome :: IO ()
77printWelcome :: IO ()
72printWelcome = do
78printWelcome = do
73− putStrLn $ "Project:M36 TutorialD Interpreter " ++ VERSION_project_m36
79+ putStrLn $ "Project:M36 TutorialD Interpreter " ++ PROJECTM36_VERSION
74 putStrLn "Type \":help\" for more information."
80 putStrLn "Type \":help\" for more information."
75 putStrLn "A full tutorial is available at:"
81 putStrLn "A full tutorial is available at:"
76 putStrLn "https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown"
82 putStrLn "https://github.com/agentm/project-m36/blob/master/docs/tutd_tutorial.markdown"
77
83
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−
84main :: IO ()
84main :: IO ()
85main = do
85main = do
86− setLocaleIfNecessary
87 interpreterConfig <- execParser opts
86 interpreterConfig <- execParser opts
88 let connInfo = connectionInfoForConfig interpreterConfig
87 let connInfo = connectionInfoForConfig interpreterConfig
89− fscheck <- checkFSType (checkFSForConfig interpreterConfig) (fromMaybe NoPersistence (persistenceStrategyForConfig interpreterConfig))
90− if not fscheck then
91− errDie checkFSErrorMsg
92− else do
93− dbconn <- connectProjectM36 connInfo
88+ dbconn <- connectProjectM36 connInfo
94− case dbconn of
89+ case dbconn of
95− Left err ->
90+ Left err ->
96− errDie ("Failed to create database connection: " ++ show err)
91+ errDie ("Failed to create database connection: " ++ show err)
97− Right conn -> do
92+ Right conn -> do
98− let connHeadName = headNameForConfig interpreterConfig
93+ let connHeadName = headNameForConfig interpreterConfig
99− eSessionId <- createSessionAtHead conn connHeadName
94+ eSessionId <- createSessionAtHead conn connHeadName
100− case eSessionId of
95+ case eSessionId of
101− Left err -> errDie ("Failed to create database session at \"" ++ show connHeadName ++ "\": " ++ show err)
96+ Left err -> errDie ("Failed to create database session at \"" ++ show connHeadName ++ "\": " ++ show err)
102− Right sessionId ->
97+ Right sessionId -> do
103− case execTutDForConfig interpreterConfig of
104− Nothing -> do
105− printWelcome
98+ printWelcome
106− _ <- reprLoop interpreterConfig sessionId conn
99+ _ <- reprLoop interpreterConfig sessionId conn
107− pure ()
100+ pure ()
108− Just tutdStr ->
109− runTutorialD sessionId conn Nothing (T.pack tutdStr)
110
101
src/bin/benchmark/Basic.hsdeleted−106
@@ -1,106 +0,0 @@
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.hsdeleted−97
@@ -1,97 +0,0 @@
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+22−45
@@ -1,39 +1,33 @@
1−{-# LANGUAGE FlexibleInstances, CPP #-}
1+{-# LANGUAGE FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3import ProjectM36.Base
3import ProjectM36.Base
4import ProjectM36.Relation
4import ProjectM36.Relation
5import ProjectM36.DateExamples
5import ProjectM36.DateExamples
6import ProjectM36.Error
6import ProjectM36.Error
7−import ProjectM36.StaticOptimizer
8import qualified ProjectM36.Attribute as A
7import qualified ProjectM36.Attribute as A
9import qualified Data.Text as T
8import qualified Data.Text as T
10−--import ProjectM36.Relation.Show.CSV
9+import ProjectM36.Relation.Show.CSV
11import ProjectM36.Relation.Show.HTML
10import ProjectM36.Relation.Show.HTML
11+import TutorialD.Interpreter.DatabaseContextExpr (interpretDatabaseContextExpr)
12import ProjectM36.RelationalExpression
12import ProjectM36.RelationalExpression
13−import ProjectM36.TransactionGraph
14−--import qualified Data.HashSet as HS
13+import qualified Data.HashSet as HS
15−--import qualified Data.ByteString.Lazy.Char8 as BS
14+import qualified Data.ByteString.Lazy.Char8 as BS
16−--import qualified Data.IntMap as IM
15+import qualified Data.IntMap as IM
17−--import qualified Data.Hashable as Hash
16+import qualified Data.Hashable as Hash
18import qualified Data.Vector as V
17import qualified Data.Vector as V
19import Options.Applicative
18import Options.Applicative
19+import qualified Data.Map as M
20import qualified Data.Text.IO as TIO
20import qualified Data.Text.IO as TIO
21import System.IO
21import System.IO
22+import Control.Monad.State
22import Control.DeepSeq
23import Control.DeepSeq
23import Data.Text hiding (map)
24import Data.Text hiding (map)
24−import Data.Time.Clock
25−import Data.UUID.V4
26−#if __GLASGOW_HASKELL__ < 804
27import Data.Monoid
25import Data.Monoid
28−#endif
29
26
30−
31−{-
32dumpcsv :: Relation -> IO ()
27dumpcsv :: Relation -> IO ()
33dumpcsv rel = case relationAsCSV rel of
28dumpcsv rel = case relationAsCSV rel of
34 Left err -> hPrint stderr err
29 Left err -> hPrint stderr err
35 Right bsData -> BS.putStrLn bsData
30 Right bsData -> BS.putStrLn bsData
36−-}
37
31
38data BigrelArgs = BigrelArgs Int Int Text
32data BigrelArgs = BigrelArgs Int Int Text
39
33
@@ -64,69 +58,52 @@ matrixRun (BigrelArgs attributeCount tupleCount tutd) =
64 Right rel -> if tutd == "" then
58 Right rel -> if tutd == "" then
65 putStrLn "Done."
59 putStrLn "Done."
66 else do
60 else do
67− now <- getCurrentTime
68− tid <- nextRandom
69 let setx = Assign "x" (ExistingRelation (force rel))
61 let setx = Assign "x" (ExistingRelation (force rel))
70− graph = bootstrapTransactionGraph now tid dateExamples
62+ (context,_,_) = execState (evalDatabaseContextExpr setx) (freshDatabaseState dateExamples)
71− env = mkDatabaseContextEvalEnv tid graph
63+ interpreted = interpretDatabaseContextExpr context tutd
72− eNewState = runDatabaseContextEvalMonad dateExamples env (optimizeAndEvalDatabaseContextExpr True setx)
73 --plan = interpretRODatabaseContextOp context $ ":showplan " ++ tutd
64 --plan = interpretRODatabaseContextOp context $ ":showplan " ++ tutd
74 --displayOpResult plan
65 --displayOpResult plan
75− case eNewState of
66+ case interpreted of
76− Right newState -> do
77− let ctx = dbc_context newState
78− Right x = optimizeAndEvalRelationalExpr env' (RelationVariable "x" ())
79− env' = RelationalExprEnv ctx graph Nothing
80− TIO.putStrLn $ relationAsHTML x
67+ Right context' -> TIO.putStrLn $ relationAsHTML (relationVariables context' M.! "x")
81 Left err -> hPrint stderr err
68 Left err -> hPrint stderr err
82
69
83−{-
70+
84intmapMatrixRun :: IO ()
71intmapMatrixRun :: IO ()
85intmapMatrixRun = do
72intmapMatrixRun = do
86 let matrix = intmapMatrixRelation 100 100000
73 let matrix = intmapMatrixRelation 100 100000
87 print matrix
74 print matrix
88−-}
89
75
90--compare IntMap speed and size
76--compare IntMap speed and size
91--this is about 3 times faster (9 minutes) for 10x100000 and uses 800 MB
77--this is about 3 times faster (9 minutes) for 10x100000 and uses 800 MB
92−{-
93intmapMatrixRelation :: Int -> Int -> HS.HashSet (IM.IntMap Atom)
78intmapMatrixRelation :: Int -> Int -> HS.HashSet (IM.IntMap Atom)
94intmapMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]
79intmapMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]
95 where
80 where
96− mapper tupCount = IM.fromList $ map (\c-> (c, IntAtom (fromIntegral tupCount))) [0..attributeCount]
81+ mapper tupCount = IM.fromList $ map (\c-> (c, IntAtom tupCount)) [0..attributeCount]
97−-}
82+
98−-- instance Hash.Hashable (IM.IntMap Atom) where
83+instance Hash.Hashable (IM.IntMap Atom) where
99−-- hashWithSalt salt tupMap = Hash.hashWithSalt salt (show tupMap)
84+ hashWithSalt salt tupMap = Hash.hashWithSalt salt (show tupMap)
100
85
101−{-
102vectorMatrixRun :: IO ()
86vectorMatrixRun :: IO ()
103vectorMatrixRun = do
87vectorMatrixRun = do
104 let matrix = vectorMatrixRelation 100 100000
88 let matrix = vectorMatrixRelation 100 100000
105 print matrix
89 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
90
112-- 20 s 90 MBs- a clear win- ideal size is 10 * 100000 * 8 bytes = 80 MB! without IntAtom wrapper
91-- 20 s 90 MBs- a clear win- ideal size is 10 * 100000 * 8 bytes = 80 MB! without IntAtom wrapper
113--with IntAtom wrapper: 1m12s 90 MB
92--with IntAtom wrapper: 1m12s 90 MB
114−{-
115−
116vectorMatrixRelation :: Int -> Int -> HS.HashSet (V.Vector Atom)
93vectorMatrixRelation :: Int -> Int -> HS.HashSet (V.Vector Atom)
117vectorMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]
94vectorMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]
118 where
95 where
119− mapper tupCount = V.replicate attributeCount (IntAtom (fromIntegral tupCount))
96+ mapper tupCount = V.replicate attributeCount (IntAtom tupCount)
120−-}
97+
121instance Hash.Hashable (V.Vector Atom) where
98instance Hash.Hashable (V.Vector Atom) where
122 hashWithSalt salt vec = Hash.hashWithSalt salt (show vec)
99 hashWithSalt salt vec = Hash.hashWithSalt salt (show vec)
123−-}
100+
124-- returns a relation with tupleCount tuples with a set of integer attributes attributesCount long
101-- returns a relation with tupleCount tuples with a set of integer attributes attributesCount long
125-- this is useful for performance and resource usage testing
102-- this is useful for performance and resource usage testing
126matrixRelation :: Int -> Int -> Either RelationalError Relation
103matrixRelation :: Int -> Int -> Either RelationalError Relation
127matrixRelation attributeCount tupleCount = do
104matrixRelation attributeCount tupleCount = do
128 let attrs = A.attributesFromList $ map (\c-> Attribute (T.pack $ "a" ++ show c) IntAtomType) [0 .. attributeCount-1]
105 let attrs = A.attributesFromList $ map (\c-> Attribute (T.pack $ "a" ++ show c) IntAtomType) [0 .. attributeCount-1]
129− tuple tupleX = RelationTuple attrs (V.generate attributeCount (\_ -> IntAtom (fromIntegral tupleX)))
106+ tuple tupleX = RelationTuple attrs (V.generate attributeCount (\_ -> IntAtom tupleX))
130 tuples = map tuple [0 .. tupleCount]
107 tuples = map tuple [0 .. tupleCount]
131 mkRelationDeferVerify attrs (RelationTupleSet tuples)
108 mkRelationDeferVerify attrs (RelationTupleSet tuples)
132
109
src/lib/ProjectM36/Arbitrary.hsdeleted−127
@@ -1,127 +0,0 @@
1−{-# LANGUAGE ExistentialQuantification,FlexibleInstances,OverloadedStrings #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
3−
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+16−26
@@ -1,46 +1,36 @@
1module ProjectM36.Atom where
1module ProjectM36.Atom where
2import ProjectM36.Base
2import ProjectM36.Base
3import ProjectM36.Error
3import ProjectM36.Error
4−import ProjectM36.DataTypes.Interval
5import qualified Data.Text as T
4import qualified Data.Text as T
6−#if __GLASGOW_HASKELL__ < 804
5+--import Data.Time.Calendar
6+--import Data.Time.Clock
7−import Data.Monoid
7+--import Data.ByteString (ByteString)
8−#endif
8+import Text.Read
9
9
10relationForAtom :: Atom -> Either RelationalError Relation
10relationForAtom :: Atom -> Either RelationalError Relation
11relationForAtom (RelationAtom rel) = Right rel
11relationForAtom (RelationAtom rel) = Right rel
12relationForAtom _ = Left $ AttributeIsNotRelationValuedError ""
12relationForAtom _ = Left $ AttributeIsNotRelationValuedError ""
13
13
14+makeAtomFromText :: AttributeName -> AtomType -> T.Text -> Either RelationalError Atom
15+makeAtomFromText _ IntAtomType textIn = maybe ((Left . ParseError) textIn) (Right . IntAtom) (readMaybe (T.unpack textIn))
16+makeAtomFromText _ DoubleAtomType textIn = maybe ((Left . ParseError) textIn) (Right . DoubleAtom) (readMaybe (T.unpack textIn))
17+makeAtomFromText _ TextAtomType textIn = maybe ((Left . ParseError) textIn) (Right . TextAtom) (readMaybe (T.unpack textIn))
18+makeAtomFromText _ DayAtomType textIn = maybe ((Left . ParseError) textIn) (Right . DayAtom) (readMaybe (T.unpack textIn))
19+makeAtomFromText _ DateTimeAtomType textIn = maybe ((Left . ParseError) textIn) (Right . DateTimeAtom) (readMaybe (T.unpack textIn))
20+makeAtomFromText _ ByteStringAtomType textIn = maybe ((Left . ParseError) textIn) (Right . ByteStringAtom) (readMaybe (T.unpack textIn))
21+makeAtomFromText _ BoolAtomType textIn = maybe ((Left . ParseError) textIn) (Right . BoolAtom) (readMaybe (T.unpack textIn))
22+makeAtomFromText attrName _ _ = Left $ AtomTypeNotSupported attrName
23+
14atomToText :: Atom -> T.Text
24atomToText :: Atom -> T.Text
15−atomToText (IntegerAtom i) = (T.pack . show) i
16atomToText (IntAtom i) = (T.pack . show) i
25atomToText (IntAtom i) = (T.pack . show) i
17atomToText (DoubleAtom i) = (T.pack . show) i
26atomToText (DoubleAtom i) = (T.pack . show) i
18−atomToText (TextAtom i) = (T.pack . show) i --quotes necessary for ConstructedAtom subatoms
27+atomToText (TextAtom i) = (T.pack . show) i --does this break quoting in CSV export?
19atomToText (DayAtom i) = (T.pack . show) i
28atomToText (DayAtom i) = (T.pack . show) i
20atomToText (DateTimeAtom i) = (T.pack . show) i
29atomToText (DateTimeAtom i) = (T.pack . show) i
21atomToText (ByteStringAtom i) = (T.pack . show) i
30atomToText (ByteStringAtom i) = (T.pack . show) i
22atomToText (BoolAtom i) = (T.pack . show) i
31atomToText (BoolAtom i) = (T.pack . show) i
23−atomToText (RelationalExprAtom re) = (T.pack . show) re
24−
25atomToText (RelationAtom i) = (T.pack . show) i
32atomToText (RelationAtom i) = (T.pack . show) i
26−atomToText (ConstructedAtom dConsName typ atoms)
33+atomToText (ConstructedAtom dConsName _ atoms) = dConsName `T.append` T.intercalate " " (map atomToText 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)
44
34
45
35
46
36
src/lib/ProjectM36/AtomFunction.hs+1−35
@@ -1,20 +1,11 @@
1−{-# LANGUAGE CPP #-}
2module ProjectM36.AtomFunction where
1module ProjectM36.AtomFunction where
3import ProjectM36.Base
2import ProjectM36.Base
4−import ProjectM36.Serialise.Base ()
5import ProjectM36.Error
3import ProjectM36.Error
6−import ProjectM36.Relation
7−import ProjectM36.AtomType
8import ProjectM36.AtomFunctionError
4import ProjectM36.AtomFunctionError
9−import ProjectM36.ScriptSession
10import qualified ProjectM36.Attribute as A
5import qualified ProjectM36.Attribute as A
11import qualified Data.HashSet as HS
6import qualified Data.HashSet as HS
12−import qualified Data.Text as T
13−import qualified Data.ByteString.Lazy as BL
14−import Codec.Winery
15
7
16foldAtomFuncType :: AtomType -> AtomType -> [AtomType]
8foldAtomFuncType :: AtomType -> AtomType -> [AtomType]
17−--the underscore in the attribute name means that any attributes are acceptable
18foldAtomFuncType foldType returnType = [RelationAtomType (A.attributesFromList [Attribute "_" foldType]), returnType]
9foldAtomFuncType foldType returnType = [RelationAtomType (A.attributesFromList [Attribute "_" foldType]), returnType]
19
10
20atomFunctionForName :: AtomFunctionName -> AtomFunctions -> Either RelationalError AtomFunction
11atomFunctionForName :: AtomFunctionName -> AtomFunctions -> Either RelationalError AtomFunction
@@ -73,29 +64,4 @@ createScriptedAtomFunction funcName argsType retType = AddAtomFunction funcName
73 argsType ++ [ADTypeConstructor "Either" [
64 argsType ++ [ADTypeConstructor "Either" [
74 ADTypeConstructor "AtomFunctionError" [],
65 ADTypeConstructor "AtomFunctionError" [],
75 retType]])
66 retType]])
76−
67+
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−8
@@ -1,17 +1,11 @@
1{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
1{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
2module ProjectM36.AtomFunctionError where
2module ProjectM36.AtomFunctionError where
3+import Data.Binary
3import GHC.Generics
4import GHC.Generics
4import Control.DeepSeq
5import Control.DeepSeq
5−import Data.Text
6
6
7data AtomFunctionError = AtomFunctionUserError String |
7data AtomFunctionError = AtomFunctionUserError String |
8 AtomFunctionTypeMismatchError |
8 AtomFunctionTypeMismatchError |
9− InvalidIntervalOrderingError |
10− InvalidIntervalBoundariesError |
11− InvalidIntBoundError |
12− AtomFunctionEmptyRelationError |
13− AtomTypeDoesNotSupportOrderingError Text |
14− AtomTypeDoesNotSupportIntervalError Text |
15 AtomFunctionBytesDecodingError String
9 AtomFunctionBytesDecodingError String
16− deriving(Generic, Eq, Show, NFData)
10+ deriving(Generic, Eq, Show, Binary, NFData)
17
11
src/lib/ProjectM36/AtomFunctions/Basic.hs+1−7
@@ -4,9 +4,6 @@ import ProjectM36.Base
4import ProjectM36.DataTypes.Day
4import ProjectM36.DataTypes.Day
5import ProjectM36.DataTypes.Either
5import ProjectM36.DataTypes.Either
6import ProjectM36.DataTypes.Maybe
6import ProjectM36.DataTypes.Maybe
7−import ProjectM36.DataTypes.Interval
8−import ProjectM36.DataTypes.ByteString
9−import ProjectM36.DataTypes.NonEmptyList
10import ProjectM36.AtomFunctions.Primitive
7import ProjectM36.AtomFunctions.Primitive
11import ProjectM36.AtomFunction
8import ProjectM36.AtomFunction
12import ProjectM36.DataTypes.List
9import ProjectM36.DataTypes.List
@@ -19,10 +16,7 @@ basicAtomFunctions = HS.unions [primitiveAtomFunctions,
19 dateTimeAtomFunctions,
16 dateTimeAtomFunctions,
20 eitherAtomFunctions,
17 eitherAtomFunctions,
21 maybeAtomFunctions,
18 maybeAtomFunctions,
22− listAtomFunctions,
19+ listAtomFunctions]
23− nonEmptyListAtomFunctions,
24− bytestringAtomFunctions,
25− intervalAtomFunctions]
26
20
27--these special atom functions aren't scripted so they can't be serialized normally. Instead, the body remains in the binary and the serialization/deserialization happens by name only.
21--these special atom functions aren't scripted so they can't be serialized normally. Instead, the body remains in the binary and the serialization/deserialization happens by name only.
28precompiledAtomFunctions :: AtomFunctions
22precompiledAtomFunctions :: AtomFunctions
src/lib/ProjectM36/AtomFunctions/Primitive.hs+35−43
@@ -1,66 +1,65 @@
1module ProjectM36.AtomFunctions.Primitive where
1module ProjectM36.AtomFunctions.Primitive where
2import ProjectM36.Base
2import ProjectM36.Base
3−import ProjectM36.Relation (relFold, oneTuple)
3+import ProjectM36.Relation (relFold)
4import ProjectM36.Tuple
4import ProjectM36.Tuple
5import ProjectM36.AtomFunctionError
5import ProjectM36.AtomFunctionError
6import ProjectM36.AtomFunction
6import ProjectM36.AtomFunction
7import qualified Data.HashSet as HS
7import qualified Data.HashSet as HS
8import qualified Data.Vector as V
8import qualified Data.Vector as V
9+import qualified Data.ByteString.Base64 as B64
10+import qualified Data.Text.Encoding as TE
9import Control.Monad
11import Control.Monad
10
12
11primitiveAtomFunctions :: AtomFunctions
13primitiveAtomFunctions :: AtomFunctions
12primitiveAtomFunctions = HS.fromList [
14primitiveAtomFunctions = HS.fromList [
13 --match on any relation type
15 --match on any relation type
14 AtomFunction { atomFuncName = "add",
16 AtomFunction { atomFuncName = "add",
15− atomFuncType = [IntegerAtomType, IntegerAtomType, IntegerAtomType],
17+ atomFuncType = [IntAtomType, IntAtomType, IntAtomType],
16− atomFuncBody = body (\(IntegerAtom i1:IntegerAtom i2:_) -> pure (IntegerAtom (i1 + i2)))},
18+ atomFuncBody = body (\(IntAtom i1:IntAtom i2:_) -> pure (IntAtom (i1 + i2)))},
17 AtomFunction { atomFuncName = "id",
19 AtomFunction { atomFuncName = "id",
18 atomFuncType = [TypeVariableType "a", TypeVariableType "a"],
20 atomFuncType = [TypeVariableType "a", TypeVariableType "a"],
19 atomFuncBody = body (\(x:_) -> pure x)},
21 atomFuncBody = body (\(x:_) -> pure x)},
20 AtomFunction { atomFuncName = "sum",
22 AtomFunction { atomFuncName = "sum",
21− atomFuncType = foldAtomFuncType IntegerAtomType IntegerAtomType,
23+ atomFuncType = foldAtomFuncType IntAtomType IntAtomType,
22 atomFuncBody = body (\(RelationAtom rel:_) -> relationSum rel)},
24 atomFuncBody = body (\(RelationAtom rel:_) -> relationSum rel)},
23 AtomFunction { atomFuncName = "count",
25 AtomFunction { atomFuncName = "count",
24− atomFuncType = foldAtomFuncType (TypeVariableType "a") IntegerAtomType,
26+ atomFuncType = foldAtomFuncType (TypeVariableType "a") IntAtomType,
25 atomFuncBody = body (\(RelationAtom relIn:_) -> relationCount relIn)},
27 atomFuncBody = body (\(RelationAtom relIn:_) -> relationCount relIn)},
26 AtomFunction { atomFuncName = "max",
28 AtomFunction { atomFuncName = "max",
27− atomFuncType = foldAtomFuncType IntegerAtomType IntegerAtomType,
29+ atomFuncType = foldAtomFuncType IntAtomType IntAtomType,
28 atomFuncBody = body (\(RelationAtom relIn:_) -> relationMax relIn)},
30 atomFuncBody = body (\(RelationAtom relIn:_) -> relationMax relIn)},
29 AtomFunction { atomFuncName = "min",
31 AtomFunction { atomFuncName = "min",
30− atomFuncType = foldAtomFuncType IntegerAtomType IntegerAtomType,
32+ atomFuncType = foldAtomFuncType IntAtomType IntAtomType,
31 atomFuncBody = body (\(RelationAtom relIn:_) -> relationMin relIn)},
33 atomFuncBody = body (\(RelationAtom relIn:_) -> relationMin relIn)},
32 AtomFunction { atomFuncName = "lt",
34 AtomFunction { atomFuncName = "lt",
33− atomFuncType = [IntegerAtomType, IntegerAtomType, BoolAtomType],
35+ atomFuncType = [IntAtomType, IntAtomType, BoolAtomType],
34− atomFuncBody = body $ integerAtomFuncLessThan False},
36+ atomFuncBody = body $ intAtomFuncLessThan False},
35 AtomFunction { atomFuncName = "lte",
37 AtomFunction { atomFuncName = "lte",
36− atomFuncType = [IntegerAtomType, IntegerAtomType, BoolAtomType],
38+ atomFuncType = [IntAtomType, IntAtomType, BoolAtomType],
37− atomFuncBody = body $ integerAtomFuncLessThan True},
39+ atomFuncBody = body $ intAtomFuncLessThan True},
38 AtomFunction { atomFuncName = "gte",
40 AtomFunction { atomFuncName = "gte",
39− atomFuncType = [IntegerAtomType, IntegerAtomType, BoolAtomType],
41+ atomFuncType = [IntAtomType, IntAtomType, BoolAtomType],
40− atomFuncBody = body $ integerAtomFuncLessThan False >=> boolAtomNot},
42+ atomFuncBody = body $ intAtomFuncLessThan False >=> boolAtomNot},
41 AtomFunction { atomFuncName = "gt",
43 AtomFunction { atomFuncName = "gt",
42− atomFuncType = [IntegerAtomType, IntegerAtomType, BoolAtomType],
44+ atomFuncType = [IntAtomType, IntAtomType, BoolAtomType],
43− atomFuncBody = body $ integerAtomFuncLessThan True >=> boolAtomNot},
45+ atomFuncBody = body $ intAtomFuncLessThan True >=> boolAtomNot},
44 AtomFunction { atomFuncName = "not",
46 AtomFunction { atomFuncName = "not",
45 atomFuncType = [BoolAtomType, BoolAtomType],
47 atomFuncType = [BoolAtomType, BoolAtomType],
46 atomFuncBody = body $ \(b:_) -> boolAtomNot b },
48 atomFuncBody = body $ \(b:_) -> boolAtomNot b },
47− AtomFunction { atomFuncName = "int",
49+ AtomFunction { atomFuncName = "makeByteString",
48− atomFuncType = [IntegerAtomType, IntAtomType],
50+ atomFuncType = [TextAtomType, ByteStringAtomType],
49− atomFuncBody = body $ \(IntegerAtom v:_) -> if v < fromIntegral (maxBound :: Int) then
51+ atomFuncBody = body $ \(TextAtom textIn:_) -> case B64.decode (TE.encodeUtf8 textIn) of
50− pure (IntAtom (fromIntegral v))
52+ Left err -> Left (AtomFunctionBytesDecodingError err)
51− else
53+ Right bs -> pure (ByteStringAtom bs) }
52− Left InvalidIntBoundError
53− }
54−
55 ]
54 ]
56 where
55 where
57 body = AtomFunctionBody Nothing
56 body = AtomFunctionBody Nothing
58
57
59−integerAtomFuncLessThan :: Bool -> [Atom] -> Either AtomFunctionError Atom
58+intAtomFuncLessThan :: Bool -> [Atom] -> Either AtomFunctionError Atom
60−integerAtomFuncLessThan equality (IntegerAtom i1:IntegerAtom i2:_) = pure (BoolAtom (i1 `op` i2))
59+intAtomFuncLessThan equality (IntAtom i1:IntAtom i2:_) = pure (BoolAtom (i1 `op` i2))
61 where
60 where
62 op = if equality then (<=) else (<)
61 op = if equality then (<=) else (<)
63−integerAtomFuncLessThan _ _= pure (BoolAtom False)
62+intAtomFuncLessThan _ _= pure (BoolAtom False)
64
63
65boolAtomNot :: Atom -> Either AtomFunctionError Atom
64boolAtomNot :: Atom -> Either AtomFunctionError Atom
66boolAtomNot (BoolAtom b) = pure (BoolAtom (not b))
65boolAtomNot (BoolAtom b) = pure (BoolAtom (not b))
@@ -68,32 +67,25 @@ boolAtomNot _ = error "boolAtomNot called on non-Bool atom"
68
67
69--used by sum atom function
68--used by sum atom function
70relationSum :: Relation -> Either AtomFunctionError Atom
69relationSum :: Relation -> Either AtomFunctionError Atom
71−relationSum relIn = pure (IntegerAtom (relFold (\tupIn acc -> acc + newVal tupIn) 0 relIn))
70+relationSum relIn = pure (IntAtom (relFold (\tupIn acc -> acc + newVal tupIn) 0 relIn))
72 where
71 where
73− --extract Integer from Atom
72+ --extract Int from Atom
73+ newVal :: RelationTuple -> Int
74− newVal tupIn = castInteger (tupleAtoms tupIn V.! 0)
74+ newVal tupIn = castInt (tupleAtoms tupIn V.! 0)
75
75
76relationCount :: Relation -> Either AtomFunctionError Atom
76relationCount :: Relation -> Either AtomFunctionError Atom
77−relationCount relIn = pure (IntegerAtom (relFold (\_ acc -> acc + 1) (0::Integer) relIn))
77+relationCount relIn = pure (IntAtom (relFold (\_ acc -> acc + 1) (0::Int) relIn))
78
78
79relationMax :: Relation -> Either AtomFunctionError Atom
79relationMax :: Relation -> Either AtomFunctionError Atom
80−relationMax relIn = case oneTuple relIn of
81− Nothing -> Left AtomFunctionEmptyRelationError
82− Just oneTup -> pure (IntegerAtom (relFold (\tupIn acc -> max acc (newVal tupIn)) (newVal oneTup) relIn))
80+relationMax relIn = pure (IntAtom (relFold (\tupIn acc -> max acc (newVal tupIn)) minBound relIn))
83 where
81 where
84− newVal tupIn = castInteger (tupleAtoms tupIn V.! 0)
82+ newVal tupIn = castInt (tupleAtoms tupIn V.! 0)
85
83
86relationMin :: Relation -> Either AtomFunctionError Atom
84relationMin :: Relation -> Either AtomFunctionError Atom
87−relationMin relIn = case oneTuple relIn of
88− Nothing -> Left AtomFunctionEmptyRelationError
89− Just oneTup -> pure (IntegerAtom (relFold (\tupIn acc -> min acc (newVal tupIn)) (newVal oneTup) relIn))
85+relationMin relIn = pure (IntAtom (relFold (\tupIn acc -> min acc (newVal tupIn)) maxBound relIn))
90 where
86 where
91− newVal tupIn = castInteger (tupleAtoms tupIn V.! 0)
87+ newVal tupIn = castInt (tupleAtoms tupIn V.! 0)
92
88
93castInt :: Atom -> Int
89castInt :: Atom -> Int
94castInt (IntAtom i) = i
90castInt (IntAtom i) = i
95−castInt _ = error "attempted to cast non-IntAtom to Int"
91+castInt _ = error "attempted to cast non-IntAtom to Int"
96−
97−castInteger :: Atom -> Integer
98−castInteger (IntegerAtom i) = i
99−castInteger _ = error "attempted to cast non-IntegerAtom to Int"
src/lib/ProjectM36/AtomType.hs+72−239
@@ -6,7 +6,6 @@ import qualified ProjectM36.DataConstructorDef as DCD
6import ProjectM36.MiscUtils
6import ProjectM36.MiscUtils
7import ProjectM36.Error
7import ProjectM36.Error
8import ProjectM36.DataTypes.Primitive
8import ProjectM36.DataTypes.Primitive
9−import ProjectM36.AttributeExpr as AE
10import qualified ProjectM36.Attribute as A
9import qualified ProjectM36.Attribute as A
11import qualified Data.Vector as V
10import qualified Data.Vector as V
12import qualified Data.Set as S
11import qualified Data.Set as S
@@ -31,7 +30,6 @@ findDataConstructor dName = foldr tConsFolder Nothing
31 [dCons] -> Just dCons
30 [dCons] -> Just dCons
32 _ -> error "More than one data constructor with the same name found"
31 _ -> error "More than one data constructor with the same name found"
33
32
34−{-
35-- | Scan the atom types and return the resultant ConstructedAtomType or error.
33-- | Scan the atom types and return the resultant ConstructedAtomType or error.
36-- Used in typeFromAtomExpr to validate argument types.
34-- Used in typeFromAtomExpr to validate argument types.
37atomTypeForDataConstructorName :: DataConstructorName -> [AtomType] -> TypeConstructorMapping -> Either RelationalError AtomType
35atomTypeForDataConstructorName :: DataConstructorName -> [AtomType] -> TypeConstructorMapping -> Either RelationalError AtomType
@@ -40,21 +38,28 @@ atomTypeForDataConstructorName dConsName atomTypesIn tConsList =
40 case findDataConstructor dConsName tConsList of
38 case findDataConstructor dConsName tConsList of
41 Nothing -> Left (NoSuchDataConstructorError dConsName)
39 Nothing -> Left (NoSuchDataConstructorError dConsName)
42 Just (tCons, dCons) -> do
40 Just (tCons, dCons) -> do
43− dConsVars <- resolveDataConstructorTypeVars dCons atomTypesIn tConsList
41+ typeVars <- resolveDataConstructorTypeVars dCons atomTypesIn tConsList
44− let tConsVars = M.fromList (map TypeVariableType (TCD.typeVars tCons))
45− allVars = M.union dConsVars tConsVars
46− ConstructedAtomType (TCD.name tCons) <$> allVars
42+ pure (ConstructedAtomType (TCD.name tCons) typeVars)
47−-}
48
43
49−atomTypeForDataConstructorDefArg :: DataConstructorDefArg -> AtomType -> TypeConstructorMapping -> Either RelationalError AtomType
44+atomTypeForDataConstructorDefArg :: DataConstructorDefArg -> AtomType -> TypeConstructorMapping -> Either RelationalError AtomType
50−atomTypeForDataConstructorDefArg (DataConstructorDefTypeConstructorArg tCons) aType tConss = do
45+atomTypeForDataConstructorDefArg (DataConstructorDefTypeConstructorArg tCons) aType tConss =
51− isValidAtomTypeForTypeConstructor aType tCons tConss
46+ case isValidAtomTypeForTypeConstructor aType tCons tConss of
52− pure aType
47+ Just err -> Left err
48+ Nothing -> Right aType
53
49
54atomTypeForDataConstructorDefArg (DataConstructorDefTypeVarNameArg _) aType _ = Right aType --any type is OK
50atomTypeForDataConstructorDefArg (DataConstructorDefTypeVarNameArg _) aType _ = Right aType --any type is OK
55
51
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+
56-- | Used to determine if the atom arguments can be used with the data constructor.
61-- | Used to determine if the atom arguments can be used with the data constructor.
57−-- | This is the entry point for type-checking from RelationalExpression.hs
62+-- | This is the entry point for type-checking from RelationalExpression.hs.
58atomTypeForDataConstructor :: TypeConstructorMapping -> DataConstructorName -> [AtomType] -> Either RelationalError AtomType
63atomTypeForDataConstructor :: TypeConstructorMapping -> DataConstructorName -> [AtomType] -> Either RelationalError AtomType
59atomTypeForDataConstructor tConss dConsName atomArgTypes =
64atomTypeForDataConstructor tConss dConsName atomArgTypes =
60 --lookup the data constructor
65 --lookup the data constructor
@@ -62,33 +67,23 @@ atomTypeForDataConstructor tConss dConsName atomArgTypes =
62 Nothing -> Left (NoSuchDataConstructorError dConsName)
67 Nothing -> Left (NoSuchDataConstructorError dConsName)
63 Just (tCons, dCons) -> do
68 Just (tCons, dCons) -> do
64 --validate that the type constructor arguments are fulfilled in the data constructor
69 --validate that the type constructor arguments are fulfilled in the data constructor
65− dConsVars <- resolveDataConstructorTypeVars dCons atomArgTypes tConss
70+ typeVars <- resolveDataConstructorTypeVars dCons atomArgTypes tConss
66− let tConsVars = M.fromList (map (\v -> (v, TypeVariableType v)) (TCD.typeVars tCons))
67− allVars = M.union dConsVars tConsVars
68− unresolvedType = ConstructedAtomType (TCD.name tCons) allVars
71+ pure (ConstructedAtomType (TCD.name tCons) typeVars)
69− --validateAtomType unresolvedType tConss -- do not validate here because the type may not be fully resolved at this point
70− pure unresolvedType
71
72
72-- | Walks the data and type constructors to extract the type variable map.
73-- | Walks the data and type constructors to extract the type variable map.
73resolveDataConstructorTypeVars :: DataConstructorDef -> [AtomType] -> TypeConstructorMapping -> Either RelationalError TypeVarMap
74resolveDataConstructorTypeVars :: DataConstructorDef -> [AtomType] -> TypeConstructorMapping -> Either RelationalError TypeVarMap
74−resolveDataConstructorTypeVars dCons@(DataConstructorDef _ defArgs) aTypeArgs tConss = do
75+resolveDataConstructorTypeVars dCons 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
80− maps <- mapM (\(dCons',aTypeArg) -> resolveDataConstructorArgTypeVars dCons' aTypeArg tConss) (zip (DCD.fields dCons) aTypeArgs)
76+ maps <- mapM (\(dCons',aTypeArg) -> resolveDataConstructorArgTypeVars dCons' aTypeArg tConss) (zip (DCD.fields dCons) aTypeArgs)
81 --if any two maps have the same key and different values, this indicates a type arg mismatch
77 --if any two maps have the same key and different values, this indicates a type arg mismatch
82− let typeVarMapFolder valMap acc = case acc of
78+ let typeVarMapFolder valMap acc = case acc of
83− Left err -> Left err
79+ Left err -> Left err
84− Right accMap ->
80+ Right accMap -> if accMap `M.isSubmapOf` valMap then
85− case resolveAtomTypesInTypeVarMap valMap accMap of
81+ Right (M.union accMap valMap)
82+ else
86− Left (TypeConstructorTypeVarMissing _) -> Left (DataConstructorTypeVarsMismatch (DCD.name dCons) accMap valMap)
83+ Left (DataConstructorTypeVarsMismatch (DCD.name dCons) accMap valMap)
87− Left err -> Left err
88− Right ok -> pure ok
89− case foldr typeVarMapFolder (Right M.empty) maps of
84+ case foldr typeVarMapFolder (Right M.empty) maps of
90− Left err -> Left err
85+ Left err -> Left err
91− Right typeVarMaps -> pure typeVarMaps
86+ Right typeVarMaps -> pure typeVarMaps
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.
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.
93
88
94
89
@@ -116,103 +111,34 @@ resolveTypeConstructorTypeVars (ADTypeConstructor tConsName _) (ConstructedAtomT
116 Right pVarMap'
111 Right pVarMap'
117 else
112 else
118 Left (TypeConstructorTypeVarsMismatch expectedPVarNames (M.keysSet pVarMap'))
113 Left (TypeConstructorTypeVarsMismatch expectedPVarNames (M.keysSet pVarMap'))
119−resolveTypeConstructorTypeVars (TypeVariable tvName) typ _ = case typ of
114+resolveTypeConstructorTypeVars (TypeVariable tvName) typ _ = Right (M.singleton tvName typ)
120− TypeVariableType nam -> Left (TypeConstructorTypeVarMissing nam)
115+resolveTypeConstructorTypeVars x y _ = error $ "Unhandled type vars:" ++ show x ++ show y
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
139
116
140-- check that type vars on the right also appear on the left
117-- check that type vars on the right also appear on the left
141-- check that the data constructor names are unique
118-- check that the data constructor names are unique
142−validateTypeConstructorDef :: TypeConstructorDef -> [DataConstructorDef] -> TypeConstructorMapping -> Either RelationalError ()
119+validateTypeConstructorDef :: TypeConstructorDef -> [DataConstructorDef] -> [RelationalError]
143−validateTypeConstructorDef tConsDef dConsList tConsMap = do
120+validateTypeConstructorDef tConsDef dConsList = execWriter $ do
144 let duplicateDConsNames = dupes (L.sort (map DCD.name dConsList))
121 let duplicateDConsNames = dupes (L.sort (map DCD.name dConsList))
145− unless (null duplicateDConsNames) (Left (someErrors (map DataConstructorNameInUseError duplicateDConsNames)))
122+ mapM_ tell [map DataConstructorNameInUseError duplicateDConsNames]
146 let leftSideVars = S.fromList (TCD.typeVars tConsDef)
123 let leftSideVars = S.fromList (TCD.typeVars tConsDef)
147 rightSideVars = S.unions (map DCD.typeVars dConsList)
124 rightSideVars = S.unions (map DCD.typeVars dConsList)
148 varsDiff = S.difference leftSideVars rightSideVars
125 varsDiff = S.difference leftSideVars rightSideVars
149− when (S.size varsDiff > 0) (Left (someErrors (map DataConstructorUsesUndeclaredTypeVariable (S.toList varsDiff))))
126+ mapM_ tell [map DataConstructorUsesUndeclaredTypeVariable (S.toList varsDiff)]
150− mapM_ (\dConsDef -> validateDataConstructorDef dConsDef tConsDef tConsMap) dConsList
127+ pure ()
151−
128+
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
176
129
177-- | Create an atom type iff all type variables are provided.
130-- | Create an atom type iff all type variables are provided.
178-- Either Int Text -> ConstructedAtomType "Either" {Int , Text}
131-- Either Int Text -> ConstructedAtomType "Either" {Int , Text}
179−atomTypeForTypeConstructorValidate :: Bool -> TypeConstructor -> TypeConstructorMapping -> TypeVarMap -> Either RelationalError AtomType
132+atomTypeForTypeConstructor :: TypeConstructor -> TypeConstructorMapping -> Either RelationalError AtomType
180−atomTypeForTypeConstructorValidate _ (PrimitiveTypeConstructor _ aType) _ _ = Right aType
133+atomTypeForTypeConstructor (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
185− pure (TypeVariableType tvname)
134+atomTypeForTypeConstructor (TypeVariable tvname) _ = Right (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))
191−atomTypeForTypeConstructorValidate val tCons tConss tvMap = case findTypeConstructor (TC.name tCons) tConss of
135+atomTypeForTypeConstructor tCons tConss = case findTypeConstructor (TC.name tCons) tConss of
192 Nothing -> Left (NoSuchTypeConstructorError (TC.name tCons))
136 Nothing -> Left (NoSuchTypeConstructorError (TC.name tCons))
193− Just (PrimitiveTypeConstructorDef _ aType, _) -> Right aType
194 Just (tConsDef, _) -> do
137 Just (tConsDef, _) -> do
195− tConsArgTypes <- mapM (\tConsArg -> atomTypeForTypeConstructorValidate val tConsArg tConss tvMap) (TC.arguments tCons)
138+ tConsArgTypes <- mapM (`atomTypeForTypeConstructor` tConss) (TC.arguments tCons)
196− let pVarNames = TCD.typeVars tConsDef
139+ let pVarNames = TCD.typeVars tConsDef
197− tConsArgs = M.fromList (zip pVarNames tConsArgTypes)
140+ tConsArgs = M.fromList (zip pVarNames tConsArgTypes)
198− Right (ConstructedAtomType (TC.name tCons) tConsArgs)
141+ 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))
216
142
217findTypeConstructor :: TypeConstructorName -> TypeConstructorMapping -> Maybe (TypeConstructorDef, [DataConstructorDef])
143findTypeConstructor :: TypeConstructorName -> TypeConstructorMapping -> Maybe (TypeConstructorDef, [DataConstructorDef])
218findTypeConstructor name = foldr tConsFolder Nothing
144findTypeConstructor name = foldr tConsFolder Nothing
@@ -221,30 +147,17 @@ findTypeConstructor name = foldr tConsFolder Nothing
221 Just (tCons, dConsList)
147 Just (tCons, dConsList)
222 else
148 else
223 accum
149 accum
224−
150+
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
233resolveAtomType :: AtomType -> AtomType -> Either RelationalError AtomType
151resolveAtomType :: AtomType -> AtomType -> Either RelationalError AtomType
234−resolveAtomType (ConstructedAtomType tConsName resolvedTypeVarMap) (ConstructedAtomType _ unresolvedTypeVarMap) =
152+resolveAtomType (ConstructedAtomType tConsName resolvedTypeVarMap) (ConstructedAtomType _ unresolvedTypeVarMap) = do
235− ConstructedAtomType tConsName <$> resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap
153+ tVarMap <- resolveAtomTypesInTypeVarMap resolvedTypeVarMap unresolvedTypeVarMap
154+ pure (ConstructedAtomType tConsName tVarMap)
236resolveAtomType typeFromRelation unresolvedType = if typeFromRelation == unresolvedType then
155resolveAtomType typeFromRelation unresolvedType = if typeFromRelation == unresolvedType then
237 Right typeFromRelation
156 Right typeFromRelation
238 else
157 else
239 Left (AtomTypeMismatchError typeFromRelation unresolvedType)
158 Left (AtomTypeMismatchError typeFromRelation unresolvedType)
240
159
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−-}
247−-- this could be optimized to reduce new tuple creation
160+-- this could be optimized to reduce new tuple creation- if anyatomtype does not appear, just return the original typevarmap
248resolveAtomTypesInTypeVarMap :: TypeVarMap -> TypeVarMap -> Either RelationalError TypeVarMap
161resolveAtomTypesInTypeVarMap :: TypeVarMap -> TypeVarMap -> Either RelationalError TypeVarMap
249resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do
162resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do
250 {-
163 {-
@@ -260,42 +173,29 @@ resolveAtomTypesInTypeVarMap resolvedTypeMap unresolvedTypeMap = do
260 let resolveTypePair resKey resType =
173 let resolveTypePair resKey resType =
261 -- if the key is missing in the unresolved type map, then fill it in with the value from the resolved map
174 -- if the key is missing in the unresolved type map, then fill it in with the value from the resolved map
262 case M.lookup resKey unresolvedTypeMap of
175 case M.lookup resKey unresolvedTypeMap of
263− Just unresType -> case unresType of
176+ Just unresType -> case unresType of
264 --do we need to recurse for RelationAtomType?
177 --do we need to recurse for RelationAtomType?
265 subType@(ConstructedAtomType _ _) -> do
178 subType@(ConstructedAtomType _ _) -> do
266 resSubType <- resolveAtomType resType subType
179 resSubType <- resolveAtomType resType subType
267 pure (resKey, resSubType)
180 pure (resKey, resSubType)
268− TypeVariableType _ -> pure (resKey, resType)
181+ otherType -> pure (resKey, otherType)
269− typ -> if typ == resType then
270− pure (resKey, resType)
271− else
272− Left $ AtomTypeMismatchError typ resType
273 Nothing ->
182 Nothing ->
274 pure (resKey, resType) --swipe the missing type var from the expected map
183 pure (resKey, resType) --swipe the missing type var from the expected map
275 tVarList <- mapM (uncurry resolveTypePair) (M.toList resolvedTypeMap)
184 tVarList <- mapM (uncurry resolveTypePair) (M.toList resolvedTypeMap)
276 pure (M.fromList tVarList)
185 pure (M.fromList tVarList)
277
186
278-- | See notes at `resolveTypesInTuple`. The typeFromRelation must not include any wildcards.
187-- | See notes at `resolveTypesInTuple`. The typeFromRelation must not include any wildcards.
279−resolveTypeInAtom :: AtomType -> Atom -> TypeConstructorMapping -> Either RelationalError Atom
188+resolveTypeInAtom :: AtomType -> Atom -> Either RelationalError Atom
280−resolveTypeInAtom typeFromRelation@(ConstructedAtomType _ tvMap) atomIn@(ConstructedAtom dConsName _ args) tConss = do
189+resolveTypeInAtom typeFromRelation atomIn@(ConstructedAtom dConsName _ args) = do
281 newType <- resolveAtomType typeFromRelation (atomTypeForAtom atomIn)
190 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)
288− pure (ConstructedAtom dConsName newType newArgs)
191+ pure (ConstructedAtom dConsName newType args)
289−resolveTypeInAtom (RelationAtomType attrs) (RelationAtom (Relation _ tupSet)) tConss = do
290− let newTups = mapM (resolveTypesInTuple attrs tConss) (asList tupSet)
291− RelationAtom . Relation attrs . RelationTupleSet <$> newTups
292−resolveTypeInAtom _ atom _ = Right atom
192+resolveTypeInAtom _ atom = Right atom
293
193
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.
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.
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.
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.
296−resolveTypesInTuple :: Attributes -> TypeConstructorMapping -> RelationTuple -> Either RelationalError RelationTuple
196+resolveTypesInTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple
297−resolveTypesInTuple resolvedAttrs tConss (RelationTuple _ tupAtoms) = do
197+resolveTypesInTuple resolvedAttrs (RelationTuple _ tupAtoms) = do
298− newAtoms <- mapM (\(atom, resolvedType) -> resolveTypeInAtom resolvedType atom tConss) (zip (V.toList tupAtoms) $ A.atomTypesList resolvedAttrs)
198+ newAtoms <- mapM (\(atom, resolvedType) -> resolveTypeInAtom resolvedType atom) (zip (V.toList tupAtoms) $ map A.atomType (V.toList resolvedAttrs))
299 Right (RelationTuple resolvedAttrs (V.fromList newAtoms))
199 Right (RelationTuple resolvedAttrs (V.fromList newAtoms))
300
200
301-- | Validate that the type is provided with complete type variables for type constructors.
201-- | Validate that the type is provided with complete type variables for type constructors.
@@ -310,38 +210,12 @@ validateAtomType typ@(ConstructedAtomType tConsName tVarMap) tConss =
310 if not (S.null diff) then
210 if not (S.null diff) then
311 Left $ TypeConstructorTypeVarsMismatch expectedTyVarNames actualTyVarNames
211 Left $ TypeConstructorTypeVarsMismatch expectedTyVarNames actualTyVarNames
312 else
212 else
313− validateTypeVarMap tVarMap tConss
213+ Right ()
314− _ -> Right ()
214+ _ -> Right ()
315−validateAtomType (RelationAtomType attrs) tConss =
215+validateAtomType _ _ = Right ()
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
333
216
334validateTuple :: RelationTuple -> TypeConstructorMapping -> Either RelationalError ()
217validateTuple :: RelationTuple -> TypeConstructorMapping -> Either RelationalError ()
335−validateTuple (RelationTuple _ atoms) tConss = mapM_ (`validateAtom` tConss) atoms
218+validateTuple (RelationTuple _ atoms) tConss = mapM_ (\a -> validateAtomType (atomTypeForAtom a) 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−
345
219
346-- | Determine if two types are equal or compatible (including special handling for TypeVar x).
220-- | Determine if two types are equal or compatible (including special handling for TypeVar x).
347atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType
221atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType
@@ -353,40 +227,33 @@ atomTypeVerify x@(ConstructedAtomType tConsNameA tVarMapA) (ConstructedAtomType
353 | otherwise = Right x
227 | otherwise = Right x
354
228
355atomTypeVerify x@(RelationAtomType attrs1) y@(RelationAtomType attrs2) = do
229atomTypeVerify x@(RelationAtomType attrs1) y@(RelationAtomType attrs2) = do
356− mapM_ (\(attr1,attr2) -> let name1 = A.attributeName attr1
230+ _ <- mapM (\(attr1,attr2) -> let name1 = A.attributeName attr1
357− name2 = A.attributeName attr2 in
231+ name2 = A.attributeName attr2 in
358 if notElem "_" [name1, name2] && name1 /= name2 then
232 if notElem "_" [name1, name2] && name1 /= name2 then
359 Left $ AtomTypeMismatchError x y
233 Left $ AtomTypeMismatchError x y
360 else
234 else
361− atomTypeVerify (A.atomType attr1) (A.atomType attr2)) $ V.toList (V.zip (attributesVec attrs1) (attributesVec attrs2))
235+ atomTypeVerify (A.atomType attr1) (A.atomType attr2)) $ V.toList (V.zip attrs1 attrs2)
362 return x
236 return x
363atomTypeVerify x y = if x == y then
237atomTypeVerify x y = if x == y then
364 Right x
238 Right x
365 else
239 else
366 Left $ AtomTypeMismatchError x y
240 Left $ AtomTypeMismatchError x y
367
241
368−-- | Determine if two typeVars are logically compatible.
242+-- | Determine if two typeVar
369typeVarMapsVerify :: TypeVarMap -> TypeVarMap -> Bool
243typeVarMapsVerify :: TypeVarMap -> TypeVarMap -> Bool
370−typeVarMapsVerify a b = M.keysSet a == M.keysSet b && (length . rights) zipped == M.size a
244+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
371− where
372− zipped = zipWith
373− (curry (\ ((_, v1), (_, v2)) -> atomTypeVerify v1 v2))
374− (M.toAscList a)
375− (M.toAscList b)
376
245
377prettyAtomType :: AtomType -> T.Text
246prettyAtomType :: AtomType -> T.Text
378−prettyAtomType (RelationAtomType attrs) = "relation {" `T.append` T.intercalate "," (map prettyAttribute (V.toList (attributesVec attrs))) `T.append` "}"
247+prettyAtomType (RelationAtomType attrs) = "relation {" `T.append` T.intercalate "," (map prettyAttribute (V.toList attrs)) `T.append` "}"
379prettyAtomType (ConstructedAtomType tConsName typeVarMap) = tConsName `T.append` T.concat (map showTypeVars (M.toList typeVarMap))
248prettyAtomType (ConstructedAtomType tConsName typeVarMap) = tConsName `T.append` T.concat (map showTypeVars (M.toList typeVarMap))
380 where
249 where
381− showTypeVars (_, TypeVariableType x) = " " <> x
382 showTypeVars (tyVarName, aType) = " (" `T.append` tyVarName `T.append` "::" `T.append` prettyAtomType aType `T.append` ")"
250 showTypeVars (tyVarName, aType) = " (" `T.append` tyVarName `T.append` "::" `T.append` prettyAtomType aType `T.append` ")"
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?)
251-- 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?)
384−prettyAtomType (TypeVariableType x) = x
252+prettyAtomType (TypeVariableType x) = "?TypeVariableType " <> x <> "?"
385prettyAtomType aType = T.take (T.length fullName - T.length "AtomType") fullName
253prettyAtomType aType = T.take (T.length fullName - T.length "AtomType") fullName
386 where fullName = (T.pack . show) aType
254 where fullName = (T.pack . show) aType
387
255
388prettyAttribute :: Attribute -> T.Text
256prettyAttribute :: Attribute -> T.Text
389−prettyAttribute (Attribute _ (TypeVariableType x)) = x
390prettyAttribute attr = A.attributeName attr `T.append` "::" `T.append` prettyAtomType (A.atomType attr)
257prettyAttribute attr = A.attributeName attr `T.append` "::" `T.append` prettyAtomType (A.atomType attr)
391
258
392resolveTypeVariables :: [AtomType] -> [AtomType] -> Either RelationalError TypeVarMap
259resolveTypeVariables :: [AtomType] -> [AtomType] -> Either RelationalError TypeVarMap
@@ -419,38 +286,4 @@ resolveFunctionReturnValue funcName tvMap (ConstructedAtomType tCons retMap) = d
419resolveFunctionReturnValue funcName tvMap (TypeVariableType tvName) = case M.lookup tvName tvMap of
286resolveFunctionReturnValue funcName tvMap (TypeVariableType tvName) = case M.lookup tvName tvMap of
420 Nothing -> Left (AtomFunctionTypeVariableResolutionError funcName tvName)
287 Nothing -> Left (AtomFunctionTypeVariableResolutionError funcName tvName)
421 Just typ -> pure typ
288 Just typ -> pure typ
422−resolveFunctionReturnValue _ _ typ = pure typ
289+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+76−120
@@ -1,28 +1,37 @@
1{-# LANGUAGE DefaultSignatures, TypeFamilies, TypeOperators, PolyKinds, FlexibleInstances, ScopedTypeVariables, FlexibleContexts #-}
1{-# LANGUAGE DefaultSignatures, TypeFamilies, TypeOperators, PolyKinds, FlexibleInstances, ScopedTypeVariables, FlexibleContexts #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
3module ProjectM36.Atomable where
2module ProjectM36.Atomable where
4--http://stackoverflow.com/questions/13448361/type-families-with-ghc-generics-or-data-data
3--http://stackoverflow.com/questions/13448361/type-families-with-ghc-generics-or-data-data
5--instances to marshal Haskell ADTs to ConstructedAtoms and back
4--instances to marshal Haskell ADTs to ConstructedAtoms and back
6import ProjectM36.Base
5import ProjectM36.Base
6+import ProjectM36.Relation
7+import ProjectM36.DataTypes.Primitive
7import ProjectM36.DataTypes.List
8import ProjectM36.DataTypes.List
8−import ProjectM36.DataTypes.NonEmptyList
9−import ProjectM36.DataTypes.Maybe
10−import ProjectM36.DataTypes.Either
11import GHC.Generics
9import GHC.Generics
12import qualified Data.Map as M
10import qualified Data.Map as M
13import qualified Data.Text as T
11import qualified Data.Text as T
14−import qualified Data.Vector as V
15import Control.DeepSeq (NFData)
12import Control.DeepSeq (NFData)
13+import Data.Binary
16import Control.Applicative
14import Control.Applicative
17import Data.Time.Calendar
15import Data.Time.Calendar
18import Data.ByteString (ByteString)
16import Data.ByteString (ByteString)
19import Data.Time.Clock
17import Data.Time.Clock
20−import Data.Proxy
18+import Data.Maybe
21−import qualified Data.List.NonEmpty as NE
22−import Codec.Winery
23
19
20+--also add haskell scripting atomable support
21+--rename this module to Atomable along with test
22+
23+{-
24+data Test1T = Test1C Int
25+ deriving (Generic, Show, Eq, Binary, NFData, Atomable)
26+
27+data Test2T = Test2C Int Int
28+ deriving (Generic, Show, Eq, Binary, NFData, Atomable)
29+
30+data Test3T = Test3Ca | Test3Cb
31+ deriving (Generic, Show, Eq, Binary, NFData, Atomable)
32+-}
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.
33-- | 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.
25−class (Eq a, NFData a, Serialise a, Show a) => Atomable a where
34+class (Eq a, NFData a, Binary a, Show a) => Atomable a where
26 toAtom :: a -> Atom
35 toAtom :: a -> Atom
27 default toAtom :: (Generic a, AtomableG (Rep a)) => a -> Atom
36 default toAtom :: (Generic a, AtomableG (Rep a)) => a -> Atom
28 toAtom v = toAtomG (from v) (toAtomTypeG (from v))
37 toAtom v = toAtomG (from v) (toAtomTypeG (from v))
@@ -36,121 +45,83 @@ class (Eq a, NFData a, Serialise a, Show a) => Atomable a where
36 Nothing -> error "no fromAtomG for Atom found"
45 Nothing -> error "no fromAtomG for Atom found"
37 Just x -> to x
46 Just x -> to x
38
47
39− toAtomType :: proxy a -> AtomType
48+ toAtomType :: a -> AtomType
40− default toAtomType :: (Generic a, AtomableG (Rep a)) => proxy a -> AtomType
49+ default toAtomType :: (Generic a, AtomableG (Rep a)) => a -> AtomType
41− toAtomType _ = toAtomTypeG (from (undefined :: a))
50+ toAtomType v = toAtomTypeG (from v)
42
51
43 -- | Creates DatabaseContextExpr necessary to load the type constructor and data constructor into the database.
52 -- | Creates DatabaseContextExpr necessary to load the type constructor and data constructor into the database.
44− toAddTypeExpr :: proxy a -> DatabaseContextExpr
53+ toDatabaseContextExpr :: a -> DatabaseContextExpr
45− default toAddTypeExpr :: (Generic a, AtomableG (Rep a)) => proxy a -> DatabaseContextExpr
54+ default toDatabaseContextExpr :: (Generic a, AtomableG (Rep a)) => a -> DatabaseContextExpr
46− toAddTypeExpr _ = toAddTypeExprG (from (error "insufficient laziness" :: a)) (toAtomType (Proxy :: Proxy a))
55+ toDatabaseContextExpr v = toDatabaseContextExprG (from v) (toAtomType v)
47−
48−instance Atomable Integer where
49− toAtom = IntegerAtom
50− fromAtom (IntegerAtom i) = i
51− fromAtom e = error ("improper fromAtom" ++ show e)
52− toAtomType _ = IntegerAtomType
53− toAddTypeExpr _ = NoOperation
54
56
55instance Atomable Int where
57instance Atomable Int where
56 toAtom = IntAtom
58 toAtom = IntAtom
57 fromAtom (IntAtom i) = i
59 fromAtom (IntAtom i) = i
58 fromAtom e = error ("improper fromAtom" ++ show e)
60 fromAtom e = error ("improper fromAtom" ++ show e)
59 toAtomType _ = IntAtomType
61 toAtomType _ = IntAtomType
60− toAddTypeExpr _ = NoOperation
62+ toDatabaseContextExpr _ = NoOperation
61
63
62instance Atomable Double where
64instance Atomable Double where
63 toAtom = DoubleAtom
65 toAtom = DoubleAtom
64 fromAtom (DoubleAtom d) = d
66 fromAtom (DoubleAtom d) = d
65 fromAtom _ = error "improper fromAtom"
67 fromAtom _ = error "improper fromAtom"
66 toAtomType _ = DoubleAtomType
68 toAtomType _ = DoubleAtomType
67− toAddTypeExpr _ = NoOperation
69+ toDatabaseContextExpr _ = NoOperation
68
70
69instance Atomable T.Text where
71instance Atomable T.Text where
70 toAtom = TextAtom
72 toAtom = TextAtom
71 fromAtom (TextAtom t) = t
73 fromAtom (TextAtom t) = t
72 fromAtom _ = error "improper fromAtom"
74 fromAtom _ = error "improper fromAtom"
73 toAtomType _ = TextAtomType
75 toAtomType _ = TextAtomType
74− toAddTypeExpr _ = NoOperation
76+ toDatabaseContextExpr _ = NoOperation
75
77
76instance Atomable Day where
78instance Atomable Day where
77 toAtom = DayAtom
79 toAtom = DayAtom
78 fromAtom (DayAtom d) = d
80 fromAtom (DayAtom d) = d
79 fromAtom _ = error "improper fromAtom"
81 fromAtom _ = error "improper fromAtom"
80 toAtomType _ = DayAtomType
82 toAtomType _ = DayAtomType
81− toAddTypeExpr _ = NoOperation
83+ toDatabaseContextExpr _ = NoOperation
82
84
83instance Atomable UTCTime where
85instance Atomable UTCTime where
84 toAtom = DateTimeAtom
86 toAtom = DateTimeAtom
85 fromAtom (DateTimeAtom t) = t
87 fromAtom (DateTimeAtom t) = t
86 fromAtom _ = error "improper fromAtom"
88 fromAtom _ = error "improper fromAtom"
87 toAtomType _ = DateTimeAtomType
89 toAtomType _ = DateTimeAtomType
88− toAddTypeExpr _ = NoOperation
90+ toDatabaseContextExpr _ = NoOperation
89
91
90instance Atomable ByteString where
92instance Atomable ByteString where
91 toAtom = ByteStringAtom
93 toAtom = ByteStringAtom
92 fromAtom (ByteStringAtom b) = b
94 fromAtom (ByteStringAtom b) = b
93 fromAtom _ = error "improper fromAtom"
95 fromAtom _ = error "improper fromAtom"
94 toAtomType _ = ByteStringAtomType
96 toAtomType _ = ByteStringAtomType
95− toAddTypeExpr _ = NoOperation
97+ toDatabaseContextExpr _ = NoOperation
96
98
97instance Atomable Bool where
99instance Atomable Bool where
98 toAtom = BoolAtom
100 toAtom = BoolAtom
99 fromAtom (BoolAtom b) = b
101 fromAtom (BoolAtom b) = b
100 fromAtom _ = error "improper fromAtom"
102 fromAtom _ = error "improper fromAtom"
101 toAtomType _ = BoolAtomType
103 toAtomType _ = BoolAtomType
102− toAddTypeExpr _ = NoOperation
104+ toDatabaseContextExpr _ = NoOperation
103−
105+
104−{-
105instance Atomable Relation where
106instance Atomable Relation where
106 toAtom = RelationAtom
107 toAtom = RelationAtom
107 fromAtom (RelationAtom r) = r
108 fromAtom (RelationAtom r) = r
108 fromAtom _ = error "improper fromAtom"
109 fromAtom _ = error "improper fromAtom"
109 --warning: cannot be used with undefined "Relation"
110 --warning: cannot be used with undefined "Relation"
110 toAtomType rel = RelationAtomType (attributes rel)
111 toAtomType rel = RelationAtomType (attributes rel)
111− toAddTypeExpr _ = NoOperation
112+ toDatabaseContextExpr _ = NoOperation
112−-}
113−
114−instance Atomable a => Atomable (Maybe a) where
115− toAtom (Just v) = ConstructedAtom "Just" (maybeAtomType (toAtomType (Proxy :: Proxy a))) [toAtom v]
116− toAtom Nothing = ConstructedAtom "Nothing" (maybeAtomType (toAtomType (Proxy :: Proxy a))) []
117−
118− fromAtom (ConstructedAtom "Just" _ [val]) = Just (fromAtom val)
119− fromAtom (ConstructedAtom "Nothing" _ []) = Nothing
120− fromAtom _ = error "improper fromAtom (Maybe a)"
121−
122− toAtomType _ = ConstructedAtomType "Maybe" (M.singleton "a" (toAtomType (Proxy :: Proxy a)))
123− toAddTypeExpr _ = NoOperation
124−
125−instance (Atomable a, Atomable b) => Atomable (Either a b) where
126− toAtom (Left l) = ConstructedAtom "Left" (eitherAtomType (toAtomType (Proxy :: Proxy a))
127− (toAtomType (Proxy :: Proxy b))) [toAtom l]
128− toAtom (Right r) = ConstructedAtom "Right" (eitherAtomType (toAtomType (Proxy :: Proxy a))
129− (toAtomType (Proxy :: Proxy b))) [toAtom r]
130−
131− fromAtom (ConstructedAtom "Left" _ [val]) = Left (fromAtom val)
132− fromAtom (ConstructedAtom "Right" _ [val]) = Right (fromAtom val)
133− fromAtom _ = error "improper fromAtom (Either a b)"
134
113
135--convert to ADT list
114--convert to ADT list
136instance Atomable a => Atomable [a] where
115instance Atomable a => Atomable [a] where
137− toAtom [] = ConstructedAtom "Empty" (listAtomType (toAtomType (Proxy :: Proxy a))) []
116+ toAtom [] = ConstructedAtom "Empty" (listAtomType (toAtomType (undefined :: a))) []
138− toAtom (x:xs) = ConstructedAtom "Cons" (listAtomType (toAtomType (Proxy :: Proxy a))) (toAtom x: [toAtom xs])
117+ toAtom (x:xs) = ConstructedAtom "Cons" (listAtomType (toAtomType x)) (map toAtom (x:xs))
139
118
140 fromAtom (ConstructedAtom "Empty" _ _) = []
119 fromAtom (ConstructedAtom "Empty" _ _) = []
141− fromAtom (ConstructedAtom "Cons" _ [x,y]) = fromAtom x:fromAtom y
120+ fromAtom (ConstructedAtom "Cons" _ (x:xs)) = fromAtom x:map fromAtom xs
142 fromAtom _ = error "improper fromAtom [a]"
121 fromAtom _ = error "improper fromAtom [a]"
143
122
144− toAtomType _ = ConstructedAtomType "List" (M.singleton "a" (toAtomType (Proxy :: Proxy a)))
123+ toAtomType _ = ConstructedAtomType "List" (M.singleton "a" (toAtomType (undefined :: 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)))
153− toAddTypeExpr _ = NoOperation
124+ toDatabaseContextExpr _ = NoOperation
154
125
155-- Generics
126-- Generics
156class AtomableG g where
127class AtomableG g where
@@ -159,7 +130,7 @@ class AtomableG g where
159 fromAtomG :: Atom -> [Atom] -> Maybe (g a)
130 fromAtomG :: Atom -> [Atom] -> Maybe (g a)
160 toAtomTypeG :: g a -> AtomType --overall ConstructedAtomType
131 toAtomTypeG :: g a -> AtomType --overall ConstructedAtomType
161 toAtomsG :: g a -> [Atom]
132 toAtomsG :: g a -> [Atom]
162− toAddTypeExprG :: g a -> AtomType -> DatabaseContextExpr
133+ toDatabaseContextExprG :: g a -> AtomType -> DatabaseContextExpr
163 getConstructorsG :: g a -> [DataConstructorDef]
134 getConstructorsG :: g a -> [DataConstructorDef]
164 getConstructorArgsG :: g a -> [DataConstructorDefArg]
135 getConstructorArgsG :: g a -> [DataConstructorDefArg]
165
136
@@ -167,17 +138,17 @@ class AtomableG g where
167instance (Datatype c, AtomableG a) => AtomableG (M1 D c a) where
138instance (Datatype c, AtomableG a) => AtomableG (M1 D c a) where
168 toAtomG (M1 v) = toAtomG v
139 toAtomG (M1 v) = toAtomG v
169 fromAtomG atom args = M1 <$> fromAtomG atom args
140 fromAtomG atom args = M1 <$> fromAtomG atom args
170− toAtomsG = error "invalid toAtomsG in M1 D"
141+ toAtomsG = undefined
171 toAtomTypeG _ = ConstructedAtomType (T.pack typeName) M.empty -- generics don't allow us to get the type constructor variables- alternatives?
142 toAtomTypeG _ = ConstructedAtomType (T.pack typeName) M.empty -- generics don't allow us to get the type constructor variables- alternatives?
172 where
143 where
173 typeName = datatypeName (undefined :: M1 D c a x)
144 typeName = datatypeName (undefined :: M1 D c a x)
174− toAddTypeExprG ~(M1 v) (ConstructedAtomType tcName _) = AddTypeConstructor tcDef dataConstructors
145+ toDatabaseContextExprG (M1 v) (ConstructedAtomType tcName _) = AddTypeConstructor tcDef dataConstructors
175 where
146 where
176 tcDef = ADTypeConstructorDef tcName []
147 tcDef = ADTypeConstructorDef tcName []
177 dataConstructors = getConstructorsG v
148 dataConstructors = getConstructorsG v
178− toAddTypeExprG _ _ = NoOperation
149+ toDatabaseContextExprG _ _ = NoOperation
179− getConstructorsG ~(M1 v) = getConstructorsG v
150+ getConstructorsG (M1 v) = getConstructorsG v
180− getConstructorArgsG = error "invalid getConstructorArgsG in M1 D"
151+ getConstructorArgsG = undefined
181
152
182--constructor metadata
153--constructor metadata
183instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where
154instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where
@@ -192,11 +163,11 @@ instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where
192 Nothing
163 Nothing
193 where
164 where
194 dName = T.pack (conName (undefined :: M1 C c a x))
165 dName = T.pack (conName (undefined :: M1 C c a x))
195− fromAtomG _ _ = error "invalid fromAtomG in M1 C"
166+ fromAtomG _ _ = error "unsupported generic traversal"
196− toAtomsG = error "invalid toAtomsG in M1 C"
167+ toAtomsG = undefined
197− toAtomTypeG = error "invalid toAtomTypeG in M1 C"
168+ toAtomTypeG = undefined
198− toAddTypeExprG = error "invalid toAddTypeExprG in M1 C"
169+ toDatabaseContextExprG = undefined
199− getConstructorsG ~(M1 v) = [DataConstructorDef (T.pack dName) dArgs]
170+ getConstructorsG (M1 v) = [DataConstructorDef (T.pack dName) dArgs]
200 where
171 where
201 dName = conName (undefined :: M1 C c a x)
172 dName = conName (undefined :: M1 C c a x)
202 dArgs = getConstructorArgsG v
173 dArgs = getConstructorArgsG v
@@ -208,9 +179,9 @@ instance (Selector c, AtomableG a) => AtomableG (M1 S c a) where
208 fromAtomG atom args = M1 <$> fromAtomG atom args
179 fromAtomG atom args = M1 <$> fromAtomG atom args
209 toAtomsG (M1 v) = toAtomsG v
180 toAtomsG (M1 v) = toAtomsG v
210 toAtomTypeG (M1 v) = toAtomTypeG v
181 toAtomTypeG (M1 v) = toAtomTypeG v
211− toAddTypeExprG = error "invalid toAddTypeExprG in M1 S"
182+ toDatabaseContextExprG _ _ = undefined
212− getConstructorsG = error "invalid getConstructorsG in M1 S"
183+ getConstructorsG = undefined
213− getConstructorArgsG ~(M1 v) = getConstructorArgsG v
184+ getConstructorArgsG (M1 v) = getConstructorArgsG v
214
185
215-- field data metadata
186-- field data metadata
216instance (Atomable a) => AtomableG (K1 c a) where
187instance (Atomable a) => AtomableG (K1 c a) where
@@ -219,64 +190,49 @@ instance (Atomable a) => AtomableG (K1 c a) where
219 where headatom (x:_) = x
190 where headatom (x:_) = x
220 headatom [] = error "no more atoms for constructor!"
191 headatom [] = error "no more atoms for constructor!"
221 toAtomsG (K1 v) = [toAtom v]
192 toAtomsG (K1 v) = [toAtom v]
222− toAtomTypeG _ = toAtomType (Proxy :: Proxy a)
193+ toAtomTypeG _ = toAtomType (undefined :: a)
223− toAddTypeExprG = error "invalid toAddTypeExprG in K1"
194+ toDatabaseContextExprG _ _ = undefined
224− getConstructorsG = error "invalid getConstructorsG in K1"
195+ getConstructorsG = undefined
225− getConstructorArgsG ~(K1 _) = [DataConstructorDefTypeConstructorArg tCons]
196+ getConstructorArgsG (K1 v) = [DataConstructorDefTypeConstructorArg tCons]
226 where
197 where
227− tCons = typeToTypeConstructor $ toAtomType (Proxy :: Proxy a)
198+ tCons = PrimitiveTypeConstructor primitiveATypeName primitiveAType
228−
199+ primitiveAType = toAtomType v
229−typeToTypeConstructor :: AtomType -> TypeConstructor
200+ primitiveATypeName = fromMaybe (error ("primitive type missing: " ++ show primitiveAType)) (foldr (\(PrimitiveTypeConstructorDef name typ, _) _ -> if typ == primitiveAType then Just name else Nothing) Nothing primitiveTypeConstructorMapping)
230−typeToTypeConstructor x@IntAtomType = PrimitiveTypeConstructor "Int" x
201+
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−
247instance AtomableG U1 where
202instance AtomableG U1 where
248− toAtomG = error "invalid toAtomG in U1"
203+ toAtomG = undefined
249 fromAtomG _ _ = pure U1
204 fromAtomG _ _ = pure U1
250 toAtomsG _ = []
205 toAtomsG _ = []
251− toAtomTypeG = error "invalid toAtomTypeG in U1"
206+ toAtomTypeG = undefined
252− toAddTypeExprG = error "invalid toAddTypeExprG in U1"
207+ toDatabaseContextExprG = undefined
253− getConstructorsG = error "invalid getConstructorsG in U1"
208+ getConstructorsG = undefined
254 getConstructorArgsG _ = []
209 getConstructorArgsG _ = []
255
210
256-- product types
211-- product types
257instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where
212instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where
258 toAtomG = undefined
213 toAtomG = undefined
259− fromAtomG atom args = (:*:) <$> fromAtomG atom splitargs1 <*> fromAtomG atom splitargs2
214+ fromAtomG atom args = (:*:) <$> fromAtomG atom [headatom args] <*> fromAtomG atom (tailatoms args)
260− where splitargs1 = take splitpoint args
215+ where headatom (x:_) = x
261− splitargs2 = drop splitpoint args
216+ headatom [] = error "no more atoms in head for product!"
262− splitpoint = length args `div` 2
217+ tailatoms (_:xs) = xs
263− toAtomTypeG = error "invalid toAtomTypeG in :*:"
218+ tailatoms [] = error "no more atoms in tail for product!"
219+ toAtomTypeG = undefined
264 toAtomsG (x :*: y) = toAtomsG x ++ toAtomsG y
220 toAtomsG (x :*: y) = toAtomsG x ++ toAtomsG y
265− toAddTypeExprG = error "invalid toAddTypeExprG in :*:"
221+ toDatabaseContextExprG _ _ = undefined
266− getConstructorsG = error "invalid getConstructorsG in :*:"
222+ getConstructorsG = undefined
267− getConstructorArgsG ~(x :*: y) = getConstructorArgsG x ++ getConstructorArgsG y
223+ getConstructorArgsG (x :*: y) = getConstructorArgsG x ++ getConstructorArgsG y
268
224
269-- sum types
225-- sum types
270instance (AtomableG a, AtomableG b) => AtomableG (a :+: b) where
226instance (AtomableG a, AtomableG b) => AtomableG (a :+: b) where
271 toAtomG (L1 x) = toAtomG x
227 toAtomG (L1 x) = toAtomG x
272 toAtomG (R1 x) = toAtomG x
228 toAtomG (R1 x) = toAtomG x
273 fromAtomG atom args = (L1 <$> fromAtomG atom args) <|> (R1 <$> fromAtomG atom args)
229 fromAtomG atom args = (L1 <$> fromAtomG atom args) <|> (R1 <$> fromAtomG atom args)
274− toAtomTypeG = error "invalid toAtomTypeG in :+:"
230+ toAtomTypeG = undefined
275 toAtomsG (L1 x) = toAtomsG x
231 toAtomsG (L1 x) = toAtomsG x
276 toAtomsG (R1 x) = toAtomsG x
232 toAtomsG (R1 x) = toAtomsG x
277− toAddTypeExprG = error "invalid toAddTypeExprG in :+:"
233+ toDatabaseContextExprG _ _ = undefined
278 getConstructorsG _ = getConstructorsG (undefined :: a x) ++ getConstructorsG (undefined :: b x)
234 getConstructorsG _ = getConstructorsG (undefined :: a x) ++ getConstructorsG (undefined :: b x)
279− getConstructorArgsG = error "invalid getConstructorArgsG in :+:"
235+ getConstructorArgsG = undefined
280
236
281--this represents the unimplemented generics traversals which should never be called
237--this represents the unimplemented generics traversals which should never be called
282{-
238{-
src/lib/ProjectM36/Attribute.hs+31−170
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -fno-warn-orphans #-}
2module ProjectM36.Attribute where
1module ProjectM36.Attribute where
3import ProjectM36.Base
2import ProjectM36.Base
4import ProjectM36.Error
3import ProjectM36.Error
@@ -8,57 +7,18 @@ import qualified Data.Vector as V
8import qualified Data.Hashable as Hash
7import qualified Data.Hashable as Hash
9import qualified Data.HashSet as HS
8import qualified Data.HashSet as HS
10import qualified Data.Map as M
9import qualified Data.Map as M
11−import Data.Either
12
10
13arity :: Attributes -> Int
11arity :: Attributes -> Int
14−arity a = V.length (attributesVec a)
12+arity = V.length
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− }
27
13
28emptyAttributes :: Attributes
14emptyAttributes :: Attributes
29−emptyAttributes = mempty
15+emptyAttributes = V.empty
30
16
31null :: Attributes -> Bool
17null :: Attributes -> Bool
32−null a = V.null (attributesVec a)
18+null = V.null
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)
42
19
43attributesFromList :: [Attribute] -> Attributes
20attributesFromList :: [Attribute] -> Attributes
44−attributesFromList attrsL = Attributes {
21+attributesFromList = V.fromList -- . L.nub --too expensive
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
62
22
63attributeName :: Attribute -> AttributeName
23attributeName :: Attribute -> AttributeName
64attributeName (Attribute name _) = name
24attributeName (Attribute name _) = name
@@ -67,16 +27,14 @@ atomType :: Attribute -> AtomType
67atomType (Attribute _ atype) = atype
27atomType (Attribute _ atype) = atype
68
28
69atomTypes :: Attributes -> V.Vector AtomType
29atomTypes :: Attributes -> V.Vector AtomType
70−atomTypes attrs = V.map atomType (attributesVec attrs)
30+atomTypes = V.map atomType
71−
72−atomTypesList :: Attributes -> [AtomType]
73−atomTypesList = V.toList . atomTypes
74
31
32+--hm- no error-checking here
75addAttribute :: Attribute -> Attributes -> Attributes
33addAttribute :: Attribute -> Attributes -> Attributes
76−addAttribute attr attrs = attrs <> singleton attr
34+addAttribute attr attrs = attrs `V.snoc` attr
77
35
78--if some attribute names overlap but the types do not, then spit back an error
36--if some attribute names overlap but the types do not, then spit back an error
79−{-joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes
37+joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes
80joinAttributes attrs1 attrs2 | V.length uniqueOverlappingAttributes /= V.length overlappingAttributes = Left (TupleAttributeTypeMismatchError overlappingAttributes)
38joinAttributes attrs1 attrs2 | V.length uniqueOverlappingAttributes /= V.length overlappingAttributes = Left (TupleAttributeTypeMismatchError overlappingAttributes)
81 | V.length overlappingAttrsDifferentTypes > 0 = Left (TupleAttributeTypeMismatchError overlappingAttrsDifferentTypes)
39 | V.length overlappingAttrsDifferentTypes > 0 = Left (TupleAttributeTypeMismatchError overlappingAttrsDifferentTypes)
82 | otherwise = Right $ vectorUniqueify (attrs1 V.++ attrs2)
40 | otherwise = Right $ vectorUniqueify (attrs1 V.++ attrs2)
@@ -85,52 +43,20 @@ joinAttributes attrs1 attrs2 | V.length uniqueOverlappingAttributes /= V.length
85 attrNames2 = V.map attributeName attrs2
43 attrNames2 = V.map attributeName attrs2
86 uniqueOverlappingAttributes = vectorUniqueify overlappingAttributes
44 uniqueOverlappingAttributes = vectorUniqueify overlappingAttributes
87 overlappingAttributes = V.filter (`V.elem` attrs2) attrs1
45 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
46
107addAttributes :: Attributes -> Attributes -> Attributes
47addAttributes :: Attributes -> Attributes -> Attributes
108−addAttributes = (<>)
48+addAttributes = (V.++)
109−
110−member :: Attribute -> Attributes -> Bool
111−member attr attrs = HS.member attr (attributesSet attrs)
112
49
113deleteAttributeName :: AttributeName -> Attributes -> Attributes
50deleteAttributeName :: AttributeName -> Attributes -> Attributes
114−deleteAttributeName attrName = deleteAttributeNames (S.singleton attrName)
51+deleteAttributeName attrName = V.filter (\attr -> attributeName attr /= 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
52
124renameAttribute :: AttributeName -> Attribute -> Attribute
53renameAttribute :: AttributeName -> Attribute -> Attribute
125renameAttribute newAttrName (Attribute _ typeo) = Attribute newAttrName typeo
54renameAttribute newAttrName (Attribute _ typeo) = Attribute newAttrName typeo
126
55
127renameAttributes :: AttributeName -> AttributeName -> Attributes -> Attributes
56renameAttributes :: AttributeName -> AttributeName -> Attributes -> Attributes
128−renameAttributes oldAttrName newAttrName attrs = Attributes {
57+renameAttributes oldAttrName newAttrName = V.map renamer
129− attributesVec = vec
130− }
131 where
58 where
132− vec = V.map renamer (attributesVec attrs)
133− renamer attr = if attributeName attr == oldAttrName then
59+ renamer attr = if attributeName attr == oldAttrName then
134 renameAttribute newAttrName attr
60 renameAttribute newAttrName attr
135 else
61 else
136 attr
62 attr
@@ -141,36 +67,20 @@ atomTypeForAttributeName attrName attrs = do
141 return atype
67 return atype
142
68
143attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute
69attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute
144−attributeForName attrName attrs = case V.find (\attr -> attributeName attr == attrName) (attributesVec attrs) of
70+attributeForName attrName attrs = case V.find (\attr -> attributeName attr == attrName) attrs of
145 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))
71 Nothing -> Left (NoSuchAttributeNamesError (S.singleton attrName))
146 Just attr -> Right attr
72 Just attr -> Right attr
147
73
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−
161attributesForNames :: S.Set AttributeName -> Attributes -> Attributes
74attributesForNames :: S.Set AttributeName -> Attributes -> Attributes
162−attributesForNames attrNameSet attrs = Attributes {
75+attributesForNames attrNameSet = V.filter filt
163− attributesVec = vec
164− }
165 where
76 where
166− vec = V.filter filt (attributesVec attrs)
167 filt attr = S.member (attributeName attr) attrNameSet
77 filt attr = S.member (attributeName attr) attrNameSet
168
78
169attributeNameSet :: Attributes -> S.Set AttributeName
79attributeNameSet :: Attributes -> S.Set AttributeName
170−attributeNameSet attrs = S.fromList $ V.toList $ V.map (\(Attribute name _) -> name) (attributesVec attrs)
80+attributeNameSet attrVec = S.fromList $ V.toList $ V.map (\(Attribute name _) -> name) attrVec
171
81
172attributeNames :: Attributes -> V.Vector AttributeName
82attributeNames :: Attributes -> V.Vector AttributeName
173−attributeNames attrs = V.map attributeName (attributesVec attrs)
83+attributeNames = V.map attributeName
174
84
175--checks if set s1 is wholly contained in the set s2
85--checks if set s1 is wholly contained in the set s2
176attributesContained :: Attributes -> Attributes -> Bool
86attributesContained :: Attributes -> Attributes -> Bool
@@ -189,90 +99,41 @@ matchingAttributeNameSet = S.intersection
189attributeNamesNotContained :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
99attributeNamesNotContained :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
190attributeNamesNotContained subset superset = S.filter (`S.notMember` superset) subset
100attributeNamesNotContained subset superset = S.filter (`S.notMember` superset) subset
191
101
192−-- useful for display
102+-- this is sorted so the tuples know in which order to output- the ordering is arbitrary
193−orderedAttributes :: Attributes -> [Attribute]
103+sortedAttributeNameList :: S.Set AttributeName -> [AttributeName]
194−orderedAttributes attrs = L.sortBy (\a b -> attributeName a `compare` attributeName b) (V.toList (attributesVec attrs))
104+sortedAttributeNameList attrNameSet= L.sort $ S.toList attrNameSet
195−
196−orderedAttributeNames :: Attributes -> [AttributeName]
197−orderedAttributeNames attrs = map attributeName (orderedAttributes attrs)
198
105
199-- take two attribute sets and return an attribute set with the attributes which do not match
106-- 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
201attributesDifference :: Attributes -> Attributes -> Attributes
107attributesDifference :: Attributes -> Attributes -> Attributes
202−{-attributesDifference attrsA attrsB = V.fromList $ diff (V.toList attrsA) (V.toList attrsB)
108+attributesDifference attrsA attrsB = V.fromList $ diff (V.toList attrsA) (V.toList attrsB)
203 where
109 where
204 diff a b = (a L.\\ b) ++ (b L.\\ a)
110 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)
219
111
220vectorUniqueify :: (Hash.Hashable a, Eq a) => V.Vector a -> V.Vector a
112vectorUniqueify :: (Hash.Hashable a, Eq a) => V.Vector a -> V.Vector a
221vectorUniqueify vecIn = V.fromList $ HS.toList $ HS.fromList $ V.toList vecIn
113vectorUniqueify vecIn = V.fromList $ HS.toList $ HS.fromList $ V.toList vecIn
222
114
223--check that each attribute only appears once
115--check that each attribute only appears once
224verifyAttributes :: Attributes -> Either RelationalError Attributes
116verifyAttributes :: Attributes -> Either RelationalError Attributes
225−verifyAttributes attrs =
117+verifyAttributes attrs = if collapsedAttrs /= attrs then
226− if vecSet == attributesSet attrs then
227− pure attrs
228− else
229− Left (TupleAttributeTypeMismatchError diffAttrs)
118+ Left (TupleAttributeTypeMismatchError (attributesDifference collapsedAttrs attrs))
230− where
119+ else
231− vecSet = V.foldr' HS.insert HS.empty (attributesVec attrs)
120+ Right 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− }
243 where
121 where
244− vec = V.drop c (attributesVec attrs)
122+ collapsedAttrs = vectorUniqueify attrs
245
123
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)
252attributesEqual :: Attributes -> Attributes -> Bool
124attributesEqual :: Attributes -> Attributes -> Bool
253−attributesEqual attrsA attrsB =
125+attributesEqual attrs1 attrs2 = V.null (attributesDifference attrs1 attrs2)
254− attributesVec attrsA == attributesVec attrsB ||
255− attributesSet attrsA == attributesSet attrsB
256
126
257attributesAsMap :: Attributes -> M.Map AttributeName Attribute
127attributesAsMap :: Attributes -> M.Map AttributeName Attribute
258−attributesAsMap attrs = V.foldr' (\attr acc -> M.insert (attributeName attr) attr acc) mempty (attributesVec attrs)
128+attributesAsMap attrs = (M.fromList . V.toList) (V.map (\attr -> (attributeName attr, attr)) attrs)
259−
260
129
261-- | Left-biased union of attributes.
130-- | Left-biased union of attributes.
262union :: Attributes -> Attributes -> Attributes
131union :: Attributes -> Attributes -> Attributes
263−union attrsA attrsB = Attributes {
132+union attrsA attrsB = V.fromList (M.elems unioned)
264− attributesVec = vec
265− --,attributesSet = hset
266− }
267 where
133 where
268− hset = HS.union (attributesSet attrsA) (attributesSet attrsB)
134+ unioned = M.union (attributesAsMap attrsA) (attributesAsMap attrsB)
269− vec = HS.foldr (flip V.snoc) mempty hset
270
135
271intersection :: Attributes -> Attributes -> Attributes
136intersection :: Attributes -> Attributes -> Attributes
272−intersection attrsA attrsB = Attributes {
137+intersection attrsA attrsB = V.fromList (M.elems intersected)
273− attributesVec = vec
274− --,attributesSet = hset
275− }
276 where
138 where
277− hset = HS.intersection (attributesSet attrsA) (attributesSet attrsB)
139+ intersected = M.intersection (attributesAsMap attrsA) (attributesAsMap attrsB)
278− vec = HS.foldr (flip V.snoc) mempty hset
src/lib/ProjectM36/AttributeExpr.hsdeleted−7
@@ -1,7 +0,0 @@
1−module ProjectM36.AttributeExpr where
2−import ProjectM36.Base
3−import ProjectM36.Attribute as A
4−
5−attributeName :: AttributeExprBase a -> AttributeName
6−attributeName (AttributeAndTypeNameExpr nam _ _) = nam
7−attributeName (NakedAttributeExpr attr) = A.attributeName attr
src/lib/ProjectM36/AttributeNames.hs+30−3
@@ -1,11 +1,38 @@
1module ProjectM36.AttributeNames where
1module ProjectM36.AttributeNames where
2+import qualified ProjectM36.Attribute as A
2import ProjectM36.Base
3import ProjectM36.Base
4+import ProjectM36.Error
3import qualified Data.Set as S
5import qualified Data.Set as S
4−--AttributeNames is a data structure which can represent inverted projection attributes and attribute names derived from relational expressions
6+--AttributeNames is a data structure which can represent inverted projection attributes
5
7
6−empty :: AttributeNamesBase a
8+empty :: AttributeNames
7empty = AttributeNames S.empty
9empty = AttributeNames S.empty
8
10
9−all :: AttributeNamesBase a
11+all :: AttributeNames
10all = InvertedAttributeNames S.empty
12all = InvertedAttributeNames S.empty
11
13
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+119−251
@@ -1,12 +1,9 @@
1−{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass,FlexibleInstances,OverloadedStrings, DeriveTraversable, DerivingVia, TemplateHaskell, TypeFamilies #-}
1+{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass, TypeSynonymInstances, FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3−
4module ProjectM36.Base where
3module ProjectM36.Base where
5import ProjectM36.DatabaseContextFunctionError
4import ProjectM36.DatabaseContextFunctionError
6import ProjectM36.AtomFunctionError
5import ProjectM36.AtomFunctionError
7−import ProjectM36.MerkleHash
8
6
9−import Data.Functor.Foldable.TH
10import qualified Data.Map as M
7import qualified Data.Map as M
11import qualified Data.HashSet as HS
8import qualified Data.HashSet as HS
12import Data.Hashable (Hashable, hashWithSalt)
9import Data.Hashable (Hashable, hashWithSalt)
@@ -15,25 +12,22 @@ import Data.UUID (UUID)
15import Control.DeepSeq (NFData, rnf)
12import Control.DeepSeq (NFData, rnf)
16import Control.DeepSeq.Generics (genericRnf)
13import Control.DeepSeq.Generics (genericRnf)
17import GHC.Generics (Generic)
14import GHC.Generics (Generic)
18−import GHC.Stack
19import qualified Data.Vector as V
15import qualified Data.Vector as V
20import qualified Data.List as L
16import qualified Data.List as L
21import Data.Text (Text,unpack)
17import Data.Text (Text,unpack)
18+import Data.Binary
19+import Data.Vector.Binary()
22import Data.Time.Clock
20import Data.Time.Clock
21+import Data.Time.Clock.POSIX
22+import Data.Time.Calendar (Day,toGregorian,fromGregorian)
23import Data.Hashable.Time ()
23import Data.Hashable.Time ()
24−import Data.Time.Calendar (Day)
25import Data.Typeable
24import Data.Typeable
26import Data.ByteString (ByteString)
25import Data.ByteString (ByteString)
27−import qualified Data.List.NonEmpty as NE
28−import Data.Vector.Instances ()
29
26
30type StringType = Text
27type StringType = Text
31−
32−type DatabaseName = String
33
28
34-- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.
29-- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.
35−data Atom = IntegerAtom Integer |
36− IntAtom Int |
30+data Atom = IntAtom Int |
37 DoubleAtom Double |
31 DoubleAtom Double |
38 TextAtom Text |
32 TextAtom Text |
39 DayAtom Day |
33 DayAtom Day |
@@ -41,15 +35,13 @@ data Atom = IntegerAtom Integer |
41 ByteStringAtom ByteString |
35 ByteStringAtom ByteString |
42 BoolAtom Bool |
36 BoolAtom Bool |
43 RelationAtom Relation |
37 RelationAtom Relation |
44− RelationalExprAtom RelationalExpr | --used for returning inc deps
45 ConstructedAtom DataConstructorName AtomType [Atom]
38 ConstructedAtom DataConstructorName AtomType [Atom]
46− deriving (Eq, Show, Typeable, NFData, Generic, Read)
39+ deriving (Eq, Show, Binary, Typeable, NFData, Generic)
47
40
48instance Hashable Atom where
41instance Hashable Atom where
49 hashWithSalt salt (ConstructedAtom dConsName _ atoms) = salt `hashWithSalt` atoms
42 hashWithSalt salt (ConstructedAtom dConsName _ atoms) = salt `hashWithSalt` atoms
50 `hashWithSalt` dConsName --AtomType is not hashable
43 `hashWithSalt` dConsName --AtomType is not hashable
51 hashWithSalt salt (IntAtom i) = salt `hashWithSalt` i
44 hashWithSalt salt (IntAtom i) = salt `hashWithSalt` i
52− hashWithSalt salt (IntegerAtom i) = salt `hashWithSalt` i
53 hashWithSalt salt (DoubleAtom d) = salt `hashWithSalt` d
45 hashWithSalt salt (DoubleAtom d) = salt `hashWithSalt` d
54 hashWithSalt salt (TextAtom t) = salt `hashWithSalt` t
46 hashWithSalt salt (TextAtom t) = salt `hashWithSalt` t
55 hashWithSalt salt (DayAtom d) = salt `hashWithSalt` d
47 hashWithSalt salt (DayAtom d) = salt `hashWithSalt` d
@@ -57,12 +49,22 @@ instance Hashable Atom where
57 hashWithSalt salt (ByteStringAtom bs) = salt `hashWithSalt` bs
49 hashWithSalt salt (ByteStringAtom bs) = salt `hashWithSalt` bs
58 hashWithSalt salt (BoolAtom b) = salt `hashWithSalt` b
50 hashWithSalt salt (BoolAtom b) = salt `hashWithSalt` b
59 hashWithSalt salt (RelationAtom r) = salt `hashWithSalt` r
51 hashWithSalt salt (RelationAtom r) = salt `hashWithSalt` r
60− hashWithSalt salt (RelationalExprAtom re) = salt `hashWithSalt` re
52+
53+instance Binary UTCTime where
54+ put utc = put $ toRational (utcTimeToPOSIXSeconds utc)
55+ get = do
56+ r <- get :: Get Rational
57+ return (posixSecondsToUTCTime (fromRational r))
58+
59+instance Binary Day where
60+ put day = put $ toGregorian day
61+ get = do
62+ (y,m,d) <- get :: Get (Integer, Int, Int)
63+ return (fromGregorian y m d)
61
64
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.
65-- 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.
63-- | The AtomType uniquely identifies the type of a atom.
66-- | The AtomType uniquely identifies the type of a atom.
64−data AtomType = IntAtomType |
67+data AtomType = IntAtomType |
65− IntegerAtomType |
66 DoubleAtomType |
68 DoubleAtomType |
67 TextAtomType |
69 TextAtomType |
68 DayAtomType |
70 DayAtomType |
@@ -71,15 +73,10 @@ data AtomType = IntAtomType |
71 BoolAtomType |
73 BoolAtomType |
72 RelationAtomType Attributes |
74 RelationAtomType Attributes |
73 ConstructedAtomType TypeConstructorName TypeVarMap |
75 ConstructedAtomType TypeConstructorName TypeVarMap |
74− RelationalExprAtomType |
75 TypeVariableType TypeVarName
76 TypeVariableType TypeVarName
76 --wildcard used in Atom Functions and tuples for data constructors which don't provide all arguments to the type constructor
77 --wildcard used in Atom Functions and tuples for data constructors which don't provide all arguments to the type constructor
77− deriving (Eq, NFData, Generic, Show, Read, Hashable)
78+ deriving (Eq, NFData, Generic, Binary, Show)
78−
79+
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
83type TypeVarMap = M.Map TypeVarName AtomType
80type TypeVarMap = M.Map TypeVarName AtomType
84
81
85instance Hashable TypeVarMap where
82instance Hashable TypeVarMap where
@@ -94,37 +91,25 @@ isRelationAtomType _ = False
94type AttributeName = StringType
91type AttributeName = StringType
95
92
96-- | A relation's type is composed of attribute names and types.
93-- | A relation's type is composed of attribute names and types.
97−data Attribute = Attribute AttributeName AtomType deriving (Eq, Show, Read, Generic, NFData)
94+data Attribute = Attribute AttributeName AtomType deriving (Eq, Show, Generic, NFData, Binary)
98
95
99instance Hashable Attribute where
96instance Hashable Attribute where
100 hashWithSalt salt (Attribute attrName _) = hashWithSalt salt attrName
97 hashWithSalt salt (Attribute attrName _) = hashWithSalt salt attrName
101
98
102−type AttributesHash = Int
103−
104-- | 'Attributes' represent the head of a relation.
99-- | 'Attributes' represent the head of a relation.
105−newtype Attributes = Attributes {
106− attributesVec :: V.Vector Attribute
100+type Attributes = 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
122
101
102+-- | Equality function for a set of attributes.
103+attributesEqual :: Attributes -> Attributes -> Bool
104+attributesEqual attrs1 attrs2 = attrsAsSet attrs1 == attrsAsSet attrs2
105+ where
106+ attrsAsSet = HS.fromList . V.toList
107+
123sortedAttributesIndices :: Attributes -> [(Int, Attribute)]
108sortedAttributesIndices :: Attributes -> [(Int, Attribute)]
124−sortedAttributesIndices attrs = L.sortBy (\(_, Attribute name1 _) (_,Attribute name2 _) -> compare name1 name2) $ V.toList (V.indexed (attributesVec attrs))
109+sortedAttributesIndices attrs = L.sortBy (\(_, Attribute name1 _) (_,Attribute name2 _) -> compare name1 name2) $ V.toList (V.indexed attrs)
125
110
126-- | The relation's tuple set is the body of the relation.
111-- | The relation's tuple set is the body of the relation.
127−newtype RelationTupleSet = RelationTupleSet { asList :: [RelationTuple] } deriving (Hashable, Show, Generic, Read)
112+newtype RelationTupleSet = RelationTupleSet { asList :: [RelationTuple] } deriving (Hashable, Show, Generic, Binary)
128
113
129instance Read Relation where
114instance Read Relation where
130 readsPrec = error "relation read not supported"
115 readsPrec = error "relation read not supported"
@@ -140,8 +125,8 @@ instance NFData RelationTupleSet where rnf = genericRnf
140instance Hashable RelationTuple where
125instance Hashable RelationTuple where
141 --sanity check the tuple for attribute and tuple counts
126 --sanity check the tuple for attribute and tuple counts
142 --this bit me when tuples were being hashed before being verified
127 --this bit me when tuples were being hashed before being verified
143− hashWithSalt salt (RelationTuple attrs tupVec) = if V.length (attributesVec attrs) /= V.length tupVec then
128+ hashWithSalt salt (RelationTuple attrs tupVec) = if V.length attrs /= V.length tupVec then
144− error ("invalid tuple: attributes and tuple count mismatch " <> show (attributesVec attrs, tupVec))
129+ error "invalid tuple: attributes and tuple count mismatch"
145 else
130 else
146 salt `hashWithSalt`
131 salt `hashWithSalt`
147 sortedAttrs `hashWithSalt`
132 sortedAttrs `hashWithSalt`
@@ -152,23 +137,24 @@ instance Hashable RelationTuple where
152 sortedTupVec = V.map (\(index, _) -> tupVec V.! index) $ V.fromList sortedAttrsIndices
137 sortedTupVec = V.map (\(index, _) -> tupVec V.! index) $ V.fromList sortedAttrsIndices
153
138
154-- | A tuple is a set of attributes mapped to their 'Atom' values.
139-- | A tuple is a set of attributes mapped to their 'Atom' values.
155−data RelationTuple = RelationTuple Attributes (V.Vector Atom) deriving (Show, Read, Generic)
140+data RelationTuple = RelationTuple Attributes (V.Vector Atom) deriving (Show, Generic)
141+
142+instance Binary RelationTuple
156
143
157instance Eq RelationTuple where
144instance Eq RelationTuple where
158− tuple1@(RelationTuple attrs1 _) == tuple2@(RelationTuple attrs2 _) =
145+ (==) tuple1@(RelationTuple attrs1 _) tuple2@(RelationTuple attrs2 _) = attributesEqual attrs1 attrs2 && atomsEqual
159− attrs1 == attrs2 && atomsEqual
160 where
146 where
161− atomForAttribute attr (RelationTuple attrs tupVec) = case V.findIndex (== attr) (attributesVec attrs) of
147+ atomForAttribute attr (RelationTuple attrs tupVec) = case V.findIndex (== attr) attrs of
162− Nothing -> Nothing
148+ Nothing -> Nothing
163− Just index -> tupVec V.!? index
149+ Just index -> tupVec V.!? index
164− atomsEqual = V.all (== True) $ V.map (\attr -> atomForAttribute attr tuple1 == atomForAttribute attr tuple2) (attributesVec attrs1)
150+ atomsEqual = V.all (== True) $ V.map (\attr -> atomForAttribute attr tuple1 == atomForAttribute attr tuple2) attrs1
165
151
166instance NFData RelationTuple where rnf = genericRnf
152instance NFData RelationTuple where rnf = genericRnf
167
153
168data Relation = Relation Attributes RelationTupleSet deriving (Show, Generic,Typeable)
154data Relation = Relation Attributes RelationTupleSet deriving (Show, Generic,Typeable)
169
155
170instance Eq Relation where
156instance Eq Relation where
171− Relation attrs1 tupSet1 == Relation attrs2 tupSet2 = attrs1 == attrs2 && tupSet1 == tupSet2
157+ Relation attrs1 tupSet1 == Relation attrs2 tupSet2 = attributesEqual attrs1 attrs2 && tupSet1 == tupSet2
172
158
173instance NFData Relation where rnf = genericRnf
159instance NFData Relation where rnf = genericRnf
174
160
@@ -179,6 +165,8 @@ instance Hashable Relation where
179 where
165 where
180 sortedAttrs = map snd (sortedAttributesIndices attrs)
166 sortedAttrs = map snd (sortedAttributesIndices attrs)
181
167
168+instance Binary Relation
169+
182-- | Used to represent the number of tuples in a relation.
170-- | Used to represent the number of tuples in a relation.
183data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)
171data RelationCardinality = Countable | Finite Int deriving (Eq, Show, Generic, Ord)
184
172
@@ -190,7 +178,7 @@ type RelationalExpr = RelationalExprBase ()
190-- | A relational expression represents query (read) operations on a database.
178-- | A relational expression represents query (read) operations on a database.
191data RelationalExprBase a =
179data RelationalExprBase a =
192 --- | Create a relation from tuple expressions.
180 --- | Create a relation from tuple expressions.
193− MakeRelationFromExprs (Maybe [AttributeExprBase a]) (TupleExprsBase a) |
181+ MakeRelationFromExprs (Maybe [AttributeExprBase a]) [TupleExprBase a] |
194 --- | Create and reference a relation from attributes and a tuple set.
182 --- | Create and reference a relation from attributes and a tuple set.
195 MakeStaticRelation Attributes RelationTupleSet |
183 MakeStaticRelation Attributes RelationTupleSet |
196 --- | Reference an existing relation in Haskell-space.
184 --- | Reference an existing relation in Haskell-space.
@@ -199,9 +187,9 @@ data RelationalExprBase a =
199 --in Tutorial D, relational variables pick up the type of the first relation assigned to them
187 --in Tutorial D, relational variables pick up the type of the first relation assigned to them
200 --relational variables should also be able to be explicitly-typed like in Haskell
188 --relational variables should also be able to be explicitly-typed like in Haskell
201 --- | Reference a relation variable by its name.
189 --- | Reference a relation variable by its name.
202− RelationVariable RelVarName a |
190+ RelationVariable RelVarName a |
203 --- | Create a projection over attribute names. (Note that the 'AttributeNames' structure allows for the names to be inverted.)
191 --- | Create a projection over attribute names. (Note that the 'AttributeNames' structure allows for the names to be inverted.)
204− Project (AttributeNamesBase a) (RelationalExprBase a) |
192+ Project AttributeNames (RelationalExprBase a) |
205 --- | Create a union of two relational expressions. The expressions should have identical attributes.
193 --- | Create a union of two relational expressions. The expressions should have identical attributes.
206 Union (RelationalExprBase a) (RelationalExprBase a) |
194 Union (RelationalExprBase a) (RelationalExprBase a) |
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.
195 --- | 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.
@@ -211,7 +199,7 @@ data RelationalExprBase a =
211 --- | Return a relation containing all tuples of the first argument which do not appear in the second argument (minus).
199 --- | Return a relation containing all tuples of the first argument which do not appear in the second argument (minus).
212 Difference (RelationalExprBase a) (RelationalExprBase a) |
200 Difference (RelationalExprBase a) (RelationalExprBase a) |
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.>
201 --- | 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.>
214− Group (AttributeNamesBase a) AttributeName (RelationalExprBase a) |
202+ Group AttributeNames AttributeName (RelationalExprBase a) |
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.
203 --- | 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.
216 Ungroup AttributeName (RelationalExprBase a) |
204 Ungroup AttributeName (RelationalExprBase a) |
217 --- | Filter the tuples of the relational expression to only retain the tuples which evaluate against the restriction predicate to true.
205 --- | Filter the tuples of the relational expression to only retain the tuples which evaluate against the restriction predicate to true.
@@ -219,46 +207,34 @@ data RelationalExprBase a =
219 --- | Returns the true relation iff
207 --- | Returns the true relation iff
220 Equals (RelationalExprBase a) (RelationalExprBase a) |
208 Equals (RelationalExprBase a) (RelationalExprBase a) |
221 NotEquals (RelationalExprBase a) (RelationalExprBase a) |
209 NotEquals (RelationalExprBase a) (RelationalExprBase a) |
222− Extend (ExtendTupleExprBase a) (RelationalExprBase a) |
210+ Extend (ExtendTupleExprBase a) (RelationalExprBase a)
223 --Summarize :: AtomExpr -> AttributeName -> RelationalExpr -> RelationalExpr -> RelationalExpr -- a special case of Extend
211 --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)
226− deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable)
212+ deriving (Show, Eq, Generic, NFData)
227−
213+
228−instance Hashable RelationalExpr
214+instance Binary RelationalExpr
229−
215+
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−
237type NotificationName = StringType
216type NotificationName = StringType
238type Notifications = M.Map NotificationName Notification
217type Notifications = M.Map NotificationName Notification
239
218
240-- | When the changeExpr returns a different result in the database context, then the reportExpr is triggered and sent asynchronously to all clients.
219-- | When the changeExpr returns a different result in the database context, then the reportExpr is triggered and sent asynchronously to all clients.
241data Notification = Notification {
220data Notification = Notification {
242 changeExpr :: RelationalExpr,
221 changeExpr :: RelationalExpr,
243− reportOldExpr :: RelationalExpr, --run the expression in the pre-change context
222+ reportExpr :: RelationalExpr
244− reportNewExpr :: RelationalExpr --run the expression in the post-change context
245 }
223 }
246− deriving (Show, Eq, Generic, NFData)
224+ deriving (Show, Eq, Binary, Generic, NFData)
247
225
248type TypeVarName = StringType
226type TypeVarName = StringType
249
227
250-- | Metadata definition for type constructors such as @data Either a b@.
228-- | Metadata definition for type constructors such as @data Either a b@.
251data TypeConstructorDef = ADTypeConstructorDef TypeConstructorName [TypeVarName] |
229data TypeConstructorDef = ADTypeConstructorDef TypeConstructorName [TypeVarName] |
252 PrimitiveTypeConstructorDef TypeConstructorName AtomType
230 PrimitiveTypeConstructorDef TypeConstructorName AtomType
253− deriving (Show, Generic, Eq, NFData, Hashable, Read)
231+ deriving (Show, Generic, Binary, Eq, NFData)
254
232
255-- | Found in data constructors and type declarations: Left (Either Int Text) | Right Int
233-- | Found in data constructors and type declarations: Left (Either Int Text) | Right Int
256−type TypeConstructor = TypeConstructorBase ()
257−data TypeConstructorBase a = ADTypeConstructor TypeConstructorName [TypeConstructor] |
234+data TypeConstructor = ADTypeConstructor TypeConstructorName [TypeConstructor] |
258− PrimitiveTypeConstructor TypeConstructorName AtomType |
235+ PrimitiveTypeConstructor TypeConstructorName AtomType |
259− RelationAtomTypeConstructor [AttributeExprBase a] |
260− TypeVariable TypeVarName
236+ TypeVariable TypeVarName
261− deriving (Show, Generic, Eq, NFData, Hashable, Read)
237+ deriving (Show, Generic, Binary, Eq, NFData)
262
238
263type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)]
239type TypeConstructorMapping = [(TypeConstructorDef, DataConstructorDefs)]
264
240
@@ -268,23 +244,16 @@ type DataConstructorName = StringType
268type AtomTypeName = StringType
244type AtomTypeName = StringType
269
245
270-- | Used to define a data constructor in a type constructor context such as @Left a | Right b@
246-- | Used to define a data constructor in a type constructor context such as @Left a | Right b@
271−data DataConstructorDef = DataConstructorDef DataConstructorName [DataConstructorDefArg] deriving (Eq, Show, Generic, NFData, Hashable, Read)
247+data DataConstructorDef = DataConstructorDef DataConstructorName [DataConstructorDefArg] deriving (Eq, Show, Binary, Generic, NFData)
272
248
273type DataConstructorDefs = [DataConstructorDef]
249type DataConstructorDefs = [DataConstructorDef]
274
250
275data DataConstructorDefArg = DataConstructorDefTypeConstructorArg TypeConstructor |
251data DataConstructorDefArg = DataConstructorDefTypeConstructorArg TypeConstructor |
276 DataConstructorDefTypeVarNameArg TypeVarName
252 DataConstructorDefTypeVarNameArg TypeVarName
277− deriving (Show, Generic, Eq, NFData, Hashable, Read)
253+ deriving (Show, Generic, Binary, Eq, NFData)
278
254
279type InclusionDependencies = M.Map IncDepName InclusionDependency
255type InclusionDependencies = M.Map IncDepName InclusionDependency
280−type RelationVariables = M.Map RelVarName GraphRefRelationalExpr
256+type RelationVariables = M.Map RelVarName Relation
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
288
257
289type SchemaName = StringType
258type SchemaName = StringType
290
259
@@ -292,18 +261,17 @@ type Subschemas = M.Map SchemaName Schema
292
261
293-- | Every transaction has one concrete database context and any number of isomorphic subschemas.
262-- | Every transaction has one concrete database context and any number of isomorphic subschemas.
294data Schemas = Schemas DatabaseContext Subschemas
263data Schemas = Schemas DatabaseContext Subschemas
295− deriving (Generic)
296
264
297-- | The DatabaseContext is a snapshot of a database's evolving state and contains everything a database client can change over time.
265-- | The DatabaseContext is a snapshot of a database's evolving state and contains everything a database client can change over time.
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.
266-- 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.
299newtype Schema = Schema SchemaIsomorphs
267newtype Schema = Schema SchemaIsomorphs
300− deriving (Generic)
268+ deriving (Generic, Binary)
301
269
302data SchemaIsomorph = IsoRestrict RelVarName RestrictionPredicateExpr (RelVarName, RelVarName) |
270data SchemaIsomorph = IsoRestrict RelVarName RestrictionPredicateExpr (RelVarName, RelVarName) |
303 IsoRename RelVarName RelVarName |
271 IsoRename RelVarName RelVarName |
304 IsoUnion (RelVarName, RelVarName) RestrictionPredicateExpr RelVarName --maps two relvars to one relvar
272 IsoUnion (RelVarName, RelVarName) RestrictionPredicateExpr RelVarName --maps two relvars to one relvar
305 -- IsoTypeConstructor in morphAttrExpr
273 -- IsoTypeConstructor in morphAttrExpr
306− deriving (Generic, Show)
274+ deriving (Generic, Binary, Show)
307
275
308type SchemaIsomorphs = [SchemaIsomorph]
276type SchemaIsomorphs = [SchemaIsomorph]
309
277
@@ -319,33 +287,29 @@ data DatabaseContext = DatabaseContext {
319type IncDepName = StringType
287type IncDepName = StringType
320
288
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.
289-- | Inclusion dependencies represent every possible database constraint. Constraints enforce specific, arbitrarily-complex rules to which the database context's relation variables must adhere unconditionally.
322−data InclusionDependency = InclusionDependency RelationalExpr RelationalExpr deriving (Show, Eq, Generic, NFData, Hashable, Read)
290+data InclusionDependency = InclusionDependency RelationalExpr RelationalExpr deriving (Show, Eq, Generic, NFData)
291+
292+instance Binary InclusionDependency
323
293
324type AttributeNameAtomExprMap = M.Map AttributeName AtomExpr
294type AttributeNameAtomExprMap = M.Map AttributeName AtomExpr
325
295
326--used for returning information about individual expressions
296--used for returning information about individual expressions
327type DatabaseContextExprName = StringType
297type DatabaseContextExprName = StringType
328
298
329−type DatabaseContextExpr = DatabaseContextExprBase ()
330−
331−instance Hashable DatabaseContextExpr
332−
333−type GraphRefDatabaseContextExpr = DatabaseContextExprBase GraphRefTransactionMarker
334−
335-- | Database context expressions modify the database context.
299-- | Database context expressions modify the database context.
336−data DatabaseContextExprBase a =
300+data DatabaseContextExpr =
337 NoOperation |
301 NoOperation |
338− Define RelVarName [AttributeExprBase a] |
302+ Define RelVarName [AttributeExpr] |
339 Undefine RelVarName | --forget existence of relvar X
303 Undefine RelVarName | --forget existence of relvar X
340− Assign RelVarName (RelationalExprBase a) |
304+ Assign RelVarName RelationalExpr |
341− Insert RelVarName (RelationalExprBase a) |
305+ Insert RelVarName RelationalExpr |
342− Delete RelVarName (RestrictionPredicateExprBase a) |
306+ Delete RelVarName RestrictionPredicateExpr |
343− Update RelVarName AttributeNameAtomExprMap (RestrictionPredicateExprBase a) |
307+ Update RelVarName AttributeNameAtomExprMap RestrictionPredicateExpr |
344
308
345 AddInclusionDependency IncDepName InclusionDependency |
309 AddInclusionDependency IncDepName InclusionDependency |
346 RemoveInclusionDependency IncDepName |
310 RemoveInclusionDependency IncDepName |
347
311
348− AddNotification NotificationName RelationalExpr RelationalExpr RelationalExpr |
312+ AddNotification NotificationName RelationalExpr RelationalExpr |
349 RemoveNotification NotificationName |
313 RemoveNotification NotificationName |
350
314
351 AddTypeConstructor TypeConstructorDef [DataConstructorDef] |
315 AddTypeConstructor TypeConstructorDef [DataConstructorDef] |
@@ -356,36 +320,19 @@ data DatabaseContextExprBase a =
356
320
357 RemoveDatabaseContextFunction DatabaseContextFunctionName |
321 RemoveDatabaseContextFunction DatabaseContextFunctionName |
358
322
359− ExecuteDatabaseContextFunction DatabaseContextFunctionName [AtomExprBase a] |
323+ ExecuteDatabaseContextFunction DatabaseContextFunctionName [AtomExpr] |
360
324
361− MultipleExpr [DatabaseContextExprBase a]
325+ MultipleExpr [DatabaseContextExpr]
362− deriving (Show, Read, Eq, Generic, NFData)
326+ deriving (Show, Eq, Binary, Generic)
363
327
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)
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.
328-- | 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 =
372− AddAtomFunction AtomFunctionName [TypeConstructor] AtomFunctionBodyScript |
329+data DatabaseContextIOExpr = AddAtomFunction AtomFunctionName [TypeConstructor] AtomFunctionBodyScript |
373− LoadAtomFunctions ObjModuleName ObjFunctionName FilePath |
374− AddDatabaseContextFunction DatabaseContextFunctionName [TypeConstructor] DatabaseContextFunctionBodyScript |
330+ AddDatabaseContextFunction DatabaseContextFunctionName [TypeConstructor] DatabaseContextFunctionBodyScript
375− LoadDatabaseContextFunctions ObjModuleName ObjFunctionName FilePath |
376− CreateArbitraryRelation RelVarName [AttributeExprBase a] Range
377− deriving (Show, Eq, Generic)
331+ deriving (Show, Eq, Generic, Binary)
378−
379−type GraphRefDatabaseContextIOExpr = DatabaseContextIOExprBase GraphRefTransactionMarker
380
332
381−type DatabaseContextIOExpr = DatabaseContextIOExprBase ()
382
333
383type RestrictionPredicateExpr = RestrictionPredicateExprBase ()
334type RestrictionPredicateExpr = RestrictionPredicateExprBase ()
384
335
385−instance Hashable RestrictionPredicateExpr
386−
387−type GraphRefRestrictionPredicateExpr = RestrictionPredicateExprBase GraphRefTransactionMarker
388−
389-- | Restriction predicates are boolean algebra components which, when composed, indicate whether or not a tuple should be retained during a restriction (filtering) operation.
336-- | Restriction predicates are boolean algebra components which, when composed, indicate whether or not a tuple should be retained during a restriction (filtering) operation.
390data RestrictionPredicateExprBase a =
337data RestrictionPredicateExprBase a =
391 TruePredicate |
338 TruePredicate |
@@ -395,7 +342,9 @@ data RestrictionPredicateExprBase a =
395 RelationalExprPredicate (RelationalExprBase a) | --type must be same as true and false relations (no attributes)
342 RelationalExprPredicate (RelationalExprBase a) | --type must be same as true and false relations (no attributes)
396 AtomExprPredicate (AtomExprBase a) | --atom must evaluate to boolean
343 AtomExprPredicate (AtomExprBase a) | --atom must evaluate to boolean
397 AttributeEqualityPredicate AttributeName (AtomExprBase a) -- relationalexpr must result in relation with single tuple
344 AttributeEqualityPredicate AttributeName (AtomExprBase a) -- relationalexpr must result in relation with single tuple
398− deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable)
345+ deriving (Show, Eq, Generic, NFData)
346+
347+instance Binary RestrictionPredicateExpr
399
348
400-- child + parent links
349-- child + parent links
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.
350-- | 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.
@@ -405,42 +354,32 @@ type TransactionHeads = M.Map HeadName Transaction
405
354
406-- | The transaction graph is the global database's state which references every committed transaction.
355-- | The transaction graph is the global database's state which references every committed transaction.
407data TransactionGraph = TransactionGraph TransactionHeads (S.Set Transaction)
356data TransactionGraph = TransactionGraph TransactionHeads (S.Set Transaction)
408− deriving Generic
409−
410−transactionHeadsForGraph :: TransactionGraph -> TransactionHeads
411−transactionHeadsForGraph (TransactionGraph hs _) = hs
412
357
413transactionsForGraph :: TransactionGraph -> S.Set Transaction
358transactionsForGraph :: TransactionGraph -> S.Set Transaction
414−transactionsForGraph (TransactionGraph _ ts) = ts
359+transactionsForGraph (TransactionGraph _ t) = t
360+
361+transactionHeadsForGraph :: TransactionGraph -> TransactionHeads
362+transactionHeadsForGraph (TransactionGraph heads _) = heads
415
363
416-- | Every transaction has context-specific information attached to it.
364-- | 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).
418−data TransactionInfo = TransactionInfo {
365+data TransactionInfo = TransactionInfo TransactionId (S.Set TransactionId) | -- 1 parent + n children
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
427− MergeTransactionInfo TransactionId TransactionId TransactionDiffs UTCTime -- 2 parents, n children
366+ MergeTransactionInfo TransactionId TransactionId (S.Set TransactionId) -- 2 parents, n children
428− deriving (Show, Generic)
367+ deriving(Show, Generic)
429−-}
368+
369+instance Binary TransactionInfo
430
370
431-- | Every set of modifications made to the database are atomically committed to the transaction graph as a transaction.
371-- | Every set of modifications made to the database are atomically committed to the transaction graph as a transaction.
432type TransactionId = UUID
372type TransactionId = UUID
433
373
434data Transaction = Transaction TransactionId TransactionInfo Schemas
374data Transaction = Transaction TransactionId TransactionInfo Schemas
435− deriving Generic
436
375
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.
376+--instance Binary Transaction
438−data DisconnectedTransaction = DisconnectedTransaction TransactionId Schemas DirtyFlag
377+
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−
441type DirtyFlag = Bool
378type DirtyFlag = Bool
442
379
443−type TransactionDiffExpr = DatabaseContextExpr
380+-- | 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.
381+data DisconnectedTransaction = DisconnectedTransaction TransactionId Schemas DirtyFlag --parentID, context- the context here represents the singular concrete context from the schema
382+--the dirty flag indicates that the database context has diverged from its parent's context
444
383
445transactionId :: Transaction -> TransactionId
384transactionId :: Transaction -> TransactionId
446transactionId (Transaction tid _ _) = tid
385transactionId (Transaction tid _ _) = tid
@@ -456,28 +395,24 @@ instance Ord Transaction where
456
395
457type AtomExpr = AtomExprBase ()
396type AtomExpr = AtomExprBase ()
458
397
459−instance Hashable AtomExpr
460−
461−type GraphRefAtomExpr = AtomExprBase GraphRefTransactionMarker
462−
463-- | An atom expression represents an action to take when extending a relation or when statically defining a relation or a new tuple.
398-- | An atom expression represents an action to take when extending a relation or when statically defining a relation or a new tuple.
464data AtomExprBase a = AttributeAtomExpr AttributeName |
399data AtomExprBase a = AttributeAtomExpr AttributeName |
465 NakedAtomExpr Atom |
400 NakedAtomExpr Atom |
466 FunctionAtomExpr AtomFunctionName [AtomExprBase a] a |
401 FunctionAtomExpr AtomFunctionName [AtomExprBase a] a |
467 RelationAtomExpr (RelationalExprBase a) |
402 RelationAtomExpr (RelationalExprBase a) |
468 ConstructedAtomExpr DataConstructorName [AtomExprBase a] a
403 ConstructedAtomExpr DataConstructorName [AtomExprBase a] a
469− deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)
404+ deriving (Eq,Show,Generic, NFData)
470
405
406+instance Binary AtomExpr
407+
471-- | Used in tuple creation when creating a relation.
408-- | Used in tuple creation when creating a relation.
472data ExtendTupleExprBase a = AttributeExtendTupleExpr AttributeName (AtomExprBase a)
409data ExtendTupleExprBase a = AttributeExtendTupleExpr AttributeName (AtomExprBase a)
473− deriving (Show, Read, Eq, Generic, NFData, Foldable, Functor, Traversable)
410+ deriving (Show, Eq, Generic, NFData)
474
411
475−type ExtendTupleExpr = ExtendTupleExprBase ()
412+type ExtendTupleExpr = ExtendTupleExprBase ()
476−
477−instance Hashable ExtendTupleExpr
478−
479−type GraphRefExtendTupleExpr = ExtendTupleExprBase GraphRefTransactionMarker
480
413
414+instance Binary ExtendTupleExpr
415+
481--enumerates the list of functions available to be run as part of tuple expressions
416--enumerates the list of functions available to be run as part of tuple expressions
482type AtomFunctions = HS.HashSet AtomFunction
417type AtomFunctions = HS.HashSet AtomFunction
483
418
@@ -488,7 +423,6 @@ type AtomFunctionBodyScript = StringType
488type AtomFunctionBodyType = [Atom] -> Either AtomFunctionError Atom
423type AtomFunctionBodyType = [Atom] -> Either AtomFunctionError Atom
489
424
490data AtomFunctionBody = AtomFunctionBody (Maybe AtomFunctionBodyScript) AtomFunctionBodyType
425data AtomFunctionBody = AtomFunctionBody (Maybe AtomFunctionBodyScript) AtomFunctionBodyType
491− deriving Generic
492
426
493instance NFData AtomFunctionBody where
427instance NFData AtomFunctionBody where
494 rnf (AtomFunctionBody mScript _) = rnf mScript
428 rnf (AtomFunctionBody mScript _) = rnf mScript
@@ -518,22 +452,12 @@ instance Show AtomFunction where
518 showArgTypes = L.intercalate "->" (map show (atomFuncType aFunc))
452 showArgTypes = L.intercalate "->" (map show (atomFuncType aFunc))
519
453
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").
454-- | 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").
521−data AttributeNamesBase a = AttributeNames (S.Set AttributeName) |
455+data AttributeNames = AttributeNames (S.Set AttributeName) |
522− InvertedAttributeNames (S.Set AttributeName) |
456+ InvertedAttributeNames (S.Set AttributeName) |
523− UnionAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |
457+ UnionAttributeNames AttributeNames AttributeNames |
524− IntersectAttributeNames (AttributeNamesBase a) (AttributeNamesBase a) |
458+ IntersectAttributeNames AttributeNames AttributeNames
525− RelationalExprAttributeNames (RelationalExprBase a) -- use attribute names from the relational expression's type
526− deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)
459+ deriving (Eq, Show, Generic, Binary, NFData)
527−
460+
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−
537-- | The persistence strategy is a global database option which represents how to persist the database in the filesystem, if at all.
461-- | The persistence strategy is a global database option which represents how to persist the database in the filesystem, if at all.
538data PersistenceStrategy = NoPersistence | -- ^ no filesystem persistence/memory-only database
462data PersistenceStrategy = NoPersistence | -- ^ no filesystem persistence/memory-only database
539 MinimalPersistence FilePath | -- ^ fsync off, not crash-safe
463 MinimalPersistence FilePath | -- ^ fsync off, not crash-safe
@@ -541,31 +465,19 @@ data PersistenceStrategy = NoPersistence | -- ^ no filesystem persistence/memory
541 deriving (Show, Read)
465 deriving (Show, Read)
542
466
543type AttributeExpr = AttributeExprBase ()
467type AttributeExpr = AttributeExprBase ()
544−type GraphRefAttributeExpr = AttributeExprBase GraphRefTransactionMarker
545
468
546-- | Create attributes dynamically.
469-- | Create attributes dynamically.
547data AttributeExprBase a = AttributeAndTypeNameExpr AttributeName TypeConstructor a |
470data AttributeExprBase a = AttributeAndTypeNameExpr AttributeName TypeConstructor a |
548 NakedAttributeExpr Attribute
471 NakedAttributeExpr Attribute
549− deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable, Hashable)
472+ deriving (Eq, Show, Generic, Binary, NFData)
550
473
551-- | Dynamically create a tuple from attribute names and 'AtomExpr's.
474-- | Dynamically create a tuple from attribute names and 'AtomExpr's.
552newtype TupleExprBase a = TupleExpr (M.Map AttributeName (AtomExprBase a))
475newtype TupleExprBase a = TupleExpr (M.Map AttributeName (AtomExprBase a))
553− deriving (Eq, Show, Read, Generic, NFData, Foldable, Functor, Traversable)
476+ deriving (Eq, Show, Generic, NFData)
554−
477+
555−instance Hashable TupleExpr
478+instance Binary TupleExpr
556−
479+
557−type TupleExpr = TupleExprBase ()
480+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 ()
569
481
570data MergeStrategy =
482data MergeStrategy =
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)
483 -- | 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)
@@ -574,7 +486,7 @@ data MergeStrategy =
574 UnionPreferMergeStrategy HeadName |
486 UnionPreferMergeStrategy HeadName |
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.
487 -- | 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.
576 SelectedBranchMergeStrategy HeadName
488 SelectedBranchMergeStrategy HeadName
577− deriving (Eq, Show, Generic, NFData)
489+ deriving (Eq, Show, Binary, Generic, NFData)
578
490
579type DatabaseContextFunctionName = StringType
491type DatabaseContextFunctionName = StringType
580
492
@@ -600,47 +512,3 @@ instance Hashable DatabaseContextFunction where
600
512
601instance Eq DatabaseContextFunction where
513instance Eq DatabaseContextFunction where
602 f1 == f2 = dbcFuncName f1 == dbcFuncName f2
514 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+365−433
@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveGeneric, ScopedTypeVariables, MonoLocalBinds, DerivingVia #-}
1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, ScopedTypeVariables, BangPatterns #-}
2{-|
2{-|
3Module: ProjectM36.Client
3Module: ProjectM36.Client
4
4
@@ -9,7 +9,6 @@ module ProjectM36.Client
9 Connection(..),
9 Connection(..),
10 Port,
10 Port,
11 Hostname,
11 Hostname,
12− ServiceName,
13 DatabaseName,
12 DatabaseName,
14 ConnectionError(..),
13 ConnectionError(..),
15 connectProjectM36,
14 connectProjectM36,
@@ -17,8 +16,7 @@ module ProjectM36.Client
17 closeRemote_,
16 closeRemote_,
18 executeRelationalExpr,
17 executeRelationalExpr,
19 executeDatabaseContextExpr,
18 executeDatabaseContextExpr,
20− executeDatabaseContextIOExpr,
19+ executeDatabaseContextIOExpr,
21− executeDataFrameExpr,
22 executeGraphExpr,
20 executeGraphExpr,
23 executeSchemaExpr,
21 executeSchemaExpr,
24 executeTransGraphRelationalExpr,
22 executeTransGraphRelationalExpr,
@@ -26,8 +24,6 @@ module ProjectM36.Client
26 rollback,
24 rollback,
27 typeForRelationalExpr,
25 typeForRelationalExpr,
28 inclusionDependencies,
26 inclusionDependencies,
29− ProjectM36.Client.typeConstructorMapping,
30− ProjectM36.Client.databaseContextFunctionsAsRelation,
31 planForDatabaseContextExpr,
27 planForDatabaseContextExpr,
32 currentSchemaName,
28 currentSchemaName,
33 SchemaName,
29 SchemaName,
@@ -35,7 +31,6 @@ module ProjectM36.Client
35 setCurrentSchemaName,
31 setCurrentSchemaName,
36 transactionGraphAsRelation,
32 transactionGraphAsRelation,
37 relationVariablesAsRelation,
33 relationVariablesAsRelation,
38− ProjectM36.Client.atomFunctionsAsRelation,
39 disconnectedTransactionIsDirty,
34 disconnectedTransactionIsDirty,
40 headName,
35 headName,
41 remoteDBLookupName,
36 remoteDBLookupName,
@@ -44,20 +39,19 @@ module ProjectM36.Client
44 defaultDatabaseName,
39 defaultDatabaseName,
45 defaultRemoteConnectionInfo,
40 defaultRemoteConnectionInfo,
46 defaultHeadName,
41 defaultHeadName,
47− addClientNode,
48 PersistenceStrategy(..),
42 PersistenceStrategy(..),
49 RelationalExpr,
43 RelationalExpr,
50 RelationalExprBase(..),
44 RelationalExprBase(..),
51− DatabaseContextExprBase(..),
52− DatabaseContextExpr,
45+ DatabaseContextExpr(..),
53− DatabaseContextIOExprBase(..),
54− DatabaseContextIOExpr,
46+ DatabaseContextIOExpr(..),
55 Attribute(..),
47 Attribute(..),
56 MergeStrategy(..),
48 MergeStrategy(..),
57 attributesFromList,
49 attributesFromList,
50+ createNodeId,
58 createSessionAtCommit,
51 createSessionAtCommit,
59 createSessionAtHead,
52 createSessionAtHead,
60 closeSession,
53 closeSession,
54+ addClientNode,
61 callTestTimeout_,
55 callTestTimeout_,
62 RelationCardinality(..),
56 RelationCardinality(..),
63 TransactionGraphOperator(..),
57 TransactionGraphOperator(..),
@@ -67,6 +61,7 @@ module ProjectM36.Client
67 TransGraphRelationalExpr,
61 TransGraphRelationalExpr,
68 TransactionIdLookup(..),
62 TransactionIdLookup(..),
69 TransactionIdHeadBacktrack(..),
63 TransactionIdHeadBacktrack(..),
64+ NodeId(..),
70 Atom(..),
65 Atom(..),
71 Session,
66 Session,
72 SessionId,
67 SessionId,
@@ -79,95 +74,83 @@ module ProjectM36.Client
79 databaseContextExprForUniqueKey,
74 databaseContextExprForUniqueKey,
80 databaseContextExprForForeignKey,
75 databaseContextExprForForeignKey,
81 createScriptedAtomFunction,
76 createScriptedAtomFunction,
82− ProjectM36.Client.validateMerkleHashes,
83 AttributeExprBase(..),
77 AttributeExprBase(..),
84− TypeConstructorBase(..),
78+ TypeConstructor(..),
85 TypeConstructorDef(..),
79 TypeConstructorDef(..),
86 DataConstructorDef(..),
80 DataConstructorDef(..),
87− AttributeNamesBase(..),
81+ AttributeNames(..),
88 RelVarName,
82 RelVarName,
89 IncDepName,
83 IncDepName,
90 InclusionDependency(..),
84 InclusionDependency(..),
91 AttributeName,
85 AttributeName,
92− DF.DataFrame,
93− DF.DataFrameExpr,
94− DF.AttributeOrderExpr,
95− DF.Order(..),
96− RelationalError(..),
97 RequestTimeoutException(..),
86 RequestTimeoutException(..),
98 RemoteProcessDiedException(..),
87 RemoteProcessDiedException(..),
99 AtomType(..),
88 AtomType(..),
100 Atomable(..),
89 Atomable(..),
101 TupleExprBase(..),
90 TupleExprBase(..),
102− TupleExprsBase(..),
103 AtomExprBase(..),
91 AtomExprBase(..),
104− RestrictionPredicateExprBase(..),
92+ RestrictionPredicateExprBase(..)
105− withTransaction
106 ) where
93 ) where
107import ProjectM36.Base hiding (inclusionDependencies) --defined in this module as well
94import ProjectM36.Base hiding (inclusionDependencies) --defined in this module as well
108import qualified ProjectM36.Base as B
95import qualified ProjectM36.Base as B
109−import ProjectM36.Serialise.Error ()
110import ProjectM36.Error
96import ProjectM36.Error
111import ProjectM36.Atomable
97import ProjectM36.Atomable
112−import ProjectM36.AtomFunction as AF
98+import ProjectM36.AtomFunction
113import ProjectM36.StaticOptimizer
99import ProjectM36.StaticOptimizer
114import ProjectM36.Key
100import ProjectM36.Key
115−import qualified ProjectM36.DataFrame as DF
116−import ProjectM36.DatabaseContextFunction as DCF
117import qualified ProjectM36.IsomorphicSchema as Schema
101import qualified ProjectM36.IsomorphicSchema as Schema
118import Control.Monad.State
102import Control.Monad.State
103+import Control.Monad.Trans.Reader
119import qualified ProjectM36.RelationalExpression as RE
104import qualified ProjectM36.RelationalExpression as RE
120import ProjectM36.DatabaseContext (basicDatabaseContext)
105import ProjectM36.DatabaseContext (basicDatabaseContext)
121import qualified ProjectM36.TransactionGraph as Graph
106import qualified ProjectM36.TransactionGraph as Graph
122−import ProjectM36.TransactionGraph as TG
107+import ProjectM36.TransactionGraph
123import qualified ProjectM36.Transaction as Trans
108import qualified ProjectM36.Transaction as Trans
124import ProjectM36.TransactionGraph.Persist
109import ProjectM36.TransactionGraph.Persist
125−import ProjectM36.Attribute
110+import ProjectM36.Attribute hiding (atomTypes)
126−import ProjectM36.TransGraphRelationalExpression as TGRE (TransGraphRelationalExpr)
111+import ProjectM36.TransGraphRelationalExpression (TransGraphRelationalExpr, evalTransGraphRelationalExpr)
127import ProjectM36.Persist (DiskSync(..))
112import ProjectM36.Persist (DiskSync(..))
128import ProjectM36.FileLock
113import ProjectM36.FileLock
129−import ProjectM36.NormalizeExpr
130import ProjectM36.Notifications
114import ProjectM36.Notifications
131import ProjectM36.Server.RemoteCallTypes
115import ProjectM36.Server.RemoteCallTypes
132import qualified ProjectM36.DisconnectedTransaction as Discon
116import qualified ProjectM36.DisconnectedTransaction as Discon
133import ProjectM36.Relation (typesAsRelation)
117import ProjectM36.Relation (typesAsRelation)
134import ProjectM36.ScriptSession (initScriptSession, ScriptSession)
118import ProjectM36.ScriptSession (initScriptSession, ScriptSession)
135import qualified ProjectM36.Relation as R
119import qualified ProjectM36.Relation as R
120+import qualified ProjectM36.DatabaseContext as DBC
136import Control.Exception.Base
121import Control.Exception.Base
137−import Control.Concurrent.STM
122+import GHC.Conc.Sync
138−import Control.Concurrent.Async
139
123
124+import Network.Transport (Transport(closeTransport))
125+import Network.Transport.TCP (createTransport, defaultTCPParameters, encodeEndPointAddress)
126+import Control.Distributed.Process.Node (newLocalNode, initRemoteTable, runProcess, LocalNode, forkProcess, closeLocalNode)
127+import Control.Distributed.Process.Extras.Internal.Types (whereisRemote)
128+import Control.Distributed.Process.ManagedProcess.Client (call, safeCall)
140import Data.Either (isRight)
129import Data.Either (isRight)
141import Data.UUID.V4 (nextRandom)
130import Data.UUID.V4 (nextRandom)
142import Data.Word
131import Data.Word
143−import Data.Hashable
132+import Control.Distributed.Process (ProcessId, Process, receiveWait, send, match, NodeId(..), reconnect)
144import Control.Exception (IOException, handle, AsyncException, throwIO, fromException, Exception)
133import Control.Exception (IOException, handle, AsyncException, throwIO, fromException, Exception)
145import Control.Concurrent.MVar
134import Control.Concurrent.MVar
146−import Codec.Winery hiding (Schema, schema)
147import qualified Data.Map as M
135import qualified Data.Map as M
148−#if MIN_VERSION_stm_containers(1,0,0)
136+import Control.Distributed.Process.Serializable (Serializable)
149−import qualified StmContainers.Map as StmMap
150−import qualified StmContainers.Set as StmSet
151−#else
152−import qualified STMContainers.Map as StmMap
137+import qualified STMContainers.Map as STMMap
153−import qualified STMContainers.Set as StmSet
138+import qualified STMContainers.Set as STMSet
154−#endif
155import qualified ProjectM36.Session as Sess
139import qualified ProjectM36.Session as Sess
156import ProjectM36.Session
140import ProjectM36.Session
157import ProjectM36.Sessions
141import ProjectM36.Sessions
142+import ListT
143+import Data.Binary (Binary)
158import GHC.Generics (Generic)
144import GHC.Generics (Generic)
159import Control.DeepSeq (force)
145import Control.DeepSeq (force)
160import System.IO
146import System.IO
161−import 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)
166
147
167type Hostname = String
148type Hostname = String
168
149
169type Port = Word16
150type Port = Word16
170
151
152+type DatabaseName = String
153+
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.
154-- | 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.
172type NotificationCallback = NotificationName -> EvaluatedNotification -> IO ()
155type NotificationCallback = NotificationName -> EvaluatedNotification -> IO ()
173
156
@@ -187,27 +170,28 @@ data RequestTimeoutException = RequestTimeoutException
187
170
188instance Exception RequestTimeoutException
171instance Exception RequestTimeoutException
189
172
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.
173+-- | 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.
191−data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy NotificationCallback [GhcPkgPath] |
174+data ConnectionInfo = InProcessConnectionInfo PersistenceStrategy NotificationCallback [GhcPkgPath]|
192− RemoteConnectionInfo DatabaseName Hostname ServiceName NotificationCallback
175+ RemoteProcessConnectionInfo DatabaseName NodeId NotificationCallback
193
176
194type EvaluatedNotifications = M.Map NotificationName EvaluatedNotification
177type EvaluatedNotifications = M.Map NotificationName EvaluatedNotification
195
178
196-- | Used for callbacks from the server when monitored changes have been made.
179-- | Used for callbacks from the server when monitored changes have been made.
197newtype NotificationMessage = NotificationMessage EvaluatedNotifications
180newtype NotificationMessage = NotificationMessage EvaluatedNotifications
198− deriving (Eq, Show, Generic)
181+ deriving (Binary, Eq, Show, Generic)
199− deriving Serialise via WineryVariant NotificationMessage
200
182
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.
183+-- | When a notification is fired, the 'reportExpr' is evaluated in the commit's context, so that is returned along with the original notification.
202data EvaluatedNotification = EvaluatedNotification {
184data EvaluatedNotification = EvaluatedNotification {
203 notification :: Notification,
185 notification :: Notification,
204− reportOldRelation :: Either RelationalError Relation,
205− reportNewRelation :: Either RelationalError Relation
186+ reportRelation :: Either RelationalError Relation
206 }
187 }
207− deriving (Eq, Show, Generic)
188+ deriving(Binary, Eq, Show, Generic)
208− deriving Serialise via WineryRecord EvaluatedNotification
209
189
210
190
191+-- | Create a 'NodeId' for use in connecting to a remote server using distributed-process.
192+createNodeId :: Hostname -> Port -> NodeId
193+createNodeId host port = NodeId $ encodeEndPointAddress host (show port) 1
194+
211-- | Use this for connecting to remote servers on the default port.
195-- | Use this for connecting to remote servers on the default port.
212defaultServerPort :: Port
196defaultServerPort :: Port
213defaultServerPort = 6543
197defaultServerPort = 6543
@@ -222,107 +206,128 @@ defaultHeadName = "master"
222
206
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.
207-- | 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.
224defaultRemoteConnectionInfo :: ConnectionInfo
208defaultRemoteConnectionInfo :: ConnectionInfo
225−defaultRemoteConnectionInfo =
226− RemoteConnectionInfo defaultDatabaseName defaultServerHostname (show defaultServerPort) emptyNotificationCallback
209+defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (createNodeId "127.0.0.1" defaultServerPort) emptyNotificationCallback
227
210
228−defaultServerHostname :: Hostname
211+-- | The 'Connection' represents either local or remote access to a database. All operations flow through the connection.
229−defaultServerHostname = "localhost"
212+type ClientNodes = STMSet.Set ProcessId
230
213
231−newtype RemoteConnectionConf = RemoteConnectionConf RPC.Connection
214+type TransactionGraphLockHandle = Handle
215+
216+-- internal structure specific to in-process connections
217+data InProcessConnectionConf = InProcessConnectionConf {
218+ ipPersistenceStrategy :: PersistenceStrategy,
219+ ipClientNodes :: ClientNodes,
220+ ipSessions :: Sessions,
221+ ipTransactionGraph :: TVar TransactionGraph,
222+ ipScriptSession :: Maybe ScriptSession,
223+ ipLocalNode :: LocalNode,
224+ ipTransport :: Transport, -- we hold onto this so that we can close it gracefully
225+ ipLocks :: Maybe (TransactionGraphLockHandle, MVar LockFileHash) -- nothing when NoPersistence
226+ }
227+
228+data RemoteProcessConnectionConf = RemoteProcessConnectionConf {
229+ rLocalNode :: LocalNode,
230+ rProcessId :: ProcessId, --remote processId
231+ rTransport :: Transport --the TCP socket transport
232+ }
232
233
233data Connection = InProcessConnection InProcessConnectionConf |
234data Connection = InProcessConnection InProcessConnectionConf |
234− RemoteConnection RemoteConnectionConf
235+ RemoteProcessConnection RemoteProcessConnectionConf
235
236
236-- | There are several reasons why a connection can fail.
237-- | There are several reasons why a connection can fail.
237data ConnectionError = SetupDatabaseDirectoryError PersistenceError |
238data ConnectionError = SetupDatabaseDirectoryError PersistenceError |
238 IOExceptionError IOException |
239 IOExceptionError IOException |
239 NoSuchDatabaseByNameError DatabaseName |
240 NoSuchDatabaseByNameError DatabaseName |
240− DatabaseValidationError [MerkleValidationError] |
241 LoginError
241 LoginError
242 deriving (Show, Eq, Generic)
242 deriving (Show, Eq, Generic)
243
243
244remoteDBLookupName :: DatabaseName -> String
244remoteDBLookupName :: DatabaseName -> String
245remoteDBLookupName = (++) "db-"
245remoteDBLookupName = (++) "db-"
246
246
247+createLocalNode :: IO (LocalNode, Transport)
248+createLocalNode = do
249+ eLocalTransport <- createTransport "127.0.0.1" "0" defaultTCPParameters
250+ case eLocalTransport of
251+ Left err -> error ("failed to create transport: " ++ show err)
252+ Right localTransport -> do
253+ localNode <- newLocalNode localTransport initRemoteTable
254+ pure (localNode, localTransport)
255+
256+notificationListener :: NotificationCallback -> Process ()
257+notificationListener callback = do
258+ --pid <- getSelfPid
259+ --liftIO $ putStrLn $ "LISTENER THREAD START " ++ show pid
260+ _ <- forever $
261+ receiveWait [
262+ match (\(NotificationMessage eNots) ->
263+ --say $ "NOTIFICATION: " ++ show eNots
264+ -- 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
265+ liftIO $ mapM_ (uncurry callback) (M.toList eNots)
266+ )
267+ ]
268+ --say "LISTENER THREAD EXIT"
269+ pure ()
270+
271+startNotificationListener :: LocalNode -> NotificationCallback -> IO ProcessId
272+startNotificationListener localNode callback = forkProcess localNode (notificationListener callback)
273+
247createScriptSession :: [String] -> IO (Maybe ScriptSession)
274createScriptSession :: [String] -> IO (Maybe ScriptSession)
248createScriptSession ghcPkgPaths = do
275createScriptSession ghcPkgPaths = do
249 eScriptSession <- initScriptSession ghcPkgPaths
276 eScriptSession <- initScriptSession ghcPkgPaths
250 case eScriptSession of
277 case eScriptSession of
251− Left err -> hPutStrLn stderr ("Warning: Haskell scripting disabled: " ++ show err) >> pure Nothing --not a fatal error, but the scripting feature must be disabled
278+ 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
252 Right s -> pure (Just s)
279 Right s -> pure (Just s)
253
280
254−
255-- | To create a 'Connection' to a remote or local database, create a 'ConnectionInfo' and call 'connectProjectM36'.
281-- | To create a 'Connection' to a remote or local database, create a 'ConnectionInfo' and call 'connectProjectM36'.
256connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)
282connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)
257--create a new in-memory database/transaction graph
283--create a new in-memory database/transaction graph
258connectProjectM36 (InProcessConnectionInfo strat notificationCallback ghcPkgPaths) = do
284connectProjectM36 (InProcessConnectionInfo strat notificationCallback ghcPkgPaths) = do
259 freshId <- nextRandom
285 freshId <- nextRandom
260− tstamp <- getCurrentTime
261 let bootstrapContext = basicDatabaseContext
286 let bootstrapContext = basicDatabaseContext
262− freshGraph = bootstrapTransactionGraph tstamp freshId bootstrapContext
287+ freshGraph = bootstrapTransactionGraph freshId bootstrapContext
263 case strat of
288 case strat of
264 --create date examples graph for now- probably should be empty context in the future
289 --create date examples graph for now- probably should be empty context in the future
265 NoPersistence -> do
290 NoPersistence -> do
266 graphTvar <- newTVarIO freshGraph
291 graphTvar <- newTVarIO freshGraph
267− clientNodes <- StmSet.newIO
292+ clientNodes <- STMSet.newIO
268− sessions <- StmMap.newIO
293+ sessions <- STMMap.newIO
294+ (localNode, transport) <- createLocalNode
295+ notificationPid <- startNotificationListener localNode notificationCallback
269 mScriptSession <- createScriptSession ghcPkgPaths
296 mScriptSession <- createScriptSession ghcPkgPaths
270− notifAsync <- startNotificationListener clientNodes notificationCallback
297+
271 let conn = InProcessConnection InProcessConnectionConf {
298 let conn = InProcessConnection InProcessConnectionConf {
272 ipPersistenceStrategy = strat,
299 ipPersistenceStrategy = strat,
273 ipClientNodes = clientNodes,
300 ipClientNodes = clientNodes,
274 ipSessions = sessions,
301 ipSessions = sessions,
275 ipTransactionGraph = graphTvar,
302 ipTransactionGraph = graphTvar,
276 ipScriptSession = mScriptSession,
303 ipScriptSession = mScriptSession,
304+ ipLocalNode = localNode,
305+ ipTransport = transport,
277− ipLocks = Nothing,
306+ ipLocks = Nothing}
278− ipCallbackAsync = notifAsync
307+ addClientNode conn notificationPid
279− }
280 pure (Right conn)
308 pure (Right conn)
281 MinimalPersistence dbdir -> connectPersistentProjectM36 strat NoDiskSync dbdir freshGraph notificationCallback ghcPkgPaths
309 MinimalPersistence dbdir -> connectPersistentProjectM36 strat NoDiskSync dbdir freshGraph notificationCallback ghcPkgPaths
282 CrashSafePersistence dbdir -> connectPersistentProjectM36 strat FsyncDiskSync dbdir freshGraph notificationCallback ghcPkgPaths
310 CrashSafePersistence dbdir -> connectPersistentProjectM36 strat FsyncDiskSync dbdir freshGraph notificationCallback ghcPkgPaths
283
311
284−connectProjectM36 (RemoteConnectionInfo dbName hostName servicePort notificationCallback) = do
312+connectProjectM36 (RemoteProcessConnectionInfo databaseName serverNodeId notificationCallback) = do
285− --TODO- add notification callback thread
313+ connStatus <- newEmptyMVar
286− let resolutionHints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV],
314+ (localNode, transport) <- createLocalNode
287− addrSocketType = Stream
315+ let dbName = remoteDBLookupName databaseName
288− }
316+ --putStrLn $ "Connecting to " ++ show serverNodeId ++ " " ++ dbName
289− resolved <- getAddrInfo (Just resolutionHints) (Just hostName) (Just servicePort)
317+ notificationListenerPid <- startNotificationListener localNode notificationCallback
290− case resolved of
318+ runProcess localNode $ do
291− [] -> error ("DNS resolution failed for" <> hostName <> ":" <> servicePort)
319+ --even a failed connection retains an open socket!
292− addrInfo:_ -> do
320+ mServerProcessId <- whereisRemote serverNodeId dbName
293− --supports IPv4 only for now
321+ case mServerProcessId of
294− let (SockAddrInet port addr) = addrAddress addrInfo
322+ Nothing -> liftIO $ putMVar connStatus $ Left (NoSuchDatabaseByNameError databaseName)
295− notificationHandlers =
323+ Just serverProcessId -> do
296− [RPC.ClientAsyncRequestHandler $
324+ loginConfirmation <- safeLogin (Login notificationListenerPid) serverProcessId
297− \(NotificationMessage notifications') ->
325+ if not loginConfirmation then
298− forM_ (M.toList notifications') (uncurry notificationCallback)
326+ liftIO $ putMVar connStatus (Left LoginError)
299− ]
327+ else
300− let connectExcHandler (e :: IOException) = pure $ Left (IOExceptionError e)
328+ liftIO $ putMVar connStatus (Right $ RemoteProcessConnection RemoteProcessConnectionConf {rLocalNode = localNode, rProcessId = serverProcessId, rTransport = transport})
301− eConn <- (Right <$> RPC.connect notificationHandlers (hostAddressToTuple addr) port) `catch` connectExcHandler
329+ status <- takeMVar connStatus
302− case eConn of
330+ pure status
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
326
331
327connectPersistentProjectM36 :: PersistenceStrategy ->
332connectPersistentProjectM36 :: PersistenceStrategy ->
328 DiskSync ->
333 DiskSync ->
@@ -341,57 +346,49 @@ connectPersistentProjectM36 strat sync dbdir freshGraph notificationCallback ghc
341 case graph of
346 case graph of
342 Left err' -> return $ Left (SetupDatabaseDirectoryError err')
347 Left err' -> return $ Left (SetupDatabaseDirectoryError err')
343 Right graph' -> do
348 Right graph' -> do
344− case TG.validateMerkleHashes graph' of
345− Left merkleErrs -> pure (Left (DatabaseValidationError merkleErrs))
346− Right _ -> do
347− tvarGraph <- newTVarIO graph'
349+ tvarGraph <- newTVarIO graph'
348− sessions <- StmMap.newIO
350+ sessions <- STMMap.newIO
349− clientNodes <- StmSet.newIO
351+ clientNodes <- STMSet.newIO
352+ (localNode, transport) <- createLocalNode
350− lockMVar <- newMVar digest
353+ lockMVar <- newMVar digest
351− notifAsync <- startNotificationListener clientNodes notificationCallback
352− let conn = InProcessConnection InProcessConnectionConf {
354+ let conn = InProcessConnection InProcessConnectionConf {
353 ipPersistenceStrategy = strat,
355 ipPersistenceStrategy = strat,
354 ipClientNodes = clientNodes,
356 ipClientNodes = clientNodes,
355 ipSessions = sessions,
357 ipSessions = sessions,
356 ipTransactionGraph = tvarGraph,
358 ipTransactionGraph = tvarGraph,
357 ipScriptSession = mScriptSession,
359 ipScriptSession = mScriptSession,
360+ ipLocalNode = localNode,
361+ ipTransport = transport,
358− ipLocks = Just (lockFileH, lockMVar),
362+ ipLocks = Just (lockFileH, lockMVar)
359− ipCallbackAsync = notifAsync
360 }
363 }
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
371
364
365+ notificationPid <- startNotificationListener localNode notificationCallback
366+ addClientNode conn notificationPid
367+ pure (Right conn)
368+
372-- | Create a new session at the transaction id and return the session's Id.
369-- | Create a new session at the transaction id and return the session's Id.
373createSessionAtCommit :: Connection -> TransactionId -> IO (Either RelationalError SessionId)
370createSessionAtCommit :: Connection -> TransactionId -> IO (Either RelationalError SessionId)
374createSessionAtCommit conn@(InProcessConnection _) commitId = do
371createSessionAtCommit conn@(InProcessConnection _) commitId = do
375 newSessionId <- nextRandom
372 newSessionId <- nextRandom
376 atomically $ createSessionAtCommit_ commitId newSessionId conn
373 atomically $ createSessionAtCommit_ commitId newSessionId conn
377−createSessionAtCommit conn@(RemoteConnection _) uuid = remoteCall conn (CreateSessionAtCommit uuid)
374+createSessionAtCommit conn@(RemoteProcessConnection _) uuid = remoteCall conn (CreateSessionAtCommit uuid)
378
375
379createSessionAtCommit_ :: TransactionId -> SessionId -> Connection -> STM (Either RelationalError SessionId)
376createSessionAtCommit_ :: TransactionId -> SessionId -> Connection -> STM (Either RelationalError SessionId)
380createSessionAtCommit_ commitId newSessionId (InProcessConnection conf) = do
377createSessionAtCommit_ commitId newSessionId (InProcessConnection conf) = do
381 let sessions = ipSessions conf
378 let sessions = ipSessions conf
382 graphTvar = ipTransactionGraph conf
379 graphTvar = ipTransactionGraph conf
383 graph <- readTVar graphTvar
380 graph <- readTVar graphTvar
384− case RE.transactionForId commitId graph of
381+ case transactionForId commitId graph of
385 Left err -> pure (Left err)
382 Left err -> pure (Left err)
386 Right transaction -> do
383 Right transaction -> do
387 let freshDiscon = DisconnectedTransaction commitId (Trans.schemas transaction) False
384 let freshDiscon = DisconnectedTransaction commitId (Trans.schemas transaction) False
388− keyDuplication <- StmMap.lookup newSessionId sessions
385+ keyDuplication <- STMMap.lookup newSessionId sessions
389 case keyDuplication of
386 case keyDuplication of
390 Just _ -> pure $ Left (SessionIdInUseError newSessionId)
387 Just _ -> pure $ Left (SessionIdInUseError newSessionId)
391 Nothing -> do
388 Nothing -> do
392− StmMap.insert (Session freshDiscon defaultSchemaName) newSessionId sessions
389+ STMMap.insert (Session freshDiscon defaultSchemaName) newSessionId sessions
393 pure $ Right newSessionId
390 pure $ Right newSessionId
394−createSessionAtCommit_ _ _ (RemoteConnection _) = error "createSessionAtCommit_ called on remote connection"
391+createSessionAtCommit_ _ _ (RemoteProcessConnection _) = error "createSessionAtCommit_ called on remote connection"
395
392
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.
393-- | 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.
397createSessionAtHead :: Connection -> HeadName -> IO (Either RelationalError SessionId)
394createSessionAtHead :: Connection -> HeadName -> IO (Either RelationalError SessionId)
@@ -403,38 +400,37 @@ createSessionAtHead conn@(InProcessConnection conf) headn = do
403 case transactionForHead headn graph of
400 case transactionForHead headn graph of
404 Nothing -> pure $ Left (NoSuchHeadNameError headn)
401 Nothing -> pure $ Left (NoSuchHeadNameError headn)
405 Just trans -> createSessionAtCommit_ (transactionId trans) newSessionId conn
402 Just trans -> createSessionAtCommit_ (transactionId trans) newSessionId conn
406−createSessionAtHead conn@(RemoteConnection _) headn = remoteCall conn (CreateSessionAtHead headn)
403+createSessionAtHead conn@(RemoteProcessConnection _) headn = remoteCall conn (CreateSessionAtHead headn)
404+
405+-- | Used internally for server connections to keep track of remote nodes for the purpose of sending notifications later.
406+addClientNode :: Connection -> ProcessId -> IO ()
407+addClientNode (RemoteProcessConnection _) _ = error "addClientNode called on remote connection"
408+addClientNode (InProcessConnection conf) newProcessId = atomically (STMSet.insert newProcessId (ipClientNodes conf))
407
409
408-- | Discards a session, eliminating any uncommitted changes present in the session.
410-- | Discards a session, eliminating any uncommitted changes present in the session.
409closeSession :: SessionId -> Connection -> IO ()
411closeSession :: SessionId -> Connection -> IO ()
410closeSession sessionId (InProcessConnection conf) =
412closeSession sessionId (InProcessConnection conf) =
411− atomically $ StmMap.delete sessionId (ipSessions conf)
413+ atomically $ STMMap.delete sessionId (ipSessions conf)
412−closeSession sessionId conn@(RemoteConnection _) = remoteCall conn (CloseSession sessionId)
414+closeSession sessionId conn@(RemoteProcessConnection _) = remoteCall conn (CloseSession sessionId)
413−
414-- | 'close' cleans up the database access connection and closes any relevant sockets.
415-- | 'close' cleans up the database access connection and closes any relevant sockets.
415close :: Connection -> IO ()
416close :: Connection -> IO ()
416close (InProcessConnection conf) = do
417close (InProcessConnection conf) = do
417− cancel (ipCallbackAsync conf)
418 atomically $ do
418 atomically $ do
419 let sessions = ipSessions conf
419 let sessions = ipSessions conf
420−#if MIN_VERSION_stm_containers(1,0,0)
421− StmMap.reset sessions
422−#else
423− StmMap.deleteAll sessions
420+ STMMap.deleteAll sessions
424−#endif
425 pure ()
421 pure ()
426− let mLocks = ipLocks conf
422+ closeLocalNode (ipLocalNode conf)
427− case mLocks of
423+ closeTransport (ipTransport conf)
428− Nothing -> pure ()
429− Just (lockFileH, _) -> closeLockFile lockFileH
430
424
431−close (RemoteConnection (RemoteConnectionConf conn)) =
425+close conn@(RemoteProcessConnection conf) = do
432− RPC.close conn
426+ _ <- remoteCall conn Logout :: IO Bool
427+ closeLocalNode (rLocalNode conf)
428+ closeTransport (rTransport conf)
433
429
434--used only by the server EntryPoints
430--used only by the server EntryPoints
435closeRemote_ :: Connection -> IO ()
431closeRemote_ :: Connection -> IO ()
436closeRemote_ (InProcessConnection _) = error "invalid call of closeRemote_ on InProcessConnection"
432closeRemote_ (InProcessConnection _) = error "invalid call of closeRemote_ on InProcessConnection"
437−closeRemote_ (RemoteConnection (RemoteConnectionConf conn)) = RPC.close conn
433+closeRemote_ (RemoteProcessConnection conf) = runProcess (rLocalNode conf) (reconnect (rProcessId conf))
438
434
439 --we need to actually close the localNode's connection to the remote
435 --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
436--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,19 +441,40 @@ excEither = handle handler
445 where
441 where
446 handler exc | Just (_ :: AsyncException) <- fromException exc = throwIO exc
442 handler exc | Just (_ :: AsyncException) <- fromException exc = throwIO exc
447 | otherwise = pure (Left (UnhandledExceptionError (show exc)))
443 | otherwise = pure (Left (UnhandledExceptionError (show exc)))
444+
445+runProcessResult :: LocalNode -> Process a -> IO a
446+runProcessResult localNode proc = do
447+ ret <- newEmptyMVar
448+ runProcess localNode $ do
449+ val <- proc
450+ liftIO $ putMVar ret val
451+ takeMVar ret
452+
453+safeLogin :: Login -> ProcessId -> Process Bool
454+safeLogin login procId = do
455+ ret <- call procId login
456+ case ret of
457+ Left (_ :: ServerError) -> pure False
458+ Right val -> pure val
448
459
449−
450−remoteCall :: (Serialise a, Serialise b) => Connection -> a -> IO b
460+remoteCall :: (Serializable a, Serializable b) => Connection -> a -> IO b
451remoteCall (InProcessConnection _ ) _ = error "remoteCall called on local connection"
461remoteCall (InProcessConnection _ ) _ = error "remoteCall called on local connection"
452−remoteCall (RemoteConnection (RemoteConnectionConf rpcConn)) arg = do
462+remoteCall (RemoteProcessConnection conf) arg = runProcessResult localNode $ do
453− eRet <- RPC.call rpcConn arg
463+ ret <- safeCall serverProcessId arg
454− case eRet of
464+ case ret of
455− Left err -> convertRPCErrors err
465+ Left err -> error ("server died: " ++ show err)
466+ Right ret' -> case ret' of
467+ Left RequestTimeoutError -> liftIO (throwIO RequestTimeoutException)
468+ Left (ProcessDiedError _) -> liftIO (throwIO RemoteProcessDiedException)
456− Right val -> pure val
469+ Right val -> pure val
470+ where
471+ localNode = rLocalNode conf
472+ serverProcessId = rProcessId conf
457
473
458sessionForSessionId :: SessionId -> Sessions -> STM (Either RelationalError Session)
474sessionForSessionId :: SessionId -> Sessions -> STM (Either RelationalError Session)
459−sessionForSessionId sessionId sessions =
475+sessionForSessionId sessionId sessions = do
476+ maybeSession <- STMMap.lookup sessionId sessions
460− maybe (Left $ NoSuchSessionError sessionId) Right <$> StmMap.lookup sessionId sessions
477+ pure $ maybe (Left $ NoSuchSessionError sessionId) Right maybeSession
461
478
462schemaForSessionId :: Session -> STM (Either RelationalError Schema)
479schemaForSessionId :: Session -> STM (Either RelationalError Schema)
463schemaForSessionId session = do
480schemaForSessionId session = do
@@ -488,7 +505,7 @@ currentSchemaName sessionId (InProcessConnection conf) = atomically $ do
488 case eSession of
505 case eSession of
489 Left err -> pure (Left err)
506 Left err -> pure (Left err)
490 Right session -> pure (Right (Sess.schemaName session))
507 Right session -> pure (Right (Sess.schemaName session))
491−currentSchemaName sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveCurrentSchemaName sessionId)
508+currentSchemaName sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveCurrentSchemaName sessionId)
492
509
493-- | Switch to the named isomorphic schema.
510-- | Switch to the named isomorphic schema.
494setCurrentSchemaName :: SessionId -> Connection -> SchemaName -> IO (Either RelationalError ())
511setCurrentSchemaName :: SessionId -> Connection -> SchemaName -> IO (Either RelationalError ())
@@ -499,8 +516,8 @@ setCurrentSchemaName sessionId (InProcessConnection conf) sname = atomically $ d
499 Left err -> pure (Left err)
516 Left err -> pure (Left err)
500 Right session -> case Sess.setSchemaName sname session of
517 Right session -> case Sess.setSchemaName sname session of
501 Left err -> pure (Left err)
518 Left err -> pure (Left err)
502− Right newSession -> StmMap.insert newSession sessionId sessions >> pure (Right ())
519+ Right newSession -> STMMap.insert newSession sessionId sessions >> pure (Right ())
503−setCurrentSchemaName sessionId conn@(RemoteConnection _) sname = remoteCall conn (ExecuteSetCurrentSchema sessionId sname)
520+setCurrentSchemaName sessionId conn@(RemoteProcessConnection _) sname = remoteCall conn (ExecuteSetCurrentSchema sessionId sname)
504
521
505-- | Execute a relational expression in the context of the session and connection. Relational expressions are queries and therefore cannot alter the database.
522-- | Execute a relational expression in the context of the session and connection. Relational expressions are queries and therefore cannot alter the database.
506executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
523executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
@@ -516,15 +533,10 @@ executeRelationalExpr sessionId (InProcessConnection conf) expr = excEither $ at
516 Right expr
533 Right expr
517 case expr' of
534 case expr' of
518 Left err -> pure (Left err)
535 Left err -> pure (Left err)
519− Right expr'' -> do
520− let graphTvar = ipTransactionGraph conf
521− graph <- readTVar graphTvar
522− let reEnv = RE.mkRelationalExprEnv (Sess.concreteDatabaseContext session) graph
536+ Right expr'' -> case runReader (RE.evalRelationalExpr expr'') (RE.mkRelationalExprState (Sess.concreteDatabaseContext session)) of
523− case optimizeAndEvalRelationalExpr reEnv expr'' of
537+ Left err -> pure (Left err)
524− Right rel -> pure (force (Right rel)) -- this is necessary so that any undefined/error exceptions are spit out here
538+ 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−
527−executeRelationalExpr sessionId conn@(RemoteConnection _) relExpr = remoteCall conn (ExecuteRelationalExpr sessionId relExpr)
539+executeRelationalExpr sessionId conn@(RemoteProcessConnection _) relExpr = remoteCall conn (ExecuteRelationalExpr sessionId relExpr)
528
540
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.
541-- | 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.
530executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ())
542executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError ())
@@ -540,54 +552,35 @@ executeDatabaseContextExpr sessionId (InProcessConnection conf) expr = excEither
540 Schema.processDatabaseContextExprInSchema schema expr
552 Schema.processDatabaseContextExprInSchema schema expr
541 case expr' of
553 case expr' of
542 Left err -> pure (Left err)
554 Left err -> pure (Left err)
543− Right expr'' -> do
555+ Right expr'' -> case runState (RE.evalDatabaseContextExpr expr'') (RE.freshDatabaseState (Sess.concreteDatabaseContext session)) of
544− graph <- readTVar (ipTransactionGraph conf)
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
549− Left err -> pure (Left err)
556+ (Just err,_) -> pure (Left err)
550− Right newState ->
551− if not (RE.dbc_dirty newState) then --nothing dirtied, nothing to do
557+ (Nothing, (_,_,False)) -> pure (Right ()) --optimization- if nothing was dirtied, nothing to do
552− pure (Right ())
558+ (Nothing, (!context',_,True)) -> do
553− else do
554− let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas True
559+ let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas True
555− context' = RE.dbc_context newState
556− newSubschemas = Schema.processDatabaseContextExprSchemasUpdate (Sess.subschemas session) expr
560+ newSubschemas = Schema.processDatabaseContextExprSchemasUpdate (Sess.subschemas session) expr
557− newSchemas = Schemas context' newSubschemas
561+ newSchemas = Schemas context' newSubschemas
558− newSession = Session newDiscon (Sess.schemaName session)
562+ newSession = Session newDiscon (Sess.schemaName session)
559− StmMap.insert newSession sessionId sessions
563+ STMMap.insert newSession sessionId sessions
560− pure (Right ())
564+ pure (Right ())
561−executeDatabaseContextExpr sessionId conn@(RemoteConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)
565+executeDatabaseContextExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)
562−
566+
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.
567+-- | 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).
564autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())
568autoMergeToHead :: SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())
565autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do
569autoMergeToHead sessionId (InProcessConnection conf) strat headName' = do
566 let sessions = ipSessions conf
570 let sessions = ipSessions conf
567 id1 <- nextRandom
571 id1 <- nextRandom
568 id2 <- nextRandom
572 id2 <- nextRandom
569 id3 <- nextRandom
573 id3 <- nextRandom
570− tstamp <- getCurrentTime
571 commitLock_ sessionId conf $ \graph -> do
574 commitLock_ sessionId conf $ \graph -> do
572 eSession <- sessionForSessionId sessionId sessions
575 eSession <- sessionForSessionId sessionId sessions
573 case eSession of
576 case eSession of
574 Left err -> pure (Left err)
577 Left err -> pure (Left err)
575− Right session ->
578+ 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− ret <- Graph.autoMergeToHead tstamp (id1, id2, id3) (Sess.disconnectedTransaction session) headName' strat graph
579+ case Graph.autoMergeToHead (id1, id2, id3) (Sess.disconnectedTransaction session) headName' strat graph of
585− pure (ret, [id1,id2,id3])
586− case graphInfo of
587− Left err -> pure (Left err)
580+ Left err -> pure (Left err)
588− Right ((discon', graph'), transactionIdsAdded) ->
581+ Right (discon', graph') ->
589− pure (Right (discon', graph', transactionIdsAdded))
582+ pure (Right (discon', graph', [id1, id2, id3]))
590−autoMergeToHead sessionId conn@(RemoteConnection _) strat headName' = remoteCall conn (ExecuteAutoMergeToHead sessionId strat headName')
583+autoMergeToHead sessionId conn@(RemoteProcessConnection _) strat headName' = remoteCall conn (ExecuteAutoMergeToHead sessionId strat headName')
591
584
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.
585-- | Execute a database context IO-monad-based expression for the given session and connection. `DatabaseContextIOExpr`s modify the DatabaseContext but cannot be purely implemented.
593--this is almost completely identical to executeDatabaseContextExpr above
586--this is almost completely identical to executeDatabaseContextExpr above
@@ -599,38 +592,39 @@ executeDatabaseContextIOExpr sessionId (InProcessConnection conf) expr = excEith
599 case eSession of
592 case eSession of
600 Left err -> pure (Left err)
593 Left err -> pure (Left err)
601 Right session -> do
594 Right session -> do
602− graph <- readTVarIO (ipTransactionGraph conf)
603− let env = RE.DatabaseContextIOEvalEnv transId graph scriptSession
604− transId = Sess.parentId session
605− context = Sess.concreteDatabaseContext session
595+ res <- RE.evalDatabaseContextIOExpr scriptSession (Sess.concreteDatabaseContext session) expr
606− res <- RE.runDatabaseContextIOEvalMonad env context (optimizeAndEvalDatabaseContextIOExpr expr)
607 case res of
596 case res of
608 Left err -> pure (Left err)
597 Left err -> pure (Left err)
609− Right newState -> do
598+ Right context' -> do
610− let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas False
599+ let newDiscon = DisconnectedTransaction (Sess.parentId session) newSchemas True
611 newSchemas = Schemas context' (Sess.subschemas session)
600 newSchemas = Schemas context' (Sess.subschemas session)
612 newSession = Session newDiscon (Sess.schemaName session)
601 newSession = Session newDiscon (Sess.schemaName session)
613− context' = RE.dbc_context newState
614− atomically $ StmMap.insert newSession sessionId sessions
602+ atomically $ STMMap.insert newSession sessionId sessions
615 pure (Right ())
603 pure (Right ())
616−executeDatabaseContextIOExpr sessionId conn@(RemoteConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextIOExpr sessionId dbExpr)
604+executeDatabaseContextIOExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (ExecuteDatabaseContextIOExpr sessionId dbExpr)
617
605
606+{-
607+executeGraphExprSTM_ :: TransactionId -> SessionId -> Session -> Sessions -> TransactionGraphOperator -> TransactionGraph -> TVar TransactionGraph -> STM (Either RelationalError (TransactionGraph, DisconnectedTransaction)
608+executeGraphExprSTM_ freshId sessionId session sessions graphExpr graph graphTVar= do
609+ case evalGraphOp freshId (Sess.disconnectedTransaction session) graph graphExpr of
610+ Left err -> do
611+ when updateGraphOnError (writeTVar graphTVar graph)
612+ pure $ Left err
613+ Right (discon', graph') -> do
614+ writeTVar graphTVar graph'
615+ let newSession = Session discon' (Sess.schemaName session)
616+ STMMap.insert newSession sessionId sessions
617+ pure $ Right graph'
618+-}
619+
618-- process notifications for commits
620-- process notifications for commits
619−executeCommitExprSTM_
620− :: TransactionGraph
621− -> DatabaseContext
622− -> DatabaseContext
623− -> ClientNodes
624− -> STM (EvaluatedNotifications, ClientNodes)
621+executeCommitExprSTM_ :: DatabaseContext -> DatabaseContext -> ClientNodes -> STM (EvaluatedNotifications, ClientNodes)
625−executeCommitExprSTM_ graph oldContext newContext nodes = do
622+executeCommitExprSTM_ oldContext newContext nodes = do
626 let nots = notifications oldContext
623 let nots = notifications oldContext
627− fireNots = notificationChanges nots graph oldContext newContext
624+ fireNots = notificationChanges nots oldContext newContext
628 evaldNots = M.map mkEvaldNot fireNots
625 evaldNots = M.map mkEvaldNot fireNots
629− evalInContext expr ctx = optimizeAndEvalRelationalExpr (RE.mkRelationalExprEnv ctx graph) expr
630−
631 mkEvaldNot notif = EvaluatedNotification { notification = notif,
626 mkEvaldNot notif = EvaluatedNotification { notification = notif,
632− reportOldRelation = evalInContext (reportOldExpr notif) oldContext,
627+ reportRelation = runReader (RE.evalRelationalExpr (reportExpr notif)) (RE.mkRelationalExprState oldContext) }
633− reportNewRelation = evalInContext (reportNewExpr notif) newContext}
634 pure (evaldNots, nodes)
628 pure (evaldNots, nodes)
635
629
636-- | Execute a transaction graph expression in the context of the session and connection. Transaction graph operators modify the transaction graph state.
630-- | Execute a transaction graph expression in the context of the session and connection. Transaction graph operators modify the transaction graph state.
@@ -642,29 +636,102 @@ executeGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> IO (E
642executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do
636executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do
643 let sessions = ipSessions conf
637 let sessions = ipSessions conf
644 freshId <- nextRandom
638 freshId <- nextRandom
645− tstamp <- getCurrentTime
646 commitLock_ sessionId conf $ \updatedGraph -> do
639 commitLock_ sessionId conf $ \updatedGraph -> do
647 eSession <- sessionForSessionId sessionId sessions
640 eSession <- sessionForSessionId sessionId sessions
648 case eSession of
641 case eSession of
649 Left err -> pure (Left err)
642 Left err -> pure (Left err)
650 Right session -> do
643 Right session -> do
651 let discon = Sess.disconnectedTransaction session
644 let discon = Sess.disconnectedTransaction session
652− case evalGraphOp tstamp freshId discon updatedGraph graphExpr of
645+ case evalGraphOp freshId discon updatedGraph graphExpr of
653 Left err -> pure (Left err)
646 Left err -> pure (Left err)
654 Right (discon', graph') -> do
647 Right (discon', graph') -> do
655 --if freshId appears in the graph, then we need to pass it on
648 --if freshId appears in the graph, then we need to pass it on
656− let transIds = [freshId | isRight (RE.transactionForId freshId graph')]
649+ let transIds = [freshId | isRight (transactionForId freshId graph')]
657 pure (Right (discon', graph', transIds))
650 pure (Right (discon', graph', transIds))
658−
651+{-
652+executeGraphExpr sessionId (InProcessConnection conf) graphExpr = excEither $ do
653+ let strat = ipPersistenceStrategy conf
654+ clientNodes = ipClientNodes conf
655+ sessions = ipSessions conf
656+ graphTvar = ipTransactionGraph conf
657+ mLockFileH = ipLocks conf
658+ lockHandler body = case graphExpr of
659+ Commit -> case mLockFileH of
660+ Nothing -> body False
661+ Just (lockFileH, lockMVar) -> let acquireLocks = do
662+ lastWrittenDigest <- takeMVar lockMVar
663+ lockFile lockFileH WriteLock
664+ latestDigest <- readGraphTransactionIdDigest strat
665+ pure (latestDigest /= lastWrittenDigest)
666+
667+ releaseLocks _ = do
668+ --still holding the lock- get the latest digest
669+ gDigest <- readGraphTransactionIdDigest strat
670+ unlockFile lockFileH
671+ putMVar lockMVar gDigest
672+ in bracket acquireLocks releaseLocks body
673+ _ -> body False
674+ freshId <- nextRandom
675+ lockHandler $ \dbWrittenByOtherProcess -> do
676+ --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
677+ --read transaction data and compare to existing graph
678+ --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)
679+ manip <- atomically $ do
680+ eSession <- sessionForSessionId sessionId sessions
681+ --handle graph update by other process
682+ oldGraph <- readTVar graphTvar
683+ case eSession of
684+ Left err -> pure (Left err)
685+ Right session -> do
686+ let mScriptSession = ipScriptSession conf
687+ dbdir = case strat of
688+ MinimalPersistence x -> x
689+ CrashSafePersistence x -> x
690+ _ -> error "accessing dbdir on non-persisted connection"
691+ eRefreshedGraph <- if dbWrittenByOtherProcess then
692+ unsafeIOToSTM (transactionGraphLoad dbdir oldGraph mScriptSession)
693+ else
694+ pure (Right oldGraph)
695+ case eRefreshedGraph of
696+ Left err -> pure (Left (DatabaseLoadError err))
697+ Right refreshedGraph -> do
698+ --snip it
699+ eGraph <- executeGraphExprSTM_ dbWrittenByOtherProcess freshId sessionId session sessions graphExpr refreshedGraph graphTvar
700+ --snip it
701+ case eGraph of
702+ Left err -> pure (Left err)
703+ Right newGraph -> do
704+ --handle commit
705+ if isCommit graphExpr then do
706+ case transactionForId (Sess.parentId session) oldGraph of
707+ Left err -> pure $ Left err
708+ Right previousTrans -> do
709+ (evaldNots, nodes) <- executeCommitExprSTM_ (Trans.concreteDatabaseContext previousTrans) (Sess.concreteDatabaseContext session) clientNodes
710+ nodesToNotify <- toList (STMSet.stream nodes)
711+ pure $ Right (evaldNots, nodesToNotify, newGraph)
712+ else
713+ pure $ Right (M.empty, [], newGraph)
714+ case manip of
715+ Left err -> return $ Just err
716+ Right (notsToFire, nodesToNotify, newGraph) -> do
717+ --update filesystem database, if necessary
718+ processTransactionGraphPersistence strat newGraph
719+ sendNotifications nodesToNotify (ipLocalNode conf) notsToFire
720+ pure Nothing
721+-}
659−executeGraphExpr sessionId conn@(RemoteConnection _) graphExpr = remoteCall conn (ExecuteGraphExpr sessionId graphExpr)
722+executeGraphExpr sessionId conn@(RemoteProcessConnection _) graphExpr = remoteCall conn (ExecuteGraphExpr sessionId graphExpr)
660
723
661-- | A trans-graph expression is a relational query executed against the entirety of a transaction graph.
724-- | A trans-graph expression is a relational query executed against the entirety of a transaction graph.
662executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)
725executeTransGraphRelationalExpr :: SessionId -> Connection -> TransGraphRelationalExpr -> IO (Either RelationalError Relation)
663executeTransGraphRelationalExpr _ (InProcessConnection conf) tgraphExpr = excEither . atomically $ do
726executeTransGraphRelationalExpr _ (InProcessConnection conf) tgraphExpr = excEither . atomically $ do
664 let graphTvar = ipTransactionGraph conf
727 let graphTvar = ipTransactionGraph conf
665 graph <- readTVar graphTvar
728 graph <- readTVar graphTvar
666− pure $ force $ optimizeAndEvalTransGraphRelationalExpr graph tgraphExpr
729+ case evalTransGraphRelationalExpr tgraphExpr graph of
730+ Left err -> pure (Left err)
731+ Right relExpr -> case runReader (RE.evalRelationalExpr relExpr) (RE.mkRelationalExprState DBC.empty) of
732+ Left err -> pure (Left err)
733+ Right rel -> pure (force (Right rel))
667−executeTransGraphRelationalExpr sessionId conn@(RemoteConnection _) tgraphExpr = remoteCall conn (ExecuteTransGraphRelationalExpr sessionId tgraphExpr)
734+executeTransGraphRelationalExpr sessionId conn@(RemoteProcessConnection _) tgraphExpr = remoteCall conn (ExecuteTransGraphRelationalExpr sessionId tgraphExpr)
668
735
669-- | Schema expressions manipulate the isomorphic schemas for the current 'DatabaseContext'.
736-- | Schema expressions manipulate the isomorphic schemas for the current 'DatabaseContext'.
670executeSchemaExpr :: SessionId -> Connection -> Schema.SchemaExpr -> IO (Either RelationalError ())
737executeSchemaExpr :: SessionId -> Connection -> Schema.SchemaExpr -> IO (Either RelationalError ())
@@ -675,36 +742,32 @@ executeSchemaExpr sessionId (InProcessConnection conf) schemaExpr = atomically $
675 Left err -> pure (Left err)
742 Left err -> pure (Left err)
676 Right (session, _) -> do
743 Right (session, _) -> do
677 let subschemas' = subschemas session
744 let subschemas' = subschemas session
678− transId = Sess.parentId session
679− context = Sess.concreteDatabaseContext session
680− graph <- readTVar (ipTransactionGraph conf)
681− case Schema.evalSchemaExpr schemaExpr context transId graph subschemas' of
745+ case Schema.evalSchemaExpr schemaExpr (Sess.concreteDatabaseContext session) subschemas' of
682 Left err -> pure (Left err)
746 Left err -> pure (Left err)
683 Right (newSubschemas, newContext) -> do
747 Right (newSubschemas, newContext) -> do
684 --hm- maybe we should start using lenses
748 --hm- maybe we should start using lenses
685 let discon = Sess.disconnectedTransaction session
749 let discon = Sess.disconnectedTransaction session
686 newSchemas = Schemas newContext newSubschemas
750 newSchemas = Schemas newContext newSubschemas
687− newSession = Session (DisconnectedTransaction (Discon.parentId discon) newSchemas False) (Sess.schemaName session)
751+ newSession = Session (DisconnectedTransaction (Discon.parentId discon) newSchemas True) (Sess.schemaName session)
688− StmMap.insert newSession sessionId sessions
752+ STMMap.insert newSession sessionId sessions
689 pure (Right ())
753 pure (Right ())
690−executeSchemaExpr sessionId conn@(RemoteConnection _) schemaExpr = remoteCall conn (ExecuteSchemaExpr sessionId schemaExpr)
754+executeSchemaExpr sessionId conn@(RemoteProcessConnection _) schemaExpr = remoteCall conn (ExecuteSchemaExpr sessionId schemaExpr)
691
755
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.
756-- | 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.
693commit :: SessionId -> Connection -> IO (Either RelationalError ())
757commit :: SessionId -> Connection -> IO (Either RelationalError ())
694commit sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Commit
758commit sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Commit
695−commit sessionId conn@(RemoteConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Commit)
759+commit sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Commit)
696−
760+
697−sendNotifications :: [ClientInfo] -> EvaluatedNotifications -> IO ()
761+sendNotifications :: [ProcessId] -> LocalNode -> EvaluatedNotifications -> IO ()
698−sendNotifications clients notifs =
762+sendNotifications pids localNode nots = mapM_ sendNots pids
699− unless (M.null notifs) $ forM_ clients sender
763+ where
700− where
764+ sendNots remoteClientPid =
701− sender (RemoteClientInfo sock) = RPC.sendMessage sock (NotificationMessage notifs)
765+ unless (M.null nots) $ runProcess localNode $ send remoteClientPid (NotificationMessage nots)
702− sender (InProcessClientInfo tvar) = putMVar tvar notifs
766+
703−
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.
767-- | 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.
705rollback :: SessionId -> Connection -> IO (Either RelationalError ())
768rollback :: SessionId -> Connection -> IO (Either RelationalError ())
706rollback sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Rollback
769rollback sessionId conn@(InProcessConnection _) = executeGraphExpr sessionId conn Rollback
707−rollback sessionId conn@(RemoteConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Rollback)
770+rollback sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteGraphExpr sessionId Rollback)
708
771
709-- | Write the transaction graph to disk. This function can be used to incrementally write new transactions to disk.
772-- | Write the transaction graph to disk. This function can be used to incrementally write new transactions to disk.
710processTransactionGraphPersistence :: PersistenceStrategy -> [TransactionId] -> TransactionGraph -> IO ()
773processTransactionGraphPersistence :: PersistenceStrategy -> [TransactionId] -> TransactionGraph -> IO ()
@@ -720,7 +783,7 @@ readGraphTransactionIdDigest (CrashSafePersistence dbdir) = readGraphTransaction
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.
783-- | 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.
721typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
784typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
722typeForRelationalExpr sessionId conn@(InProcessConnection _) relExpr = atomically $ typeForRelationalExprSTM sessionId conn relExpr
785typeForRelationalExpr sessionId conn@(InProcessConnection _) relExpr = atomically $ typeForRelationalExprSTM sessionId conn relExpr
723−typeForRelationalExpr sessionId conn@(RemoteConnection _) relExpr = remoteCall conn (ExecuteTypeForRelationalExpr sessionId relExpr)
786+typeForRelationalExpr sessionId conn@(RemoteProcessConnection _) relExpr = remoteCall conn (ExecuteTypeForRelationalExpr sessionId relExpr)
724
787
725typeForRelationalExprSTM :: SessionId -> Connection -> RelationalExpr -> STM (Either RelationalError Relation)
788typeForRelationalExprSTM :: SessionId -> Connection -> RelationalExpr -> STM (Either RelationalError Relation)
726typeForRelationalExprSTM sessionId (InProcessConnection conf) relExpr = do
789typeForRelationalExprSTM sessionId (InProcessConnection conf) relExpr = do
@@ -735,10 +798,7 @@ typeForRelationalExprSTM sessionId (InProcessConnection conf) relExpr = do
735 Schema.processRelationalExprInSchema schema relExpr
798 Schema.processRelationalExprInSchema schema relExpr
736 case processed of
799 case processed of
737 Left err -> pure (Left err)
800 Left err -> pure (Left err)
738− Right relExpr' -> do
801+ Right relExpr' -> pure $ runReader (RE.typeForRelationalExpr relExpr') (RE.mkRelationalExprState (Sess.concreteDatabaseContext session))
739− graph <- readTVar (ipTransactionGraph conf)
740− let reEnv = RE.mkRelationalExprEnv (Sess.concreteDatabaseContext session) graph
741− pure $ RE.runRelationalExprM reEnv (RE.typeForRelationalExpr relExpr')
742
802
743typeForRelationalExprSTM _ _ _ = error "typeForRelationalExprSTM called on non-local connection"
803typeForRelationalExprSTM _ _ _ = error "typeForRelationalExprSTM called on non-local connection"
744
804
@@ -757,38 +817,22 @@ inclusionDependencies sessionId (InProcessConnection conf) = do
757 else
817 else
758 pure (Schema.inclusionDependenciesInSchema schema (B.inclusionDependencies context))
818 pure (Schema.inclusionDependenciesInSchema schema (B.inclusionDependencies context))
759
819
760−inclusionDependencies sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveInclusionDependencies sessionId)
820+inclusionDependencies sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveInclusionDependencies sessionId)
761
821
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−
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.
822-- | 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.
774−planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr)
823+planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError DatabaseContextExpr)
775planForDatabaseContextExpr sessionId (InProcessConnection conf) dbExpr = do
824planForDatabaseContextExpr sessionId (InProcessConnection conf) dbExpr = do
776 let sessions = ipSessions conf
825 let sessions = ipSessions conf
777 atomically $ do
826 atomically $ do
778− graph <- readTVar (ipTransactionGraph conf)
779 eSession <- sessionAndSchema sessionId sessions
827 eSession <- sessionAndSchema sessionId sessions
780 case eSession of
828 case eSession of
781 Left err -> pure $ Left err
829 Left err -> pure $ Left err
782− Right (session, _) ->
783− if schemaName session == defaultSchemaName then do
830+ Right (session, _) -> if schemaName session == defaultSchemaName then
784− let ctx = Sess.concreteDatabaseContext session
831+ pure $ evalState (applyStaticDatabaseOptimization dbExpr) (RE.freshDatabaseState (Sess.concreteDatabaseContext session))
785− transId = Sess.parentId session
786− gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextExpr dbExpr)
787− pure $ runGraphRefSOptDatabaseContextExprM transId ctx graph (optimizeGraphRefDatabaseContextExpr gfExpr)
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-}
832+ 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
789− pure (Left NonConcreteSchemaPlanError)
833+ pure (Right dbExpr)
790
834
791−planForDatabaseContextExpr sessionId conn@(RemoteConnection _) dbExpr = remoteCall conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr)
835+planForDatabaseContextExpr sessionId conn@(RemoteProcessConnection _) dbExpr = remoteCall conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr)
792
836
793-- | Return a relation which represents the current state of the global transaction graph. The attributes are
837-- | Return a relation which represents the current state of the global transaction graph. The attributes are
794-- * current- boolean attribute representing whether or not the current session references this transaction
838-- * current- boolean attribute representing whether or not the current session references this transaction
@@ -803,57 +847,30 @@ transactionGraphAsRelation sessionId (InProcessConnection conf) = do
803 eSession <- sessionForSessionId sessionId sessions
847 eSession <- sessionForSessionId sessionId sessions
804 case eSession of
848 case eSession of
805 Left err -> pure $ Left err
849 Left err -> pure $ Left err
806− Right session ->
850+ Right session -> do
851+ graph <- readTVar tvar
807− graphAsRelation (Sess.disconnectedTransaction session) <$> readTVar tvar
852+ pure $ graphAsRelation (Sess.disconnectedTransaction session) graph
808
853
809−transactionGraphAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveTransactionGraph sessionId)
854+transactionGraphAsRelation sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveTransactionGraph sessionId)
810
855
811-- | Returns the names and types of the relation variables in the current 'Session'.
856-- | Returns the names and types of the relation variables in the current 'Session'.
812relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
857relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
813relationVariablesAsRelation sessionId (InProcessConnection conf) = do
858relationVariablesAsRelation sessionId (InProcessConnection conf) = do
814 let sessions = ipSessions conf
859 let sessions = ipSessions conf
815 atomically $ do
860 atomically $ do
816− graph <- readTVar (ipTransactionGraph conf)
817 eSession <- sessionAndSchema sessionId sessions
861 eSession <- sessionAndSchema sessionId sessions
818 case eSession of
862 case eSession of
819 Left err -> pure (Left err)
863 Left err -> pure (Left err)
820 Right (session, schema) -> do
864 Right (session, schema) -> do
821 let context = Sess.concreteDatabaseContext session
865 let context = Sess.concreteDatabaseContext session
822 if Sess.schemaName session == defaultSchemaName then
866 if Sess.schemaName session == defaultSchemaName then
823− pure $ RE.relationVariablesAsRelation context graph
867+ pure $ R.relationVariablesAsRelation (relationVariables context)
824 else
868 else
825− case Schema.relationVariablesInSchema schema of
869+ case Schema.relationVariablesInSchema schema context of
826 Left err -> pure (Left err)
870 Left err -> pure (Left err)
827− Right relvars -> do
828− let schemaContext = context {relationVariables = relvars }
829− pure $ RE.relationVariablesAsRelation schemaContext graph
871+ Right relvars -> pure $ R.relationVariablesAsRelation relvars
830
872
831−relationVariablesAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveRelationVariableSummary sessionId)
873+relationVariablesAsRelation sessionId conn@(RemoteProcessConnection _) = 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)
857
874
858-- | Returns the transaction id for the connection's disconnected transaction committed parent transaction.
875-- | Returns the transaction id for the connection's disconnected transaction committed parent transaction.
859headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId)
876headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId)
@@ -864,7 +881,7 @@ headTransactionId sessionId (InProcessConnection conf) = do
864 case eSession of
881 case eSession of
865 Left err -> pure (Left err)
882 Left err -> pure (Left err)
866 Right session -> pure $ Right (Sess.parentId session)
883 Right session -> pure $ Right (Sess.parentId session)
867−headTransactionId sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveHeadTransactionId sessionId)
884+headTransactionId sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveHeadTransactionId sessionId)
868
885
869headNameSTM_ :: SessionId -> Sessions -> TVar TransactionGraph -> STM (Either RelationalError HeadName)
886headNameSTM_ :: SessionId -> Sessions -> TVar TransactionGraph -> STM (Either RelationalError HeadName)
870headNameSTM_ sessionId sessions graphTvar = do
887headNameSTM_ sessionId sessions graphTvar = do
@@ -872,7 +889,7 @@ headNameSTM_ sessionId sessions graphTvar = do
872 eSession <- sessionForSessionId sessionId sessions
889 eSession <- sessionForSessionId sessionId sessions
873 case eSession of
890 case eSession of
874 Left err -> pure (Left err)
891 Left err -> pure (Left err)
875− Right session -> case RE.transactionForId (Sess.parentId session) graph of
892+ Right session -> case transactionForId (Sess.parentId session) graph of
876 Left err -> pure (Left err)
893 Left err -> pure (Left err)
877 Right parentTrans -> case headNameForTransaction parentTrans graph of
894 Right parentTrans -> case headNameForTransaction parentTrans graph of
878 Nothing -> pure (Left UnknownHeadError)
895 Nothing -> pure (Left UnknownHeadError)
@@ -884,7 +901,7 @@ headName sessionId (InProcessConnection conf) = do
884 let sessions = ipSessions conf
901 let sessions = ipSessions conf
885 graphTvar = ipTransactionGraph conf
902 graphTvar = ipTransactionGraph conf
886 atomically (headNameSTM_ sessionId sessions graphTvar)
903 atomically (headNameSTM_ sessionId sessions graphTvar)
887−headName sessionId conn@(RemoteConnection _) = remoteCall conn (ExecuteHeadName sessionId)
904+headName sessionId conn@(RemoteProcessConnection _) = remoteCall conn (ExecuteHeadName sessionId)
888
905
889-- | Returns a listing of all available atom types.
906-- | Returns a listing of all available atom types.
890atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
907atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)
@@ -895,10 +912,10 @@ atomTypesAsRelation sessionId (InProcessConnection conf) = do
895 case eSession of
912 case eSession of
896 Left err -> pure (Left err)
913 Left err -> pure (Left err)
897 Right session ->
914 Right session ->
898− case typesAsRelation (B.typeConstructorMapping (Sess.concreteDatabaseContext session)) of
915+ case typesAsRelation (typeConstructorMapping (Sess.concreteDatabaseContext session)) of
899 Left err -> pure (Left err)
916 Left err -> pure (Left err)
900 Right rel -> pure (Right rel)
917 Right rel -> pure (Right rel)
901−atomTypesAsRelation sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveAtomTypesAsRelation sessionId)
918+atomTypesAsRelation sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveAtomTypesAsRelation sessionId)
902
919
903disconnectedTransactionIsDirty :: SessionId -> Connection -> IO (Either RelationalError Bool)
920disconnectedTransactionIsDirty :: SessionId -> Connection -> IO (Either RelationalError Bool)
904disconnectedTransactionIsDirty sessionId (InProcessConnection conf) = do
921disconnectedTransactionIsDirty sessionId (InProcessConnection conf) = do
@@ -909,23 +926,23 @@ disconnectedTransactionIsDirty sessionId (InProcessConnection conf) = do
909 Left err -> pure (Left err)
926 Left err -> pure (Left err)
910 Right session ->
927 Right session ->
911 pure (Right (isDirty session))
928 pure (Right (isDirty session))
912−disconnectedTransactionIsDirty sessionId conn@(RemoteConnection _) = remoteCall conn (RetrieveSessionIsDirty sessionId)
929+disconnectedTransactionIsDirty sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveSessionIsDirty sessionId)
913
930
914--used only for testing- we expect this to throw an exception
931--used only for testing- we expect this to throw an exception
915callTestTimeout_ :: SessionId -> Connection -> IO Bool
932callTestTimeout_ :: SessionId -> Connection -> IO Bool
916callTestTimeout_ _ (InProcessConnection _) = error "bad testing call"
933callTestTimeout_ _ (InProcessConnection _) = error "bad testing call"
917−callTestTimeout_ sessionId conn@(RemoteConnection _) = remoteCall conn (TestTimeout sessionId)
934+callTestTimeout_ sessionId conn@(RemoteProcessConnection _) = remoteCall conn (TestTimeout sessionId)
918
935
919--used in tests only
936--used in tests only
920transactionGraph_ :: Connection -> IO TransactionGraph
937transactionGraph_ :: Connection -> IO TransactionGraph
921−transactionGraph_ (InProcessConnection conf) = readTVarIO (ipTransactionGraph conf)
938+transactionGraph_ (InProcessConnection conf) = atomically $ readTVar (ipTransactionGraph conf)
922transactionGraph_ _ = error "remote connection used"
939transactionGraph_ _ = error "remote connection used"
923
940
924--used in tests only
941--used in tests only
925disconnectedTransaction_ :: SessionId -> Connection -> IO DisconnectedTransaction
942disconnectedTransaction_ :: SessionId -> Connection -> IO DisconnectedTransaction
926disconnectedTransaction_ sessionId (InProcessConnection conf) = do
943disconnectedTransaction_ sessionId (InProcessConnection conf) = do
927 let sessions = ipSessions conf
944 let sessions = ipSessions conf
928− mSession <- atomically $ StmMap.lookup sessionId sessions
945+ mSession <- atomically $ STMMap.lookup sessionId sessions
929 case mSession of
946 case mSession of
930 Nothing -> error "No such session"
947 Nothing -> error "No such session"
931 Just (Sess.Session discon _) -> pure discon
948 Just (Sess.Session discon _) -> pure discon
@@ -983,13 +1000,13 @@ commitLock_ sessionId conf stmBlock = do
983 Right (discon', graph', transactionIdsToPersist) -> do
1000 Right (discon', graph', transactionIdsToPersist) -> do
984 writeTVar graphTvar graph'
1001 writeTVar graphTvar graph'
985 let newSession = Session discon' (Sess.schemaName session)
1002 let newSession = Session discon' (Sess.schemaName session)
986− StmMap.insert newSession sessionId sessions
1003+ STMMap.insert newSession sessionId sessions
987− case RE.transactionForId (Sess.parentId session) oldGraph of
1004+ case transactionForId (Sess.parentId session) oldGraph of
988 Left err -> pure $ Left err
1005 Left err -> pure $ Left err
989 Right previousTrans ->
1006 Right previousTrans ->
990 if not (Prelude.null transactionIdsToPersist) then do
1007 if not (Prelude.null transactionIdsToPersist) then do
991− (evaldNots, nodes) <- executeCommitExprSTM_ graph' (Trans.concreteDatabaseContext previousTrans) (Sess.concreteDatabaseContext session) clientNodes
1008+ (evaldNots, nodes) <- executeCommitExprSTM_ (Trans.concreteDatabaseContext previousTrans) (Sess.concreteDatabaseContext session) clientNodes
992− nodesToNotify <- stmSetToList nodes
1009+ nodesToNotify <- toList (STMSet.stream nodes)
993 pure $ Right (evaldNots, nodesToNotify, graph', transactionIdsToPersist)
1010 pure $ Right (evaldNots, nodesToNotify, graph', transactionIdsToPersist)
994 else pure (Right (M.empty, [], graph', []))
1011 else pure (Right (M.empty, [], graph', []))
995
1012
@@ -999,97 +1016,12 @@ commitLock_ sessionId conf stmBlock = do
999 Right (notsToFire, nodesToNotify, newGraph, transactionIdsToPersist) -> do
1016 Right (notsToFire, nodesToNotify, newGraph, transactionIdsToPersist) -> do
1000 --update filesystem database, if necessary
1017 --update filesystem database, if necessary
1001 processTransactionGraphPersistence strat transactionIdsToPersist newGraph
1018 processTransactionGraphPersistence strat transactionIdsToPersist newGraph
1002− sendNotifications nodesToNotify notsToFire
1019+ sendNotifications nodesToNotify (ipLocalNode conf) notsToFire
1003 pure (Right ())
1020 pure (Right ())
1004−
1021+{-
1005−-- | Runs an IO monad, commits the result when the monad returns no errors, otherwise, rolls back the changes and the error.
1022+writeDisconAndGraph_ :: TVar TransactionGraph -> SessionId -> Session -> Sessions -> DisconnectedTransaction -> TransactionGraph -> STM ()
1006−withTransaction :: SessionId -> Connection -> IO (Either RelationalError a) -> IO (Either RelationalError ()) -> IO (Either RelationalError a)
1023+writeDisconAndGraph_ graphTvar sessionId session sessions discon graph = do
1007−withTransaction sessionId conn io successFunc = bracketOnError (pure ()) (const do_rollback) block
1024+ writeTVar graphTvar graph
1008− where
1025+ let newSession = Session discon (Sess.schemaName session)
1009− do_rollback = rollback sessionId conn
1026+ STMMap.insert newSession sessionId sessions
1010− block _ = do
1027+-}
1011− eErr <- io
1012− case eErr of
1013− Left err -> do
1014− _ <- do_rollback
1015− pure (Left err)
1016− Right val -> do
1017− eIsDirty <- disconnectedTransactionIsDirty sessionId conn
1018− case eIsDirty of
1019− Left err -> pure (Left err)
1020− Right dirty ->
1021− if dirty then do
1022− res <- successFunc
1023− case res of
1024− Left err -> pure (Left err)
1025− Right _ -> pure (Right val)
1026− else -- no updates executed, so don't create a commit
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.hsdeleted−129
@@ -1,129 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−-- | A simplified client interface for Project:M36 database access.
3−module ProjectM36.Client.Simple (
4− simpleConnectProjectM36,
5− simpleConnectProjectM36At,
6− withTransaction,
7− withTransactionUsing,
8− execute,
9− executeOrErr,
10− query,
11− queryOrErr,
12− cancelTransaction,
13− orCancelTransaction,
14− rollback,
15− close,
16− Atom(..),
17− AtomType(..),
18− Db,
19− DbConn,
20− DbError(..),
21− RelationalError(..),
22− Attribute(..),
23− C.Atomable(toAtom, fromAtom),
24− C.ConnectionInfo(..),
25− C.PersistenceStrategy(..),
26− C.NotificationCallback,
27− C.emptyNotificationCallback,
28− C.DatabaseContextExprBase(..),
29− C.DatabaseContextExpr,
30− C.RelationalExprBase(..)
31− ) where
32−
33−import Control.Exception.Base
34−import Control.Monad ((<=<))
35−import Control.Monad.Reader
36−import ProjectM36.Base
37−import qualified ProjectM36.Client as C
38−import ProjectM36.Error
39−
40−type DbConn = (C.SessionId, C.Connection)
41−
42−newtype Db a = Db {runDb :: ReaderT DbConn IO a}
43− deriving (Functor, Applicative, Monad, MonadIO)
44−
45−-- This exception type should never be observable by the API users.
46−-- It merely carries errors which end up as RelError at the end of a transaction.
47−newtype TransactionCancelled = TransactionCancelled DbError deriving Show
48−instance Exception TransactionCancelled
49−
50−-- | A simple alternative to 'connectProjectM36' which includes simple session management.
51−simpleConnectProjectM36At :: HeadName -> C.ConnectionInfo -> IO (Either DbError DbConn)
52−simpleConnectProjectM36At headName connInfo = do
53− eConn <- C.connectProjectM36 connInfo
54− case eConn of
55− Left err -> pure (Left (ConnError err))
56− Right conn -> do
57− eSess <- C.createSessionAtHead conn headName
58− case eSess of
59− Left err -> do
60− C.close conn
61− pure (Left (RelError err))
62− Right sess -> pure (Right (sess, conn))
63−
64−-- | Same as 'simpleConnectProjectM36At' but always connects to the @master@ branch.
65−simpleConnectProjectM36 :: C.ConnectionInfo -> IO (Either DbError DbConn)
66−simpleConnectProjectM36 = simpleConnectProjectM36At "master"
67−
68−-- | Closes the database connection.
69−close :: DbConn -> IO ()
70−close (_ , conn) = C.close conn
71−
72−-- | Runs a Db monad which may include some database updates. If an exception or error occurs, the transaction is rolled back. Otherwise, the transaction is committed to the head of the current branch.
73−withTransaction :: DbConn -> Db a -> IO (Either DbError a)
74−withTransaction sessconn = withTransactionUsing sessconn UnionMergeStrategy
75−
76−-- | Same as 'withTransaction' except that the merge strategy can be specified.
77−withTransactionUsing :: DbConn -> MergeStrategy -> Db a -> IO (Either DbError a)
78−withTransactionUsing (sess, conn) strat dbm = do
79− eHeadName <- C.headName sess conn
80− case eHeadName of
81− Left err -> pure (Left (RelError err))
82− Right headName -> do
83− let successFunc = C.autoMergeToHead sess conn strat headName
84− block = runReaderT (runDb dbm) (sess, conn)
85− handler :: TransactionCancelled -> IO (Either DbError a)
86− handler (TransactionCancelled err) = pure (Left err)
87− handle handler $ do
88− ret <- C.withTransaction sess conn (Right <$> block) successFunc
89− case ret of
90− Left err -> pure (Left (RelError err))
91− Right val -> pure (Right val)
92−
93−-- | A union of connection and other errors that can be returned from 'withTransaction'.
94−data DbError = ConnError C.ConnectionError |
95− RelError RelationalError |
96− TransactionRolledBack
97− deriving (Eq, Show)
98−
99−-- | Execute a 'DatabaseContextExpr' in the 'DB' monad. Database context expressions manipulate the state of the database. In case of an error, the transaction is terminated and the connection's session is rolled back.
100−execute :: C.DatabaseContextExpr -> Db ()
101−execute = orCancelTransaction <=< executeOrErr
102−
103−-- | Run a 'RelationalExpr' query in the 'DB' monad. Relational expressions perform read-only queries against the current database state.
104−query :: C.RelationalExpr -> Db Relation
105−query = orCancelTransaction <=< queryOrErr
106−
107−-- | Run a 'DatabaseContextExpr' update expression. If there is an error, just return it without cancelling the current transaction.
108−executeOrErr :: C.DatabaseContextExpr -> Db (Either RelationalError ())
109−executeOrErr expr = Db $ do
110− (sess, conn) <- ask
111− lift $ C.executeDatabaseContextExpr sess conn expr
112−
113−-- | Run a 'RelationalExpr' query expression. If there is an error, just return it without cancelling the transaction.
114−queryOrErr :: C.RelationalExpr -> Db (Either RelationalError Relation)
115−queryOrErr expr = Db $ do
116− (sess, conn) <- ask
117− lift $ C.executeRelationalExpr sess conn expr
118−
119−-- | Unconditionally roll back the current transaction and throw an exception to terminate the execution of the Db monad.
120−rollback :: Db ()
121−rollback = cancelTransaction TransactionRolledBack
122−
123−-- | Cancel a transaction and carry some error information with it.
124−cancelTransaction :: DbError -> Db a
125−cancelTransaction err = liftIO $ throwIO (TransactionCancelled err)
126−
127−-- | Converts the 'Either' result from a 'Db' action into an immediate cancel in the case of error.
128−orCancelTransaction :: Either RelationalError a -> Db a
129−orCancelTransaction = either (cancelTransaction . RelError) pure
src/lib/ProjectM36/DataConstructorDef.hs+4−4
@@ -1,5 +1,6 @@
1module ProjectM36.DataConstructorDef where
1module ProjectM36.DataConstructorDef where
2−import ProjectM36.Base as B
2+import ProjectM36.Base
3+import qualified ProjectM36.TypeConstructor as TC
3import qualified Data.Set as S
4import qualified Data.Set as S
4
5
5emptyDataConstructor :: DataConstructorName -> DataConstructorDef
6emptyDataConstructor :: DataConstructorName -> DataConstructorDef
@@ -15,6 +16,5 @@ typeVars :: DataConstructorDef -> S.Set TypeVarName
15typeVars (DataConstructorDef _ tConsArgs) = S.unions $ map typeVarsInDefArg tConsArgs
16typeVars (DataConstructorDef _ tConsArgs) = S.unions $ map typeVarsInDefArg tConsArgs
16
17
17typeVarsInDefArg :: DataConstructorDefArg -> S.Set TypeVarName
18typeVarsInDefArg :: DataConstructorDefArg -> S.Set TypeVarName
18−typeVarsInDefArg (DataConstructorDefTypeConstructorArg tCons) = B.typeVars tCons
19+typeVarsInDefArg (DataConstructorDefTypeConstructorArg tCons) = TC.typeVars tCons
19−typeVarsInDefArg (DataConstructorDefTypeVarNameArg pVarName) = S.singleton pVarName
20+typeVarsInDefArg (DataConstructorDefTypeVarNameArg pVarName) = S.singleton pVarName
20−
src/lib/ProjectM36/DataFrame.hsdeleted−183
@@ -1,183 +0,0 @@
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) = "&quot;" <> t <> "&quot;"
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+2−4
@@ -1,11 +1,10 @@
1-- wraps up primitives plus other basic data types
1-- wraps up primitives plus other basic data types
2module ProjectM36.DataTypes.Basic where
2module ProjectM36.DataTypes.Basic where
3import ProjectM36.DataTypes.Primitive
3import ProjectM36.DataTypes.Primitive
4+import ProjectM36.DataTypes.Day
4import ProjectM36.DataTypes.Either
5import ProjectM36.DataTypes.Either
5import ProjectM36.DataTypes.Maybe
6import ProjectM36.DataTypes.Maybe
6import ProjectM36.DataTypes.List
7import ProjectM36.DataTypes.List
7−import ProjectM36.DataTypes.NonEmptyList
8−import ProjectM36.DataTypes.Interval
9import ProjectM36.Base
8import ProjectM36.Base
10
9
11basicTypeConstructorMapping :: TypeConstructorMapping
10basicTypeConstructorMapping :: TypeConstructorMapping
@@ -13,7 +12,6 @@ basicTypeConstructorMapping = primitiveTypeConstructorMapping ++
13 maybeTypeConstructorMapping ++
12 maybeTypeConstructorMapping ++
14 eitherTypeConstructorMapping ++
13 eitherTypeConstructorMapping ++
15 listTypeConstructorMapping ++
14 listTypeConstructorMapping ++
16− nonEmptyListTypeConstructorMapping ++
15+ dayTypeConstructorMapping
17− intervalTypeConstructorMapping
18
16
19
17
src/lib/ProjectM36/DataTypes/ByteString.hsdeleted−18
@@ -1,18 +0,0 @@
1−module ProjectM36.DataTypes.ByteString where
2−import ProjectM36.Base
3−import ProjectM36.AtomFunctionError
4−import ProjectM36.AtomFunctionBody
5−import qualified Data.HashSet as HS
6−import qualified Data.ByteString.Base64 as B64
7−import qualified Data.Text.Encoding as TE
8−
9−bytestringAtomFunctions :: AtomFunctions
10−bytestringAtomFunctions = HS.fromList [
11− AtomFunction { atomFuncName = "bytestring",
12− atomFuncType = [TextAtomType, ByteStringAtomType],
13− atomFuncBody = compiledAtomFunctionBody $ \(TextAtom textIn:_) -> case B64.decode (TE.encodeUtf8 textIn) of
14− Left err -> Left (AtomFunctionBytesDecodingError err)
15− Right bs -> pure (ByteStringAtom bs)
16− }
17− ]
18−
src/lib/ProjectM36/DataTypes/DateTime.hs+2−2
@@ -7,8 +7,8 @@ import Data.Time.Clock.POSIX
7dateTimeAtomFunctions :: AtomFunctions
7dateTimeAtomFunctions :: AtomFunctions
8dateTimeAtomFunctions = HS.fromList [ AtomFunction {
8dateTimeAtomFunctions = HS.fromList [ AtomFunction {
9 atomFuncName = "dateTimeFromEpochSeconds",
9 atomFuncName = "dateTimeFromEpochSeconds",
10− atomFuncType = [IntegerAtomType, DateTimeAtomType],
10+ atomFuncType = [IntAtomType, DateTimeAtomType],
11− atomFuncBody = compiledAtomFunctionBody $ \(IntegerAtom epoch:_) -> pure (DateTimeAtom (posixSecondsToUTCTime (realToFrac epoch)))
11+ atomFuncBody = compiledAtomFunctionBody $ \(IntAtom epoch:_) -> pure (DateTimeAtom (posixSecondsToUTCTime (realToFrac epoch)))
12 }]
12 }]
13
13
14
14
src/lib/ProjectM36/DataTypes/Day.hs+5−2
@@ -7,11 +7,14 @@ import Data.Time.Calendar
7dayAtomFunctions :: AtomFunctions
7dayAtomFunctions :: AtomFunctions
8dayAtomFunctions = HS.fromList [
8dayAtomFunctions = HS.fromList [
9 AtomFunction { atomFuncName = "fromGregorian",
9 AtomFunction { atomFuncName = "fromGregorian",
10− atomFuncType = [IntegerAtomType, IntegerAtomType, IntegerAtomType, DayAtomType],
10+ atomFuncType = [IntAtomType, IntAtomType, IntAtomType, DayAtomType],
11− atomFuncBody = compiledAtomFunctionBody $ \(IntegerAtom year:IntegerAtom month:IntegerAtom day:_) -> pure $ DayAtom (fromGregorian (fromIntegral year) (fromIntegral month) (fromIntegral day))
11+ atomFuncBody = compiledAtomFunctionBody $ \(IntAtom year:IntAtom month:IntAtom day:_) -> pure $ DayAtom (fromGregorian (fromIntegral year) month day)
12 },
12 },
13 AtomFunction { atomFuncName = "dayEarlierThan",
13 AtomFunction { atomFuncName = "dayEarlierThan",
14 atomFuncType = [DayAtomType, DayAtomType, BoolAtomType],
14 atomFuncType = [DayAtomType, DayAtomType, BoolAtomType],
15 atomFuncBody = compiledAtomFunctionBody $ \(ConstructedAtom _ _ (IntAtom dayA:_):ConstructedAtom _ _ (IntAtom dayB:_):_) -> pure (BoolAtom (dayA < dayB))
15 atomFuncBody = compiledAtomFunctionBody $ \(ConstructedAtom _ _ (IntAtom dayA:_):ConstructedAtom _ _ (IntAtom dayB:_):_) -> pure (BoolAtom (dayA < dayB))
16 }
16 }
17 ]
17 ]
18+
19+dayTypeConstructorMapping :: TypeConstructorMapping
20+dayTypeConstructorMapping = [] -- use fromGregorian
src/lib/ProjectM36/DataTypes/Interval.hs+29−140
@@ -1,146 +1,35 @@
1{-# OPTIONS_GHC -fno-warn-orphans #-}
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2module ProjectM36.DataTypes.Interval where
2module ProjectM36.DataTypes.Interval where
3−import ProjectM36.AtomFunctionBody
3+import Data.Interval
4−import ProjectM36.Base
4+import ProjectM36.Base hiding (Finite)
5−import ProjectM36.AtomType
6−import ProjectM36.DataTypes.Primitive
7−import ProjectM36.AtomFunctionError
8−import qualified Data.HashSet as HS
9−import qualified Data.Map as M
10−import Control.Monad (when)
11−import Data.Maybe
5+import Data.Binary
6+import ProjectM36.Atom
7+import Data.Typeable
8+import Data.Time.Clock
12
9
13−type OpenInterval = Bool
10+instance (Atomable a, Ord a) => Atomable (Interval a)
14
11
15−intervalSubType :: AtomType -> AtomType
12+instance (Binary a) => Binary (Extended a) where
16−intervalSubType typ = if isIntervalAtomType typ then
13+ put ext = case ext of
17− case typ of
14+ NegInf -> put (1 :: Int)
18− ConstructedAtomType _ tvMap ->
15+ PosInf -> put (2 :: Int)
19− fromMaybe err (M.lookup "a" tvMap)
16+ Finite x -> put (3 :: Int) >> put x
20− _ -> err
17+ get = do
21− else
18+ flag <- get :: Get Int
22− err
19+ case flag of
23− where
20+ 1 -> pure NegInf
24− err = error "intervalSubType on non-interval type"
21+ 2 -> pure PosInf
25−
22+ 3 -> Finite <$> get
26−
23+ _ -> error "poop"
27−-- in lieu of typeclass support, we just hard-code the types which can be part of an interval
28−supportsInterval :: AtomType -> Bool
29−supportsInterval typ = case typ of
30− IntAtomType -> True
31− IntegerAtomType -> True
32− DoubleAtomType -> True
33− TextAtomType -> False -- just because it supports ordering, doesn't mean it makes sense in an interval
34− DayAtomType -> True
35− DateTimeAtomType -> True
36− ByteStringAtomType -> False
37− BoolAtomType -> False
38− RelationAtomType _ -> False
39− ConstructedAtomType _ _ -> False --once we support an interval-style typeclass, we might enable this
40− RelationalExprAtomType -> False
41− TypeVariableType _ -> False
42−
43−supportsOrdering :: AtomType -> Bool
44−supportsOrdering typ = case typ of
45− IntAtomType -> True
46− IntegerAtomType -> True
47− DoubleAtomType -> True
48− TextAtomType -> True
49− DayAtomType -> True
50− DateTimeAtomType -> True
51− ByteStringAtomType -> False
52− BoolAtomType -> False
53− RelationAtomType _ -> False
54− RelationalExprAtomType -> False
55− ConstructedAtomType _ _ -> False --once we support an interval-style typeclass, we might enable this
56− TypeVariableType _ -> False
57−
58−atomCompare :: Atom -> Atom -> Either AtomFunctionError Ordering
59−atomCompare a1 a2 = let aType = atomTypeForAtom a1
60− go a b = Right (compare a b)
61− typError = Left (AtomTypeDoesNotSupportOrderingError (prettyAtomType aType)) in
62− if atomTypeForAtom a1 /= atomTypeForAtom a2 then
63− Left AtomFunctionTypeMismatchError
64− else if not (supportsOrdering aType) then
65− typError
66− else
67− case (a1, a2) of
68− (IntegerAtom a, IntegerAtom b) -> go a b
69− (IntAtom a, IntAtom b) -> go a b
70− (DoubleAtom a, DoubleAtom b) -> go a b
71− (TextAtom a, TextAtom b) -> go a b
72− (DayAtom a, DayAtom b) -> go a b
73− (DateTimeAtom a, DateTimeAtom b) -> go a b
74− _ -> typError
75
24
76−--check that interval is properly ordered and that the boundaries make sense
25+instance (Ord a, Binary a) => Binary (Interval a) where
77−createInterval :: Atom -> Atom -> OpenInterval -> OpenInterval -> Either AtomFunctionError Atom
26+ put interv = put (lowerBound interv) >> put (upperBound interv)
78−createInterval atom1 atom2 bopen eopen = do
27+ get = interval <$> get <*> get
79− cmp <- atomCompare atom1 atom2
80− case cmp of
81− GT -> Left InvalidIntervalOrderingError
82− EQ -> if bopen || eopen then
83− Left InvalidIntervalBoundariesError
84− else
85− Right valid
86− LT -> Right valid
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)
92−
93−intervalAtomFunctions :: AtomFunctions
94−intervalAtomFunctions = HS.fromList [
95− AtomFunction { atomFuncName = "interval",
96− atomFuncType = [TypeVariableType "a",
97− TypeVariableType "a",
98− BoolAtomType,
99− BoolAtomType,
100− intervalAtomType (TypeVariableType "a")],
101− atomFuncBody = compiledAtomFunctionBody $ \(atom1:atom2:BoolAtom bopen:BoolAtom eopen:_) -> do
102− let aType = atomTypeForAtom atom1
103− if supportsInterval aType then
104− createInterval atom1 atom2 bopen eopen
105− else
106− Left (AtomTypeDoesNotSupportIntervalError (prettyAtomType aType))
107− },
108− AtomFunction {
109− atomFuncName = "interval_overlaps",
110− atomFuncType = [intervalAtomType (TypeVariableType "a"),
111− intervalAtomType (TypeVariableType "a"),
112− BoolAtomType],
113− atomFuncBody = compiledAtomFunctionBody $ \(i1@ConstructedAtom{}:i2@ConstructedAtom{}:_) ->
114− BoolAtom <$> intervalOverlaps i1 i2
115− }]
116−
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−
124−intervalOverlaps :: Atom -> Atom -> Either AtomFunctionError Bool
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)
134− cmp1 <- atomCompare i1start i2end
135− cmp2 <- atomCompare i2start i1end
136− let startcmp = if i1startopen || i2endopen then oplt else oplte
137− endcmp = if i2startopen || i1endopen then oplt else oplte
138− oplte op = op == LT || op == EQ
139− oplt op = op == LT
140− pure (startcmp cmp1 && endcmp cmp2)
141−intervalOverlaps _ _ = Left AtomFunctionTypeMismatchError
142
28
143−intervalTypeConstructorMapping :: TypeConstructorMapping
29+intervalFunctions :: [AtomFunction]
144−intervalTypeConstructorMapping = [(ADTypeConstructorDef "Interval" ["a"], [])]
30+intervalFunctions = [AtomFunction { atomFuncName = "interval_dt_member",
145−
31+ atomFuncType = [dateTimeAtomType,
146−
32+ atomTypeForProxy (Proxy :: Proxy (Interval UTCTime)),
33+ boolAtomType],
34+ atomFunc = \(dt:dtinterval:_) -> Atom $ member (unsafeCast dt ::UTCTime) (unsafeCast dtinterval :: Interval UTCTime)}
35+ ]
src/lib/ProjectM36/DataTypes/List.hs+4−8
@@ -37,17 +37,13 @@ listAtomFunctions = HS.fromList [
37 AtomFunction {
37 AtomFunction {
38 atomFuncName = "length",
38 atomFuncName = "length",
39 atomFuncType = [listAtomType (TypeVariableType "a"), IntAtomType],
39 atomFuncType = [listAtomType (TypeVariableType "a"), IntAtomType],
40− atomFuncBody = AtomFunctionBody Nothing (\(listAtom:_) ->
40+ atomFuncBody = AtomFunctionBody Nothing (\(listAtom:_) -> do
41− IntAtom . fromIntegral <$> listLength listAtom)
41+ c <- listLength listAtom
42+ pure (IntAtom c))
42 },
43 },
43 AtomFunction {
44 AtomFunction {
44 atomFuncName = "maybeHead",
45 atomFuncName = "maybeHead",
45 atomFuncType = [listAtomType (TypeVariableType "a"), maybeAtomType (TypeVariableType "a")],
46 atomFuncType = [listAtomType (TypeVariableType "a"), maybeAtomType (TypeVariableType "a")],
46 atomFuncBody = AtomFunctionBody Nothing (\(listAtom:_) -> listMaybeHead listAtom)
47 atomFuncBody = AtomFunctionBody Nothing (\(listAtom:_) -> listMaybeHead listAtom)
47 }
48 }
48− ]
49+ ]
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.hsdeleted−53
@@ -1,53 +0,0 @@
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
7−
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+2−10
@@ -5,14 +5,11 @@ primitiveTypeConstructorMapping :: TypeConstructorMapping
5primitiveTypeConstructorMapping = map (\(name, aType) ->
5primitiveTypeConstructorMapping = map (\(name, aType) ->
6 (PrimitiveTypeConstructorDef name aType, [])) prims
6 (PrimitiveTypeConstructorDef name aType, [])) prims
7 where
7 where
8− prims = [("Integer", IntegerAtomType),
9− ("Int", IntAtomType),
8+ prims = [("Int", IntAtomType),
10 ("Text", TextAtomType),
9 ("Text", TextAtomType),
11 ("Double", DoubleAtomType),
10 ("Double", DoubleAtomType),
12 ("Bool", BoolAtomType),
11 ("Bool", BoolAtomType),
13− ("ByteString", ByteStringAtomType),
12+ ("ByteString", ByteStringAtomType)
14− ("DateTime", DateTimeAtomType),
15− ("Day", DayAtomType)
16 ]
13 ]
17
14
18intTypeConstructor :: TypeConstructor
15intTypeConstructor :: TypeConstructor
@@ -27,13 +24,9 @@ textTypeConstructor = PrimitiveTypeConstructor "Text" TextAtomType
27dayTypeConstructor :: TypeConstructor
24dayTypeConstructor :: TypeConstructor
28dayTypeConstructor = PrimitiveTypeConstructor "Day" DayAtomType
25dayTypeConstructor = PrimitiveTypeConstructor "Day" DayAtomType
29
26
30−dateTimeTypeConstructor :: TypeConstructor
31−dateTimeTypeConstructor = PrimitiveTypeConstructor "DateTime" DayAtomType
32−
33-- | Return the type of an 'Atom'.
27-- | Return the type of an 'Atom'.
34atomTypeForAtom :: Atom -> AtomType
28atomTypeForAtom :: Atom -> AtomType
35atomTypeForAtom (IntAtom _) = IntAtomType
29atomTypeForAtom (IntAtom _) = IntAtomType
36−atomTypeForAtom (IntegerAtom _) = IntegerAtomType
37atomTypeForAtom (DoubleAtom _) = DoubleAtomType
30atomTypeForAtom (DoubleAtom _) = DoubleAtomType
38atomTypeForAtom (TextAtom _) = TextAtomType
31atomTypeForAtom (TextAtom _) = TextAtomType
39atomTypeForAtom (DayAtom _) = DayAtomType
32atomTypeForAtom (DayAtom _) = DayAtomType
@@ -42,4 +35,3 @@ atomTypeForAtom (ByteStringAtom _) = ByteStringAtomType
42atomTypeForAtom (BoolAtom _) = BoolAtomType
35atomTypeForAtom (BoolAtom _) = BoolAtomType
43atomTypeForAtom (RelationAtom (Relation attrs _)) = RelationAtomType attrs
36atomTypeForAtom (RelationAtom (Relation attrs _)) = RelationAtomType attrs
44atomTypeForAtom (ConstructedAtom _ aType _) = aType
37atomTypeForAtom (ConstructedAtom _ aType _) = aType
45−atomTypeForAtom (RelationalExprAtom _) = RelationalExprAtomType
src/lib/ProjectM36/DataTypes/Sorting.hsdeleted−31
@@ -1,31 +0,0 @@
1−module ProjectM36.DataTypes.Sorting where
2−import ProjectM36.Base
3−
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+5−24
@@ -1,15 +1,11 @@
1module ProjectM36.DatabaseContext where
1module ProjectM36.DatabaseContext where
2import ProjectM36.Base
2import ProjectM36.Base
3−import Control.Monad (void)
4import qualified Data.Map as M
3import qualified Data.Map as M
5import qualified Data.HashSet as HS
4import qualified Data.HashSet as HS
6import ProjectM36.DataTypes.Basic
5import ProjectM36.DataTypes.Basic
7import ProjectM36.AtomFunctions.Basic
6import ProjectM36.AtomFunctions.Basic
7+import ProjectM36.DatabaseContextFunction
8import ProjectM36.Relation
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
13
9
14empty :: DatabaseContext
10empty :: DatabaseContext
15empty = DatabaseContext { inclusionDependencies = M.empty,
11empty = DatabaseContext { inclusionDependencies = M.empty,
@@ -18,37 +14,22 @@ empty = DatabaseContext { inclusionDependencies = M.empty,
18 atomFunctions = HS.empty,
14 atomFunctions = HS.empty,
19 dbcFunctions = HS.empty,
15 dbcFunctions = HS.empty,
20 typeConstructorMapping = [] }
16 typeConstructorMapping = [] }
21−
22−-- | Remove TransactionId markers on GraphRefRelationalExpr
23−stripGraphRefRelationalExpr :: GraphRefRelationalExpr -> RelationalExpr
24−stripGraphRefRelationalExpr = void
25
17
26-- | convert an existing database context into its constituent expression.
18-- | convert an existing database context into its constituent expression.
27databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr
19databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr
28databaseContextAsDatabaseContextExpr context = MultipleExpr $ relVarsExprs ++ incDepsExprs ++ funcsExprs
20databaseContextAsDatabaseContextExpr context = MultipleExpr $ relVarsExprs ++ incDepsExprs ++ funcsExprs
29 where
21 where
30− relVarsExprs = map (\(name, rel) -> Assign name (stripGraphRefRelationalExpr rel)) (M.toList (relationVariables context))
22+ relVarsExprs = map (\(name, rel) -> Assign name (ExistingRelation rel)) (M.toList (relationVariables context))
31 incDepsExprs :: [DatabaseContextExpr]
23 incDepsExprs :: [DatabaseContextExpr]
32 incDepsExprs = map (uncurry AddInclusionDependency) (M.toList (inclusionDependencies context))
24 incDepsExprs = map (uncurry AddInclusionDependency) (M.toList (inclusionDependencies context))
33− funcsExprs = [] -- map (\func -> ) (HS.toList funcs) -- there are no databaseExprs to add atom functions yet-}
25+ funcsExprs = [] -- map (\func -> ) (HS.toList funcs) -- there are no databaseExprs to add atom functions yet
34
26
35basicDatabaseContext :: DatabaseContext
27basicDatabaseContext :: DatabaseContext
36basicDatabaseContext = DatabaseContext { inclusionDependencies = M.empty,
28basicDatabaseContext = DatabaseContext { inclusionDependencies = M.empty,
37− relationVariables = M.fromList [("true", ExistingRelation relationTrue),
29+ relationVariables = M.fromList [("true", relationTrue),
38− ("false", ExistingRelation relationFalse)],
30+ ("false", relationFalse)],
39 atomFunctions = basicAtomFunctions,
31 atomFunctions = basicAtomFunctions,
40 dbcFunctions = basicDatabaseContextFunctions,
32 dbcFunctions = basicDatabaseContextFunctions,
41 notifications = M.empty,
33 notifications = M.empty,
42 typeConstructorMapping = basicTypeConstructorMapping
34 typeConstructorMapping = basicTypeConstructorMapping
43 }
35 }
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+1−36
@@ -1,18 +1,9 @@
1−{-# LANGUAGE CPP #-}
2module ProjectM36.DatabaseContextFunction where
1module ProjectM36.DatabaseContextFunction where
3--implements functions which operate as: [Atom] -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
2--implements functions which operate as: [Atom] -> DatabaseContextExpr -> Either RelationalError DatabaseContextExpr
4import ProjectM36.Base
3import ProjectM36.Base
5import ProjectM36.Error
4import ProjectM36.Error
6−import ProjectM36.Serialise.Base ()
7−import ProjectM36.Attribute as A
8−import ProjectM36.Relation
9−import ProjectM36.AtomType
10import qualified Data.HashSet as HS
5import qualified Data.HashSet as HS
11import qualified Data.Map as M
6import 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
16
7
17emptyDatabaseContextFunction :: DatabaseContextFunctionName -> DatabaseContextFunction
8emptyDatabaseContextFunction :: DatabaseContextFunctionName -> DatabaseContextFunction
18emptyDatabaseContextFunction name = DatabaseContextFunction {
9emptyDatabaseContextFunction name = DatabaseContextFunction {
@@ -62,30 +53,4 @@ databaseContextFunctionReturnType tCons = ADTypeConstructor "Either" [
62 tCons]
53 tCons]
63
54
64createScriptedDatabaseContextFunction :: DatabaseContextFunctionName -> [TypeConstructor] -> TypeConstructor -> DatabaseContextFunctionBodyScript -> DatabaseContextIOExpr
55createScriptedDatabaseContextFunction :: DatabaseContextFunctionName -> [TypeConstructor] -> TypeConstructor -> DatabaseContextFunctionBodyScript -> DatabaseContextIOExpr
65−createScriptedDatabaseContextFunction funcName argsIn retArg = AddDatabaseContextFunction funcName (argsIn ++ [databaseContextFunctionReturnType retArg])
56+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+2−1
@@ -1,8 +1,9 @@
1{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
1{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
2module ProjectM36.DatabaseContextFunctionError where
2module ProjectM36.DatabaseContextFunctionError where
3import GHC.Generics
3import GHC.Generics
4+import Data.Binary
4import Control.DeepSeq
5import Control.DeepSeq
5
6
6{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
7{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
7data DatabaseContextFunctionError = DatabaseContextFunctionUserError String
8data DatabaseContextFunctionError = DatabaseContextFunctionUserError String
8− deriving (Generic, Eq, Show, NFData)
9+ deriving (Generic, Eq, Show, Binary, NFData)
src/lib/ProjectM36/DatabaseContextFunctionUtils.hs+8−15
@@ -3,20 +3,13 @@ import ProjectM36.RelationalExpression
3import ProjectM36.Base
3import ProjectM36.Base
4import ProjectM36.DatabaseContextFunctionError
4import ProjectM36.DatabaseContextFunctionError
5import ProjectM36.Error
5import ProjectM36.Error
6−import ProjectM36.StaticOptimizer
6+import Control.Monad.State
7+import Control.Monad.Trans.Reader
7
8
8−executeDatabaseContextExpr :: DatabaseContextExpr -> TransactionId -> TransactionGraph -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext
9+executeDatabaseContextExpr :: DatabaseContextExpr -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext
9−executeDatabaseContextExpr expr transId graph context' =
10+executeDatabaseContextExpr expr context = case runState (evalDatabaseContextExpr expr) (freshDatabaseState context) of
10− case run of
11+ (Nothing, (context', _, _)) -> pure context'
11− Right st -> pure (dbc_context st)
12− Left err -> error (show err)
12+ (Just err, _) -> error (show err)
13− where
14− env = mkDatabaseContextEvalEnv transId graph
15− run = runDatabaseContextEvalMonad context' env (optimizeAndEvalDatabaseContextExpr True expr)
16
13
17−executeRelationalExpr :: RelationalExpr -> DatabaseContext -> TransactionGraph -> Either RelationalError Relation
14+executeRelationalExpr :: RelationalExpr -> DatabaseContext -> Either RelationalError Relation
18−executeRelationalExpr expr context graph =
15+executeRelationalExpr expr context = runReader (evalRelationalExpr expr) (mkRelationalExprState context)
19− run
20− where
21− env = mkRelationalExprEnv context graph
22− run = optimizeAndEvalRelationalExpr env expr
src/lib/ProjectM36/DateExamples.hs+33−36
@@ -16,19 +16,16 @@ dateExamples = empty { inclusionDependencies = dateIncDeps,
16 atomFunctions = basicAtomFunctions,
16 atomFunctions = basicAtomFunctions,
17 typeConstructorMapping = basicTypeConstructorMapping }
17 typeConstructorMapping = basicTypeConstructorMapping }
18 where -- these must be lower case now that data constructors are in play
18 where -- these must be lower case now that data constructors are in play
19− dateRelVars = M.fromList [("s", ExistingRelation suppliers),
19+ dateRelVars = M.fromList [("s", suppliers),
20− ("p", ExistingRelation products),
20+ ("p", products),
21− ("sp", ExistingRelation supplierProducts)]
21+ ("sp", supplierProducts)]
22 suppliers = suppliersRel
22 suppliers = suppliersRel
23 products = productsRel
23 products = productsRel
24 supplierProducts = supplierProductsRel
24 supplierProducts = supplierProductsRel
25− dateIncDeps = M.fromList [
25+ dateIncDeps = M.fromList [("s_pkey", simplePKey ["s#"] "s"),
26− ("s_pkey", simplePKey ["s#"] "s"),
27− ("p_pkey", simplePKey ["p#"] "p"),
26+ ("p_pkey", simplePKey ["p#"] "p"),
28− ("sp_pkey", simplePKey ["s#", "p#"] "sp"),
27+ ("sp_pkey", simplePKey ["s#", "p#"] "sp")
29− ("s_sp_fk", inclusionDependencyForForeignKey ("sp", ["s#"]) ("s", ["s#"])),
30− ("p_sp_fk", inclusionDependencyForForeignKey ("sp", ["p#"]) ("p", ["p#"]))
31− ]
28+ ]
32 simplePKey attrNames relvarName = inclusionDependencyForKey (AttributeNames $ S.fromList attrNames) (RelationVariable relvarName ())
29 simplePKey attrNames relvarName = inclusionDependencyForKey (AttributeNames $ S.fromList attrNames) (RelationVariable relvarName ())
33
30
34suppliersRel :: Relation
31suppliersRel :: Relation
@@ -38,14 +35,14 @@ suppliersRel = case mkRelationFromList attrs atomMatrix of
38 where
35 where
39 attrs = A.attributesFromList [Attribute "s#" TextAtomType,
36 attrs = A.attributesFromList [Attribute "s#" TextAtomType,
40 Attribute "sname" TextAtomType,
37 Attribute "sname" TextAtomType,
41− Attribute "status" IntegerAtomType,
38+ Attribute "status" IntAtomType,
42 Attribute "city" TextAtomType]
39 Attribute "city" TextAtomType]
43 atomMatrix = [
40 atomMatrix = [
44− [TextAtom "S1", TextAtom "Smith", IntegerAtom 20, TextAtom "London"],
41+ [TextAtom "S1", TextAtom "Smith", IntAtom 20, TextAtom "London"],
45− [TextAtom "S2", TextAtom "Jones", IntegerAtom 10, TextAtom "Paris"],
42+ [TextAtom "S2", TextAtom "Jones", IntAtom 10, TextAtom "Paris"],
46− [TextAtom "S3", TextAtom "Blake", IntegerAtom 30, TextAtom "Paris"],
43+ [TextAtom "S3", TextAtom "Blake", IntAtom 30, TextAtom "Paris"],
47− [TextAtom "S4", TextAtom "Clark", IntegerAtom 20, TextAtom "London"],
44+ [TextAtom "S4", TextAtom "Clark", IntAtom 20, TextAtom "London"],
48− [TextAtom "S5", TextAtom "Adams", IntegerAtom 30, TextAtom "Athens"]]
45+ [TextAtom "S5", TextAtom "Adams", IntAtom 30, TextAtom "Athens"]]
49
46
50supplierProductsRel :: Relation
47supplierProductsRel :: Relation
51supplierProductsRel = case mkRelationFromList attrs matrix of
48supplierProductsRel = case mkRelationFromList attrs matrix of
@@ -54,20 +51,20 @@ supplierProductsRel = case mkRelationFromList attrs matrix of
54 where
51 where
55 attrs = A.attributesFromList [Attribute "s#" TextAtomType,
52 attrs = A.attributesFromList [Attribute "s#" TextAtomType,
56 Attribute "p#" TextAtomType,
53 Attribute "p#" TextAtomType,
57− Attribute "qty" IntegerAtomType]
54+ Attribute "qty" IntAtomType]
58 matrix = [
55 matrix = [
59− [TextAtom "S1", TextAtom "P1", IntegerAtom 300],
56+ [TextAtom "S1", TextAtom "P1", IntAtom 300],
60− [TextAtom "S1", TextAtom "P2", IntegerAtom 200],
57+ [TextAtom "S1", TextAtom "P2", IntAtom 200],
61− [TextAtom "S1", TextAtom "P3", IntegerAtom 400],
58+ [TextAtom "S1", TextAtom "P3", IntAtom 400],
62− [TextAtom "S1", TextAtom "P4", IntegerAtom 200],
59+ [TextAtom "S1", TextAtom "P4", IntAtom 200],
63− [TextAtom "S1", TextAtom "P5", IntegerAtom 100],
60+ [TextAtom "S1", TextAtom "P5", IntAtom 100],
64− [TextAtom "S1", TextAtom "P6", IntegerAtom 100],
61+ [TextAtom "S1", TextAtom "P6", IntAtom 100],
65− [TextAtom "S2", TextAtom "P1", IntegerAtom 300],
62+ [TextAtom "S2", TextAtom "P1", IntAtom 300],
66− [TextAtom "S2", TextAtom "P2", IntegerAtom 400],
63+ [TextAtom "S2", TextAtom "P2", IntAtom 400],
67− [TextAtom "S3", TextAtom "P2", IntegerAtom 200],
64+ [TextAtom "S3", TextAtom "P2", IntAtom 200],
68− [TextAtom "S4", TextAtom "P2", IntegerAtom 200],
65+ [TextAtom "S4", TextAtom "P2", IntAtom 200],
69− [TextAtom "S4", TextAtom "P4", IntegerAtom 300],
66+ [TextAtom "S4", TextAtom "P4", IntAtom 300],
70− [TextAtom "S4", TextAtom "P5", IntegerAtom 400]
67+ [TextAtom "S4", TextAtom "P5", IntAtom 400]
71 ]
68 ]
72
69
73productsRel :: Relation
70productsRel :: Relation
@@ -78,13 +75,13 @@ productsRel = case mkRelationFromList attrs matrix of
78 attrs = A.attributesFromList [Attribute "p#" TextAtomType,
75 attrs = A.attributesFromList [Attribute "p#" TextAtomType,
79 Attribute "pname" TextAtomType,
76 Attribute "pname" TextAtomType,
80 Attribute "color" TextAtomType,
77 Attribute "color" TextAtomType,
81− Attribute "weight" IntegerAtomType,
78+ Attribute "weight" IntAtomType,
82 Attribute "city" TextAtomType]
79 Attribute "city" TextAtomType]
83 matrix = [
80 matrix = [
84− [TextAtom "P1", TextAtom "Nut", TextAtom "Red", IntegerAtom 12, TextAtom "London"],
81+ [TextAtom "P1", TextAtom "Nut", TextAtom "Red", IntAtom 12, TextAtom "London"],
85− [TextAtom "P2", TextAtom "Bolt", TextAtom "Green", IntegerAtom 17, TextAtom "Paris"],
82+ [TextAtom "P2", TextAtom "Bolt", TextAtom "Green", IntAtom 17, TextAtom "Paris"],
86− [TextAtom "P3", TextAtom "Screw", TextAtom "Blue", IntegerAtom 17, TextAtom "Oslo"],
83+ [TextAtom "P3", TextAtom "Screw", TextAtom "Blue", IntAtom 17, TextAtom "Oslo"],
87− [TextAtom "P4", TextAtom "Screw", TextAtom "Red", IntegerAtom 14, TextAtom "London"],
84+ [TextAtom "P4", TextAtom "Screw", TextAtom "Red", IntAtom 14, TextAtom "London"],
88− [TextAtom "P5", TextAtom "Cam", TextAtom "Blue", IntegerAtom 12, TextAtom "Paris"],
85+ [TextAtom "P5", TextAtom "Cam", TextAtom "Blue", IntAtom 12, TextAtom "Paris"],
89− [TextAtom "P6", TextAtom "Cog", TextAtom "Red", IntegerAtom 19, TextAtom "London"]
86+ [TextAtom "P6", TextAtom "Cog", TextAtom "Red", IntAtom 19, TextAtom "London"]
90 ]
87 ]
src/lib/ProjectM36/DisconnectedTransaction.hs+1−7
@@ -8,10 +8,4 @@ schemas :: DisconnectedTransaction -> Schemas
8schemas (DisconnectedTransaction _ s _) = s
8schemas (DisconnectedTransaction _ s _) = s
9
9
10parentId :: DisconnectedTransaction -> TransactionId
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+17−33
@@ -1,7 +1,6 @@
1{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
1{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
2module ProjectM36.Error where
2module ProjectM36.Error where
3import ProjectM36.Base
3import ProjectM36.Base
4−import ProjectM36.MerkleHash
5import ProjectM36.DatabaseContextFunctionError
4import ProjectM36.DatabaseContextFunctionError
6import ProjectM36.AtomFunctionError
5import ProjectM36.AtomFunctionError
7import qualified Data.Set as S
6import qualified Data.Set as S
@@ -9,13 +8,12 @@ import Control.DeepSeq (NFData, rnf)
9import Control.DeepSeq.Generics (genericRnf)
8import Control.DeepSeq.Generics (genericRnf)
10import GHC.Generics (Generic)
9import GHC.Generics (Generic)
11import qualified Data.Text as T
10import qualified Data.Text as T
11+import Data.Binary
12import Data.Typeable
12import Data.Typeable
13import Control.Exception
13import Control.Exception
14
14
15data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
15data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
16 | TupleAttributeCountMismatchError Int --attribute name
16 | TupleAttributeCountMismatchError Int --attribute name
17− | EmptyAttributesError
18− | DuplicateAttributeNamesError (S.Set AttributeName)
19 | TupleAttributeTypeMismatchError Attributes
17 | TupleAttributeTypeMismatchError Attributes
20 | AttributeCountMismatchError Int
18 | AttributeCountMismatchError Int
21 | AttributeNamesMismatchError (S.Set AttributeName)
19 | AttributeNamesMismatchError (S.Set AttributeName)
@@ -24,7 +22,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
24 | CouldNotInferAttributes
22 | CouldNotInferAttributes
25 | RelVarNotDefinedError RelVarName
23 | RelVarNotDefinedError RelVarName
26 | RelVarAlreadyDefinedError RelVarName
24 | RelVarAlreadyDefinedError RelVarName
27− | RelationTypeMismatchError Attributes Attributes --expected, found
25+ | RelVarAssignmentTypeMismatchError Attributes Attributes --expected, found
28 | InclusionDependencyCheckError IncDepName
26 | InclusionDependencyCheckError IncDepName
29 | InclusionDependencyNameInUseError IncDepName
27 | InclusionDependencyNameInUseError IncDepName
30 | InclusionDependencyNameNotInUseError IncDepName
28 | InclusionDependencyNameNotInUseError IncDepName
@@ -62,12 +60,10 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
62 | AtomTypeNameInUseError AtomTypeName
60 | AtomTypeNameInUseError AtomTypeName
63 | IncompletelyDefinedAtomTypeWithConstructorError
61 | IncompletelyDefinedAtomTypeWithConstructorError
64 | AtomTypeNameNotInUseError AtomTypeName
62 | AtomTypeNameNotInUseError AtomTypeName
65− | AttributeNotSortableError Attribute
66 | FunctionNameInUseError AtomFunctionName
63 | FunctionNameInUseError AtomFunctionName
67 | FunctionNameNotInUseError AtomFunctionName
64 | FunctionNameNotInUseError AtomFunctionName
68 | EmptyCommitError
65 | EmptyCommitError
69− | FunctionArgumentCountMismatchError Int Int
66+ | FunctionArgumentCountMismatch Int Int
70− | ConstructedAtomArgumentCountMismatchError Int Int
71 | NoSuchDataConstructorError DataConstructorName
67 | NoSuchDataConstructorError DataConstructorName
72 | NoSuchTypeConstructorError TypeConstructorName
68 | NoSuchTypeConstructorError TypeConstructorName
73 | InvalidAtomTypeName AtomTypeName
69 | InvalidAtomTypeName AtomTypeName
@@ -81,12 +77,11 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
81 | RelationValuedAttributesNotSupportedError [AttributeName]
77 | RelationValuedAttributesNotSupportedError [AttributeName]
82 | NotificationNameInUseError NotificationName
78 | NotificationNameInUseError NotificationName
83 | NotificationNameNotInUseError NotificationName
79 | NotificationNameNotInUseError NotificationName
84− | ImportError ImportError'
80+ | ImportError T.Text -- really? This should be broken out into some other error type- this has nothing to do with relational algebra
85 | ExportError T.Text
81 | ExportError T.Text
86 | UnhandledExceptionError String
82 | UnhandledExceptionError String
87 | MergeTransactionError MergeError
83 | MergeTransactionError MergeError
88 | ScriptError ScriptCompilationError
84 | ScriptError ScriptCompilationError
89− | LoadFunctionError
90 | DatabaseContextFunctionUserError DatabaseContextFunctionError
85 | DatabaseContextFunctionUserError DatabaseContextFunctionError
91 | DatabaseLoadError PersistenceError
86 | DatabaseLoadError PersistenceError
92
87
@@ -96,21 +91,13 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
96 | SchemaCreationError SchemaError
91 | SchemaCreationError SchemaError
97
92
98 | ImproperDatabaseStateError
93 | ImproperDatabaseStateError
99−
94+
100− | NonConcreteSchemaPlanError
101−
102− | NoUncommittedContextInEvalError
103− | TupleExprsReferenceMultipleMarkersError
104−
105− | MerkleHashValidationError TransactionId MerkleHash MerkleHash
106−
107 | MultipleErrors [RelationalError]
95 | MultipleErrors [RelationalError]
108− deriving (Show,Eq,Generic,Typeable, NFData)
96+ deriving (Show,Eq,Generic,Binary,Typeable, NFData)
109
97
110data PersistenceError = InvalidDirectoryError FilePath |
98data PersistenceError = InvalidDirectoryError FilePath |
111− MissingTransactionError TransactionId |
99+ MissingTransactionError TransactionId
112− WrongDatabaseFormatVersionError String String
113− deriving (Show, Eq, Generic, NFData)
100+ deriving (Show, Eq, Generic, Binary, NFData)
114
101
115--collapse list of errors into normal error- if there is just one, just return one
102--collapse list of errors into normal error- if there is just one, just return one
116someErrors :: [RelationalError] -> RelationalError
103someErrors :: [RelationalError] -> RelationalError
@@ -128,7 +115,7 @@ data MergeError = SelectedHeadMismatchMergeError |
128 StrategyViolatesComponentMergeError | --failed merge in inc deps, relvars, etc.
115 StrategyViolatesComponentMergeError | --failed merge in inc deps, relvars, etc.
129 StrategyViolatesRelationVariableMergeError |
116 StrategyViolatesRelationVariableMergeError |
130 StrategyViolatesTypeConstructorMergeError
117 StrategyViolatesTypeConstructorMergeError
131− deriving (Show, Eq, Generic, Typeable)
118+ deriving (Show, Eq, Generic, Binary, Typeable)
132
119
133instance NFData MergeError where rnf = genericRnf
120instance NFData MergeError where rnf = genericRnf
134
121
@@ -136,20 +123,17 @@ data ScriptCompilationError = TypeCheckCompilationError String String | --expect
136 SyntaxErrorCompilationError String |
123 SyntaxErrorCompilationError String |
137 ScriptCompilationDisabledError |
124 ScriptCompilationDisabledError |
138 OtherScriptCompilationError String
125 OtherScriptCompilationError String
139− deriving (Show, Eq, Generic, Typeable, NFData)
126+ deriving (Show, Eq, Generic, Binary, Typeable, NFData)
140
127
141instance Exception ScriptCompilationError
128instance Exception ScriptCompilationError
142
129
143data SchemaError = RelVarReferencesMissing (S.Set RelVarName) |
130data SchemaError = RelVarReferencesMissing (S.Set RelVarName) |
144 RelVarInReferencedMoreThanOnce RelVarName |
131 RelVarInReferencedMoreThanOnce RelVarName |
145 RelVarOutReferencedMoreThanOnce RelVarName
132 RelVarOutReferencedMoreThanOnce RelVarName
146− deriving (Show, Eq, Generic, Typeable, NFData)
133+ deriving (Show, Eq, Generic, Binary, Typeable, NFData)
147−
134+
148−
135+
149−data ImportError' = InvalidSHA256Error T.Text
136+-- errors returned from the distributed-process call handlers
150− | SHA256MismatchError T.Text T.Text
137+data ServerError = RequestTimeoutError |
151− | InvalidFileURIError T.Text
138+ ProcessDiedError String
152− | ImportFileDecodeError T.Text
153− | ImportFileError T.Text
154− | ImportDownloadError T.Text
155− deriving (Show, Eq, Generic, Typeable, NFData)
139+ deriving (Generic, Binary, Eq)
src/lib/ProjectM36/FSType.hsdeleted−102
@@ -1,102 +0,0 @@
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
6−
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+31−42
@@ -2,9 +2,11 @@
2--cross-platform file locking utilizing POSIX file locking on Unix/Linux and Windows file locking
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
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
4module ProjectM36.FileLock where
5+import System.IO
5
6
6
7
7#if defined(mingw32_HOST_OS)
8#if defined(mingw32_HOST_OS)
9+import ProjectM36.Win32Handle
8import System.Win32.Types
10import System.Win32.Types
9import Foreign.Marshal.Alloc
11import Foreign.Marshal.Alloc
10import System.Win32.File
12import System.Win32.File
@@ -22,24 +24,9 @@ foreign import WINDOWS_CCONV "LockFileEx" c_lockFileEx :: HANDLE -> DWORD -> DWO
22
24
23foreign import WINDOWS_CCONV "UnlockFileEx" c_unlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL
25foreign import WINDOWS_CCONV "UnlockFileEx" c_unlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL
24
26
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−
40--swiped from System.FileLock package
27--swiped from System.FileLock package
41−lockFile :: HANDLE -> LockType -> IO ()
28+lockFile :: Handle -> LockType -> IO ()
42−lockFile winHandle lock = do
29+lockFile handle lock = withHandleToHANDLE handle $ \winHandle -> do
43 let exFlag = case lock of
30 let exFlag = case lock of
44 WriteLock -> 2
31 WriteLock -> 2
45 ReadLock -> 0
32 ReadLock -> 0
@@ -48,49 +35,51 @@ lockFile winHandle lock = do
48
35
49 allocaBytes sizeof_OVERLAPPED $ \op -> do
36 allocaBytes sizeof_OVERLAPPED $ \op -> do
50 zeroMemory op $ fromIntegral sizeof_OVERLAPPED
37 zeroMemory op $ fromIntegral sizeof_OVERLAPPED
51− failIfFalse_ "LockFileEx" $ c_lockFileEx winHandle (exFlag .|. blockFlag) 0 1 0 op
38+ res <- c_lockFileEx winHandle (exFlag .|. blockFlag) 0 1 0 op
52−
39+ if res then
40+ pure ()
41+ else
42+ error "failed to wait for database lock"
43+
53−unlockFile :: HANDLE -> IO ()
44+unlockFile :: Handle -> IO ()
54−unlockFile winHandle = do
45+unlockFile handle = withHandleToHANDLE handle $ \winHandle -> do
55 let sizeof_OVERLAPPED = 32
46 let sizeof_OVERLAPPED = 32
56 allocaBytes sizeof_OVERLAPPED $ \op -> do
47 allocaBytes sizeof_OVERLAPPED $ \op -> do
57 zeroMemory op $ fromIntegral sizeof_OVERLAPPED
48 zeroMemory op $ fromIntegral sizeof_OVERLAPPED
58− failIfFalse_ "UnlockFileEx" $ c_unlockFileEx winHandle 0 1 0 op
49+ res <- c_unlockFileEx winHandle 0 1 0 op
50+ if res then
51+ pure ()
52+ else
53+ error ("failed to unlock database lock: " ++ show res)
59
54
60#else
55#else
61−--all of this complicated nonsense is fixed if we switch to GHC 8.2 which includes native flock support on handles
62import qualified System.Posix.IO as P
56import qualified System.Posix.IO as P
63−import System.Posix.Types
64−import System.Posix.Files
65−import System.IO
66
57
67lockStruct :: P.LockRequest -> P.FileLock
58lockStruct :: P.LockRequest -> P.FileLock
68lockStruct req = (req, AbsoluteSeek, 0, 0)
59lockStruct req = (req, AbsoluteSeek, 0, 0)
69
60
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−
81--blocks on lock, if necessary
61--blocks on lock, if necessary
82−lockFile :: LockFile -> LockType -> IO ()
62+lockFile :: Handle -> LockType -> IO ()
83−lockFile (LockFile fd) lock = do
63+lockFile file lock = do
64+ fd <- P.handleToFd file
84 let lockt = case lock of
65 let lockt = case lock of
85 WriteLock -> P.WriteLock
66 WriteLock -> P.WriteLock
86 ReadLock -> P.ReadLock
67 ReadLock -> P.ReadLock
87 P.waitToSetLock fd (lockStruct lockt)
68 P.waitToSetLock fd (lockStruct lockt)
88
69
89−unlockFile :: LockFile -> IO ()
70+unlockFile :: Handle -> IO ()
90−unlockFile (LockFile fd) =
71+unlockFile file = do
72+ fd <- P.handleToFd file
91 P.waitToSetLock fd (lockStruct P.Unlock)
73 P.waitToSetLock fd (lockStruct P.Unlock)
92#endif
74#endif
93
75
94−data LockType = ReadLock | WriteLock deriving (Show)
76+data LockType = ReadLock | WriteLock
77+
78+{-
79+lockFileSTM :: Handle -> LockType -> STM ()
80+lockFileSTM file lock = unsafeIOToSTM $ onException (lockFile file lock) (unlockFile file)
95
81
82+unlockFileSTM :: Handle -> STM ()
83+unlockFileSTM file = unsafeIOToSTM $ unlockFile file
84+-}
96
85
src/lib/ProjectM36/GraphRefRelationalExpr.hsdeleted−45
@@ -1,45 +0,0 @@
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
5−
6−--import Debug.Trace
7−
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+6−5
@@ -4,16 +4,17 @@ import ProjectM36.Attribute
4import ProjectM36.Error
4import ProjectM36.Error
5import ProjectM36.Relation
5import ProjectM36.Relation
6import qualified Data.Map as M
6import qualified Data.Map as M
7+import qualified Data.Text as T
7
8
8inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation
9inclusionDependenciesAsRelation :: InclusionDependencies -> Either RelationalError Relation
9inclusionDependenciesAsRelation incDeps =
10inclusionDependenciesAsRelation incDeps =
10 mkRelationFromList attrs (map incDepAsAtoms (M.toList incDeps))
11 mkRelationFromList attrs (map incDepAsAtoms (M.toList incDeps))
11 where
12 where
12 attrs = attributesFromList [Attribute "name" TextAtomType,
13 attrs = attributesFromList [Attribute "name" TextAtomType,
13− Attribute "sub" RelationalExprAtomType,
14+ Attribute "sub" TextAtomType,
14− Attribute "super" RelationalExprAtomType
15+ Attribute "super" TextAtomType
15 ]
16 ]
16 incDepAsAtoms (name, InclusionDependency exprA exprB) = [TextAtom name,
17 incDepAsAtoms (name, InclusionDependency exprA exprB) = [TextAtom name,
17− RelationalExprAtom exprA,
18+ TextAtom (T.pack (show exprA)),
18− RelationalExprAtom exprB]
19+ TextAtom (T.pack (show exprB))]
19−
20+
src/lib/ProjectM36/IsomorphicSchema.hs+40−37
@@ -1,20 +1,22 @@
1−{-# LANGUAGE DeriveGeneric, LambdaCase, DerivingVia #-}
1+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
2module ProjectM36.IsomorphicSchema where
2module ProjectM36.IsomorphicSchema where
3import ProjectM36.Base
3import ProjectM36.Base
4import ProjectM36.Error
4import ProjectM36.Error
5import ProjectM36.MiscUtils
5import ProjectM36.MiscUtils
6−import ProjectM36.Relation
7−import ProjectM36.NormalizeExpr
8import ProjectM36.RelationalExpression
6import ProjectM36.RelationalExpression
7+import ProjectM36.Relation
9import qualified ProjectM36.AttributeNames as AN
8import qualified ProjectM36.AttributeNames as AN
10import Control.Monad
9import Control.Monad
10+import Control.Monad.State
11+import Control.Monad.Trans.Reader
11import GHC.Generics
12import GHC.Generics
13+import Data.Binary
12import qualified Data.Map as M
14import qualified Data.Map as M
13import qualified Data.Set as S
15import qualified Data.Set as S
14import qualified Data.List as L
16import qualified Data.List as L
15−#if __GLASGOW_HASKELL__ < 804
17+import qualified Data.Text as T
16import Data.Monoid
18import Data.Monoid
17−#endif
19+--import Debug.Trace
18-- isomorphic schemas offer bi-directional functors between two schemas
20-- isomorphic schemas offer bi-directional functors between two schemas
19
21
20--TODO: note that renaming a relvar should alter any stored isomorphisms as well
22--TODO: note that renaming a relvar should alter any stored isomorphisms as well
@@ -27,7 +29,8 @@ import Data.Monoid
27
29
28data SchemaExpr = AddSubschema SchemaName SchemaIsomorphs |
30data SchemaExpr = AddSubschema SchemaName SchemaIsomorphs |
29 RemoveSubschema SchemaName
31 RemoveSubschema SchemaName
30− deriving (Generic, Show)
32+ deriving (Generic, Binary, Show)
33+
31
34
32isomorphs :: Schema -> SchemaIsomorphs
35isomorphs :: Schema -> SchemaIsomorphs
33isomorphs (Schema i) = i
36isomorphs (Schema i) = i
@@ -79,9 +82,9 @@ isomorphsOutRelVarNames morphs = S.fromList (foldr rvnames [] morphs)
79
82
80-- | Check that all mentioned relvars are actually present in the current schema.
83-- | Check that all mentioned relvars are actually present in the current schema.
81validateRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError ()
84validateRelationalExprInSchema :: Schema -> RelationalExpr -> Either RelationalError ()
82−validateRelationalExprInSchema schema relExprIn = relExprMogrify (\case
85+validateRelationalExprInSchema schema relExprIn = relExprMogrify (\expr -> case expr of
83− RelationVariable rv () | S.notMember rv validRelVarNames -> Left (RelVarNotDefinedError rv)
86+ RelationVariable rv () | S.notMember rv validRelVarNames -> Left (RelVarNotDefinedError rv)
84− ex -> Right ex) relExprIn >> pure ()
87+ ex -> Right ex) relExprIn >> pure ()
85 where
88 where
86 validRelVarNames = isomorphsInRelVarNames (isomorphs schema)
89 validRelVarNames = isomorphsInRelVarNames (isomorphs schema)
87
90
@@ -130,16 +133,16 @@ applySchemaToInclusionDependencies (Schema morphs) incDeps =
130
133
131-- | Morph a relational expression in one schema to another isomorphic schema.
134-- | Morph a relational expression in one schema to another isomorphic schema.
132relExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr)
135relExprMorph :: SchemaIsomorph -> (RelationalExpr -> Either RelationalError RelationalExpr)
133−relExprMorph (IsoRestrict relIn _ (relOutTrue, relOutFalse)) = \case
136+relExprMorph (IsoRestrict relIn _ (relOutTrue, relOutFalse)) = \expr -> case expr of
134 RelationVariable rv () | rv == relIn -> Right (Union (RelationVariable relOutTrue ()) (RelationVariable relOutFalse ()))
137 RelationVariable rv () | rv == relIn -> Right (Union (RelationVariable relOutTrue ()) (RelationVariable relOutFalse ()))
135 orig -> Right orig
138 orig -> Right orig
136−relExprMorph (IsoUnion (relInT, relInF) predi relTarget) = \case
139+relExprMorph (IsoUnion (relInT, relInF) predi relTarget) = \expr -> case expr of
137 --only the true predicate portion appears in the virtual schema
140 --only the true predicate portion appears in the virtual schema
138 RelationVariable rv () | rv == relInT -> Right (Restrict predi (RelationVariable relTarget ()))
141 RelationVariable rv () | rv == relInT -> Right (Restrict predi (RelationVariable relTarget ()))
139
142
140 RelationVariable rv () | rv == relInF -> Right (Restrict (NotPredicate predi) (RelationVariable relTarget ()))
143 RelationVariable rv () | rv == relInF -> Right (Restrict (NotPredicate predi) (RelationVariable relTarget ()))
141 orig -> Right orig
144 orig -> Right orig
142−relExprMorph (IsoRename relIn relOut) = \case
145+relExprMorph (IsoRename relIn relOut) = \expr -> case expr of
143 RelationVariable rv () | rv == relIn -> Right (RelationVariable relOut ())
146 RelationVariable rv () | rv == relIn -> Right (RelationVariable relOut ())
144 orig -> Right orig
147 orig -> Right orig
145
148
@@ -251,17 +254,17 @@ inclusionDependencyInSchema schema (InclusionDependency rexprA rexprB) = do
251-- also, it's inverse to IsoRestrict which adds two constraints at the base level
254-- also, it's inverse to IsoRestrict which adds two constraints at the base level
252-- for IsoRestrict, consider hiding the two, generated constraints since they can never be thrown in the isomorphic schema
255-- for IsoRestrict, consider hiding the two, generated constraints since they can never be thrown in the isomorphic schema
253inclusionDependenciesInSchema :: Schema -> InclusionDependencies -> Either RelationalError InclusionDependencies
256inclusionDependenciesInSchema :: Schema -> InclusionDependencies -> Either RelationalError InclusionDependencies
254−inclusionDependenciesInSchema schema incDeps = M.fromList <$> mapM (\(depName, dep) -> inclusionDependencyInSchema schema dep >>= \newDep -> pure (depName, newDep)) (M.toList incDeps)
257+inclusionDependenciesInSchema schema incDeps = mapM (\(depName, dep) -> inclusionDependencyInSchema schema dep >>= \newDep -> pure (depName, newDep)) (M.toList incDeps) >>= pure . M.fromList
255
258
256−relationVariablesInSchema :: Schema -> Either RelationalError RelationVariables
259+relationVariablesInSchema :: Schema -> DatabaseContext -> Either RelationalError RelationVariables
257−relationVariablesInSchema schema@(Schema morphs) = foldM transform M.empty morphs
260+relationVariablesInSchema schema@(Schema morphs) context = foldM transform M.empty morphs
258 where
261 where
259 transform newRvMap morph = do
262 transform newRvMap morph = do
260 let rvNames = isomorphInRelVarNames morph
263 let rvNames = isomorphInRelVarNames morph
261 rvAssocs <- mapM (\rv -> do
264 rvAssocs <- mapM (\rv -> do
262 expr' <- processRelationalExprInSchema schema (RelationVariable rv ())
265 expr' <- processRelationalExprInSchema schema (RelationVariable rv ())
263− let gfExpr = runProcessExprM UncommittedContextMarker (processRelationalExpr expr')
266+ rel <- runReader (evalRelationalExpr expr') (RelationalExprStateElems context)
264− pure (rv, gfExpr)) rvNames
267+ pure (rv, rel)) rvNames
265 pure (M.union newRvMap (M.fromList rvAssocs))
268 pure (M.union newRvMap (M.fromList rvAssocs))
266
269
267
270
@@ -301,32 +304,32 @@ validate morph underlyingRvNames = if S.size invalidRvNames > 0 then
301
304
302-- | Create inclusion dependencies mainly for IsoRestrict because the predicate should hold in the base schema.
305-- | Create inclusion dependencies mainly for IsoRestrict because the predicate should hold in the base schema.
303createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies
306createIncDepsForIsomorph :: SchemaName -> SchemaIsomorph -> InclusionDependencies
304−createIncDepsForIsomorph sname (IsoRestrict origRv predi (rvTrue, rvFalse)) = let
307+createIncDepsForIsomorph sname (IsoRestrict _ predi (rvTrue, rvFalse)) = let
305 newIncDep predicate rv = InclusionDependency (Project AN.empty (Restrict predicate (RelationVariable rv ()))) (ExistingRelation relationTrue)
308 newIncDep predicate rv = InclusionDependency (Project AN.empty (Restrict predicate (RelationVariable rv ()))) (ExistingRelation relationTrue)
306− incDepName b = "schema" <> "_" <> sname <> "_" <> b in
309+ incDepName b = "schema" <> "_" <> sname <> "_" <> T.pack (show b) in
307− M.fromList [(incDepName (origRv <> "_true"), newIncDep predi rvTrue),
310+ M.fromList [(incDepName True, newIncDep predi rvTrue),
308− (incDepName (origRv <> "_false"), newIncDep (NotPredicate predi) rvFalse)]
311+ (incDepName False, newIncDep (NotPredicate predi) rvFalse)]
309createIncDepsForIsomorph _ _ = M.empty
312createIncDepsForIsomorph _ _ = M.empty
310
313
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
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
312−evalSchemaExpr :: SchemaExpr -> DatabaseContext -> TransactionId -> TransactionGraph -> Subschemas -> Either RelationalError (Subschemas, DatabaseContext)
315+evalSchemaExpr :: SchemaExpr -> DatabaseContext -> Subschemas -> Either RelationalError (Subschemas, DatabaseContext)
313−evalSchemaExpr (AddSubschema sname morphs) context transId graph sschemas =
316+evalSchemaExpr (AddSubschema sname morphs) context sschemas =
314 if M.member sname sschemas then
317 if M.member sname sschemas then
315 Left (SubschemaNameInUseError sname)
318 Left (SubschemaNameInUseError sname)
316− else
319+ else case valid of
317− case validateSchema (Schema morphs) context of
318− Just err -> Left (SchemaCreationError err)
320+ Just err -> Left (SchemaCreationError err)
319− Nothing -> do
321+ Nothing ->
320− let newSchemas = M.insert sname newSchema sschemas
322+ let newSchemas = M.insert sname newSchema sschemas
321− newSchema = Schema morphs
322− moreIncDeps = foldr (\morph acc -> M.union acc (createIncDepsForIsomorph sname morph)) M.empty morphs
323+ moreIncDeps = foldr (\morph acc -> M.union acc (createIncDepsForIsomorph sname morph)) M.empty morphs
323− incDepExprs = MultipleExpr (map (uncurry AddInclusionDependency) (M.toList moreIncDeps))
324+ incDepExprs = MultipleExpr (map (uncurry AddInclusionDependency) (M.toList moreIncDeps))
324− dbenv = mkDatabaseContextEvalEnv transId graph
325+ in
325− dbstate <- runDatabaseContextEvalMonad context dbenv (evalGraphRefDatabaseContextExpr incDepExprs)
326+ case runState (evalDatabaseContextExpr incDepExprs) (context, M.empty, False) of
326− pure (newSchemas, dbc_context dbstate)
327+ (Just err, _) -> Left err
327−--need to propagate dirty flag here
328+ (Nothing, (newContext,_,_)) -> pure (newSchemas, newContext) --need to propagate dirty flag here
328−
329+ where
330+ newSchema = Schema morphs
331+ valid = validateSchema newSchema context
329−evalSchemaExpr (RemoveSubschema sname) context _ _ sschemas = if M.member sname sschemas then
332+evalSchemaExpr (RemoveSubschema sname) context sschemas = if M.member sname sschemas then
330 pure (M.delete sname sschemas, context)
333 pure (M.delete sname sschemas, context)
331 else
334 else
332 Left (SubschemaNameNotInUseError sname)
335 Left (SubschemaNameNotInUseError sname)
src/lib/ProjectM36/Key.hs+2−27
@@ -2,9 +2,7 @@ module ProjectM36.Key where
2import ProjectM36.Base
2import ProjectM36.Base
3import ProjectM36.Relation
3import ProjectM36.Relation
4import qualified Data.Set as S
4import qualified Data.Set as S
5−#if __GLASGOW_HASKELL__ < 804
6import Data.Monoid
5import Data.Monoid
7−#endif
8
6
9{-
7{-
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
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
@@ -41,29 +39,6 @@ databaseContextExprForUniqueKey rvName attrNames = AddInclusionDependency (rvNam
41
39
42-- | Create a foreign key constraint from the first relation variable and attributes to the second.
40-- | Create a foreign key constraint from the first relation variable and attributes to the second.
43databaseContextExprForForeignKey :: IncDepName -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> DatabaseContextExpr
41databaseContextExprForForeignKey :: IncDepName -> (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> DatabaseContextExpr
44−databaseContextExprForForeignKey fkName infoA infoB =
42+databaseContextExprForForeignKey fkName (rvA, attrsA) (rvB, attrsB) = AddInclusionDependency fkName $ InclusionDependency (Project (attrsL attrsA) (RelationVariable rvA ())) (Project (attrsL attrsB) (RelationVariable rvB ()))
45− AddInclusionDependency fkName (inclusionDependencyForForeignKey infoA infoB)
46−
47−inclusionDependencyForForeignKey :: (RelVarName, [AttributeName]) -> (RelVarName, [AttributeName]) -> InclusionDependency
48−inclusionDependencyForForeignKey (rvA, attrsA) (rvB, attrsB) =
49− InclusionDependency (
50− renameIfNecessary attrsB attrsA (Project (attrsL attrsA)
51− (RelationVariable rvA ()))) (
52− Project (attrsL attrsB) (RelationVariable rvB ()))
53 where
43 where
54− attrsL = AttributeNames . S.fromList
44+ attrsL = AttributeNames . S.fromList
55− renameIfNecessary attrsExpected attrsExisting expr = foldr folder expr (zip attrsExpected attrsExisting)
56− folder (attrExpected, attrExisting) expr = if attrExpected == attrExisting then
57− expr
58− else
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.hsdeleted−9
@@ -1,9 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric, DerivingVia #-}
2−module ProjectM36.MerkleHash where
3−import Data.ByteString (ByteString)
4−import GHC.Generics
5−import Control.DeepSeq (NFData)
6−
7−newtype MerkleHash = MerkleHash { _unMerkleHash :: ByteString }
8− deriving (Show, Eq, Generic, Monoid, Semigroup, NFData)
9−
src/lib/ProjectM36/MiscUtils.hs−6
@@ -7,9 +7,3 @@ dupes [_] = []
7dupes [x,y] = [x | x == y]
7dupes [x,y] = [x | x == y]
8dupes (x:y:xs) = dupes(x:[y]) ++ dupes(y : xs)
8dupes (x:y:xs) = dupes(x:[y]) ++ dupes(y : xs)
9
9
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.hsdeleted−132
@@ -1,132 +0,0 @@
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
6−
7−--used to process/normalize exprs to their respective graph ref forms
8−type ProcessExprM a = Reader GraphRefTransactionMarker a
9−
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+7−12
@@ -1,22 +1,17 @@
1module ProjectM36.Notifications where
1module ProjectM36.Notifications where
2import ProjectM36.Base
2import ProjectM36.Base
3−import ProjectM36.Error
4import ProjectM36.RelationalExpression
3import ProjectM36.RelationalExpression
5−import ProjectM36.StaticOptimizer
4+import Control.Monad.Trans.Reader
6import qualified Data.Map as M
5import qualified Data.Map as M
7import Data.Either (isRight)
6import Data.Either (isRight)
8
7
9-- | Returns the notifications which should be triggered based on the transition from the first 'DatabaseContext' to the second 'DatabaseContext'.
8-- | Returns the notifications which should be triggered based on the transition from the first 'DatabaseContext' to the second 'DatabaseContext'.
10−notificationChanges :: Notifications -> TransactionGraph -> DatabaseContext -> DatabaseContext -> Notifications
9+notificationChanges :: Notifications -> DatabaseContext -> DatabaseContext -> Notifications
11−notificationChanges nots graph context1 context2 = M.filter notificationFilter nots
10+notificationChanges nots context1 context2 = M.filter notificationFilter nots
12 where
11 where
12+ notificationFilter (Notification chExpr _) = let oldChangeEval = evalChangeExpr chExpr (RelationalExprStateElems context1)
13+ newChangeEval = evalChangeExpr chExpr (RelationalExprStateElems context2) in
13− notificationFilter (Notification chExpr _ _) = oldChangeEval /= newChangeEval && isRight oldChangeEval
14+ oldChangeEval /= newChangeEval && isRight oldChangeEval
14− where
15+ evalChangeExpr chExpr = runReader (evalRelationalExpr chExpr)
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
21
16
22
17
src/lib/ProjectM36/Persist.hs+13−62
@@ -2,26 +2,11 @@
2--this module is related to persisting Project:M36 structures to disk and not related to the persistent library
2--this module is related to persisting Project:M36 structures to disk and not related to the persistent library
3module ProjectM36.Persist (writeFileSync,
3module ProjectM36.Persist (writeFileSync,
4 writeBSFileSync,
4 writeBSFileSync,
5− renameSync,
5+ renameSync,
6− printFdCount,
7 DiskSync(..)) where
6 DiskSync(..)) where
8-- on Windows, use FlushFileBuffers and MoveFileEx
7-- on Windows, use FlushFileBuffers and MoveFileEx
9−import qualified Data.Text as T
8+import qualified Data.Text.IO as TIO
10−
9+import Data.Text
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−
25#if defined(mingw32_HOST_OS)
10#if defined(mingw32_HOST_OS)
26import qualified System.Win32 as Win32
11import qualified System.Win32 as Win32
27#else
12#else
@@ -31,13 +16,12 @@ import System.Posix.Unistd (fileSynchroniseDataOnly)
31#else
16#else
32import System.Posix.Unistd (fileSynchronise)
17import System.Posix.Unistd (fileSynchronise)
33#endif
18#endif
34−import System.Posix.IO (handleToFd, closeFd)
19+import System.Posix.IO (handleToFd)
35import Foreign.C
20import Foreign.C
36#endif
21#endif
37
22
38import System.IO (withFile, IOMode(WriteMode), Handle)
23import System.IO (withFile, IOMode(WriteMode), Handle)
39−import qualified Data.ByteString as BS'
24+import qualified Data.ByteString.Lazy as BS
40−import qualified Data.Text.Encoding as TE
41
25
42#if defined(mingw32_HOST_OS)
26#if defined(mingw32_HOST_OS)
43import ProjectM36.Win32Handle
27import ProjectM36.Win32Handle
@@ -47,12 +31,11 @@ foreign import ccall unsafe "cDirectoryFsync" cHSDirectoryFsync :: CString -> IO
47
31
48data DiskSync = NoDiskSync | FsyncDiskSync
32data DiskSync = NoDiskSync | FsyncDiskSync
49
33
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
51−writeFileSync :: DiskSync -> FilePath -> T.Text -> IO()
34+writeFileSync :: DiskSync -> FilePath -> Text -> IO()
52writeFileSync sync path strOut = withFile path WriteMode handler
35writeFileSync sync path strOut = withFile path WriteMode handler
53 where
36 where
54 handler handle = do
37 handler handle = do
55− BS'.hPut handle (TE.encodeUtf8 strOut)
38+ TIO.hPutStr handle strOut
56 syncHandle sync handle
39 syncHandle sync handle
57
40
58renameSync :: DiskSync -> FilePath -> FilePath -> IO ()
41renameSync :: DiskSync -> FilePath -> FilePath -> IO ()
@@ -65,13 +48,7 @@ renameSync sync srcPath dstPath = do
65atomicRename :: FilePath -> FilePath -> IO ()
48atomicRename :: FilePath -> FilePath -> IO ()
66atomicRename srcPath dstPath =
49atomicRename srcPath dstPath =
67#if defined(mingw32_HOST_OS)
50#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
74− Win32.moveFileEx srcPath dst Win32.mOVEFILE_REPLACE_EXISTING
51+ Win32.moveFileEx srcPath dstPath Win32.mOVEFILE_REPLACE_EXISTING
75#else
52#else
76 Posix.rename srcPath dstPath
53 Posix.rename srcPath dstPath
77#endif
54#endif
@@ -81,28 +58,21 @@ syncHandle FsyncDiskSync handle =
81#if defined(mingw32_HOST_OS)
58#if defined(mingw32_HOST_OS)
82 withHandleToHANDLE handle (\h -> Win32.flushFileBuffers h)
59 withHandleToHANDLE handle (\h -> Win32.flushFileBuffers h)
83#elif defined(linux_HOST_OS)
60#elif defined(linux_HOST_OS)
84− do
85 --fdatasync doesn't exist on macOS
61 --fdatasync doesn't exist on macOS
86− fd <- handleToFd handle
87− fileSynchroniseDataOnly fd
62+ handleToFd handle >>= fileSynchroniseDataOnly
88− closeFd fd
89−#else
63+#else
90− do
91− fd <- handleToFd handle
64+ handleToFd handle >>= fileSynchronise
92− fileSynchronise fd
93− closeFd fd
94#endif
65#endif
95−
96syncHandle NoDiskSync _ = pure ()
66syncHandle NoDiskSync _ = pure ()
97
67
98syncDirectory :: DiskSync -> FilePath -> IO ()
68syncDirectory :: DiskSync -> FilePath -> IO ()
99syncDirectory FsyncDiskSync path = directoryFsync path
69syncDirectory FsyncDiskSync path = directoryFsync path
100syncDirectory NoDiskSync _ = pure ()
70syncDirectory NoDiskSync _ = pure ()
101
71
102−writeBSFileSync :: DiskSync -> FilePath -> BS'.ByteString -> IO ()
72+writeBSFileSync :: DiskSync -> FilePath -> BS.ByteString -> IO ()
103writeBSFileSync sync path bstring =
73writeBSFileSync sync path bstring =
104 withFile path WriteMode $ \handle -> do
74 withFile path WriteMode $ \handle -> do
105− BS'.hPut handle bstring
75+ BS.hPut handle bstring
106 syncHandle sync handle
76 syncHandle sync handle
107
77
108directoryFsync :: FilePath -> IO ()
78directoryFsync :: FilePath -> IO ()
@@ -112,22 +82,3 @@ directoryFsync _ = pure () -- on Windows directory metadata cannot be synchroniz
112directoryFsync path = throwErrnoIfMinus1Retry_ "directoryFsync" (withCString path $ \cpath -> cHSDirectoryFsync cpath)
82directoryFsync path = throwErrnoIfMinus1Retry_ "directoryFsync" (withCString path $ \cpath -> cHSDirectoryFsync cpath)
113#endif
83#endif
114
84
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+55−53
@@ -4,9 +4,12 @@ import qualified Data.Set as S
4import qualified Data.HashSet as HS
4import qualified Data.HashSet as HS
5import Control.Monad
5import Control.Monad
6import qualified Data.Vector as V
6import qualified Data.Vector as V
7+import qualified Data.Map as M
8+import ProjectM36.AtomType
7import ProjectM36.Base
9import ProjectM36.Base
8import ProjectM36.Tuple
10import ProjectM36.Tuple
9import qualified ProjectM36.Attribute as A
11import qualified ProjectM36.Attribute as A
12+import qualified ProjectM36.AttributeNames as AS
10import ProjectM36.TupleSet
13import ProjectM36.TupleSet
11import ProjectM36.Error
14import ProjectM36.Error
12--import qualified Control.Parallel.Strategies as P
15--import qualified Control.Parallel.Strategies as P
@@ -34,18 +37,19 @@ atomTypeForName attrName (Relation attrs _) = A.atomTypeForAttributeName attrNam
34
37
35mkRelationFromList :: Attributes -> [[Atom]] -> Either RelationalError Relation
38mkRelationFromList :: Attributes -> [[Atom]] -> Either RelationalError Relation
36mkRelationFromList attrs atomMatrix = do
39mkRelationFromList attrs atomMatrix = do
37− Relation attrs <$> mkTupleSetFromList attrs atomMatrix
40+ tupSet <- mkTupleSetFromList attrs atomMatrix
41+ return $ Relation attrs tupSet
38
42
39emptyRelationWithAttrs :: Attributes -> Relation
43emptyRelationWithAttrs :: Attributes -> Relation
40emptyRelationWithAttrs attrs = Relation attrs emptyTupleSet
44emptyRelationWithAttrs attrs = Relation attrs emptyTupleSet
41
45
42mkRelation :: Attributes -> RelationTupleSet -> Either RelationalError Relation
46mkRelation :: Attributes -> RelationTupleSet -> Either RelationalError Relation
43−mkRelation attrs tupleSet =
47+mkRelation attrs tupleSet =
44− --check that all tuples have the same keys
48+ --check that all tuples have the same keys
45− --check that all tuples have keys (1-N) where N is the attribute count
49+ --check that all tuples have keys (1-N) where N is the attribute count
46− case verifyTupleSet attrs tupleSet of
50+ case verifyTupleSet attrs tupleSet of
47− Left err -> Left err
51+ Left err -> Left err
48− Right verifiedTupleSet -> return $ Relation attrs verifiedTupleSet
52+ Right verifiedTupleSet -> return $ Relation attrs verifiedTupleSet
49
53
50--less safe version of mkRelation skips verifyTupleSet
54--less safe version of mkRelation skips verifyTupleSet
51--useful for infinite or thunked tuple sets
55--useful for infinite or thunked tuple sets
@@ -55,10 +59,6 @@ mkRelationDeferVerify :: Attributes -> RelationTupleSet -> Either RelationalErro
55mkRelationDeferVerify attrs tupleSet = return $ Relation attrs (RelationTupleSet (filter tupleFilter (asList tupleSet)))
59mkRelationDeferVerify attrs tupleSet = return $ Relation attrs (RelationTupleSet (filter tupleFilter (asList tupleSet)))
56 where
60 where
57 tupleFilter tuple = isRight (verifyTuple attrs tuple)
61 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
62
62
63mkRelationFromTuples :: Attributes -> [RelationTuple] -> Either RelationalError Relation
63mkRelationFromTuples :: Attributes -> [RelationTuple] -> Either RelationalError Relation
64mkRelationFromTuples attrs tupleSetList = do
64mkRelationFromTuples attrs tupleSetList = do
@@ -78,7 +78,6 @@ singletonTuple rel@(Relation _ tupleSet) = if cardinality rel == Finite 1 then
78 else
78 else
79 Nothing
79 Nothing
80
80
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)
82union :: Relation -> Relation -> Either RelationalError Relation
81union :: Relation -> Relation -> Either RelationalError Relation
83union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =
82union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =
84 if not (A.attributesEqual attrs1 attrs2)
83 if not (A.attributesEqual attrs1 attrs2)
@@ -86,13 +85,17 @@ union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =
86 else
85 else
87 Right $ Relation attrs1 newtuples
86 Right $ Relation attrs1 newtuples
88 where
87 where
89− newtuples = tupleSetUnion attrs1 tupSet1 tupSet2
88+ newtuples = RelationTupleSet $ HS.toList . HS.fromList $ asList tupSet1 ++ map (reorderTuple attrs1) (asList tupSet2)
90
89
91−project :: S.Set AttributeName -> Relation -> Either RelationalError Relation
90+project :: AttributeNames -> Relation -> Either RelationalError Relation
92−project attrNames rel@(Relation _ tupSet) = do
91+project projectionAttrNames rel =
93− newAttrs <- A.projectionAttributesForNames attrNames (attributes rel)
92+ case AS.projectionAttributesForAttributeNames (attributes rel) projectionAttrNames of
94− newTupleList <- mapM (tupleProject newAttrs) (asList tupSet)
93+ Left err -> Left err
95− pure (Relation newAttrs (RelationTupleSet (HS.toList (HS.fromList newTupleList))))
94+ Right newAttrs -> relFold (folder newAttrs) (Right $ Relation newAttrs emptyTupleSet) rel
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])
96
99
97rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
100rename :: AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
98rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet)
101rename oldAttrName newAttrName rel@(Relation oldAttrs oldTupSet)
@@ -139,14 +142,14 @@ group groupAttrNames newAttrName rel@(Relation oldAttrs tupleSet) = do
139-}
142-}
140
143
141--algorithm: self-join with image relation
144--algorithm: self-join with image relation
142−group :: S.Set AttributeName -> AttributeName -> Relation -> Either RelationalError Relation
145+group :: AttributeNames -> AttributeName -> Relation -> Either RelationalError Relation
143group groupAttrNames newAttrName rel = do
146group groupAttrNames newAttrName rel = do
144− let nonGroupAttrNames = A.nonMatchingAttributeNameSet groupAttrNames (S.fromList (V.toList (A.attributeNames (attributes rel))))
147+ let nonGroupAttrNames = AS.invertAttributeNames groupAttrNames
145− nonGroupProjectionAttributes <- A.projectionAttributesForNames nonGroupAttrNames (attributes rel)
148+ nonGroupProjectionAttributes <- AS.projectionAttributesForAttributeNames (attributes rel) nonGroupAttrNames
146− groupProjectionAttributes <- A.projectionAttributesForNames groupAttrNames (attributes rel)
149+ groupProjectionAttributes <- AS.projectionAttributesForAttributeNames (attributes rel) groupAttrNames
147 let groupAttr = Attribute newAttrName (RelationAtomType groupProjectionAttributes)
150 let groupAttr = Attribute newAttrName (RelationAtomType groupProjectionAttributes)
148 matchingRelTuple tupIn = case imageRelationFor tupIn rel of
151 matchingRelTuple tupIn = case imageRelationFor tupIn rel of
149− Right rel2 -> RelationTuple (A.singleton groupAttr) (V.singleton (RelationAtom rel2))
152+ Right rel2 -> RelationTuple (V.singleton groupAttr) (V.singleton (RelationAtom rel2))
150 Left _ -> undefined
153 Left _ -> undefined
151 mogrifier tupIn = pure (tupleExtend tupIn (matchingRelTuple tupIn))
154 mogrifier tupIn = pure (tupleExtend tupIn (matchingRelTuple tupIn))
152 newAttrs = A.addAttribute groupAttr nonGroupProjectionAttributes
155 newAttrs = A.addAttribute groupAttr nonGroupProjectionAttributes
@@ -160,8 +163,7 @@ restrictEq :: RelationTuple -> Relation -> Either RelationalError Relation
160restrictEq tuple = restrict rfilter
163restrictEq tuple = restrict rfilter
161 where
164 where
162 rfilter :: RelationTuple -> Either RelationalError Bool
165 rfilter :: RelationTuple -> Either RelationalError Bool
163− rfilter tupleIn = do
164− pure (tupleIntersection tuple tupleIn == tuple)
166+ rfilter tupleIn = pure (tupleIntersection tuple tupleIn == tuple)
165
167
166-- unwrap relation-valued attribute
168-- unwrap relation-valued attribute
167-- return error if relval attrs and nongroup attrs overlap
169-- return error if relval attrs and nongroup attrs overlap
@@ -183,13 +185,13 @@ ungroup relvalAttrName rel = case attributesForRelval relvalAttrName rel of
183tupleUngroup :: AttributeName -> Attributes -> RelationTuple -> Either RelationalError Relation
185tupleUngroup :: AttributeName -> Attributes -> RelationTuple -> Either RelationalError Relation
184tupleUngroup relvalAttrName newAttrs tuple = do
186tupleUngroup relvalAttrName newAttrs tuple = do
185 relvalRelation <- relationForAttributeName relvalAttrName tuple
187 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])
192 relFold folder (Right $ Relation newAttrs emptyTupleSet) relvalRelation
188 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])
193
195
194attributesForRelval :: AttributeName -> Relation -> Either RelationalError Attributes
196attributesForRelval :: AttributeName -> Relation -> Either RelationalError Attributes
195attributesForRelval relvalAttrName (Relation attrs _) = do
197attributesForRelval relvalAttrName (Relation attrs _) = do
@@ -214,7 +216,8 @@ join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = do
214 joinedTupSet <- singleTupleSetJoin newAttrs tuple1 tupSet2
216 joinedTupSet <- singleTupleSetJoin newAttrs tuple1 tupSet2
215 return $ joinedTupSet ++ accumulator
217 return $ joinedTupSet ++ accumulator
216 newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)
218 newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)
217− Relation newAttrs <$> mkTupleSet newAttrs newTupSetList
219+ newTupSet <- mkTupleSet newAttrs newTupSetList
220+ return $ Relation newAttrs newTupSet
218
221
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.
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.
220difference :: Relation -> Relation -> Either RelationalError Relation
223difference :: Relation -> Relation -> Either RelationalError Relation
@@ -244,20 +247,12 @@ relMap mapper (Relation attrs tupleSet) =
244
247
245relMogrify :: (RelationTuple -> Either RelationalError RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation
248relMogrify :: (RelationTuple -> Either RelationalError RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation
246relMogrify mapper newAttributes (Relation _ tupSet) = do
249relMogrify mapper newAttributes (Relation _ tupSet) = do
247− newTuples <- mapM (fmap (reorderTuple newAttributes) . mapper) (asList tupSet)
250+ newTuples <- mapM mapper (asList tupSet)
248−
249 mkRelationFromTuples newAttributes newTuples
251 mkRelationFromTuples newAttributes newTuples
250
252
251relFold :: (RelationTuple -> a -> a) -> a -> Relation -> a
253relFold :: (RelationTuple -> a -> a) -> a -> Relation -> a
252relFold folder acc (Relation _ tupleSet) = foldr folder acc (asList tupleSet)
254relFold folder acc (Relation _ tupleSet) = foldr folder acc (asList tupleSet)
253
255
254−-- | Generate a randomly-ordered list of tuples from the relation.
255−toList :: Relation -> IO [RelationTuple]
256−toList rel = do
257− gen <- newStdGen
258− let rel' = evalRand (randomizeTupleOrder rel) gen
259− pure (relFold (:) [] rel')
260−
261--image relation as defined by CJ Date
256--image relation as defined by CJ Date
262--given tupleA and relationB, return restricted relation where tuple attributes are not the attribues in tupleA but are attributes in relationB and match the tuple's value
257--given tupleA and relationB, return restricted relation where tuple attributes are not the attribues in tupleA but are attributes in relationB and match the tuple's value
263
258
@@ -265,7 +260,7 @@ toList rel = do
265imageRelationFor :: RelationTuple -> Relation -> Either RelationalError Relation
260imageRelationFor :: RelationTuple -> Relation -> Either RelationalError Relation
266imageRelationFor matchTuple rel = do
261imageRelationFor matchTuple rel = do
267 restricted <- restrictEq matchTuple rel --restrict across matching tuples
262 restricted <- restrictEq matchTuple rel --restrict across matching tuples
268− let projectionAttrNames = A.nonMatchingAttributeNameSet (attributeNames rel) (tupleAttributeNameSet matchTuple)
263+ let projectionAttrNames = AttributeNames $ A.nonMatchingAttributeNameSet (attributeNames rel) (tupleAttributeNameSet matchTuple)
269 project projectionAttrNames restricted --project across attributes not in rel
264 project projectionAttrNames restricted --project across attributes not in rel
270
265
271--returns a relation-valued attribute image relation for each tuple in rel1
266--returns a relation-valued attribute image relation for each tuple in rel1
@@ -291,22 +286,29 @@ typesAsRelation types = mkRelationFromTuples attrs tuples
291 dConsType = RelationAtomType subAttrs
286 dConsType = RelationAtomType subAttrs
292 tuples = map mkTypeConsDescription types
287 tuples = map mkTypeConsDescription types
293
288
294− mkTypeConsDescription (tCons, dConsList) =
295− RelationTuple attrs (V.fromList [TextAtom (TCD.name tCons), mkDataConsRelation dConsList])
289+ mkTypeConsDescription (tCons, dConsList) = RelationTuple attrs (V.fromList [TextAtom (TCD.name tCons), mkDataConsRelation dConsList])
296
290
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
291 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
298 Left err -> error ("mkRelationFromTuples pooped " ++ show err)
292 Left err -> error ("mkRelationFromTuples pooped " ++ show err)
299 Right rel -> RelationAtom rel
293 Right rel -> RelationAtom rel
294+
295+-- | Return a Relation describing the relation variables.
296+relationVariablesAsRelation :: M.Map RelVarName Relation -> Either RelationalError Relation
297+relationVariablesAsRelation relVarMap = mkRelationFromList attrs tups
298+ where
299+ subrelAttrs = A.attributesFromList [Attribute "attribute" TextAtomType, Attribute "type" TextAtomType]
300+ attrs = A.attributesFromList [Attribute "name" TextAtomType,
301+ Attribute "attributes" (RelationAtomType subrelAttrs)]
302+ tups = map relVarToAtomList (M.toList relVarMap)
303+ relVarToAtomList (rvName, rel) = [TextAtom rvName, attributesToRel (attributes rel)]
304+ attributesToRel attrl = case mkRelationFromList subrelAttrs (map attrAtoms (V.toList attrl)) of
305+ Left err -> error ("relationVariablesAsRelation pooped " ++ show err)
306+ Right rel -> RelationAtom rel
307+ attrAtoms a = [TextAtom (A.attributeName a), TextAtom (prettyAtomType (A.atomType a))]
300
308
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.
309-- | 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.
302randomizeTupleOrder :: MonadRandom m => Relation -> m Relation
310randomizeTupleOrder :: MonadRandom m => Relation -> m Relation
303−randomizeTupleOrder (Relation attrs tupSet) =
311+randomizeTupleOrder (Relation attrs tupSet) = do
304− Relation attrs . RelationTupleSet <$> shuffleM (asList tupSet)
312+ newTupSet <- shuffleM (asList tupSet)
305−
313+ pure (Relation attrs (RelationTupleSet newTupSet))
306−-- returns a tuple from the tupleset- this is useful for priming folds over the tuples
307−oneTuple :: Relation -> Maybe RelationTuple
308−oneTuple (Relation _ (RelationTupleSet [])) = Nothing
309−oneTuple (Relation _ (RelationTupleSet (x:_))) = Just x
310
314
311−tuplesList :: Relation -> [RelationTuple]
312−tuplesList (Relation _ tupleSet) = asList tupleSet
src/lib/ProjectM36/Relation/Parse/CSV.hs+22−133
@@ -1,27 +1,21 @@
1module ProjectM36.Relation.Parse.CSV where
1module ProjectM36.Relation.Parse.CSV where
2--parse Relations from CSV
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
9−
10import Data.Csv.Parser
3import Data.Csv.Parser
11import qualified Data.Vector as V
4import qualified Data.Vector as V
12−import Data.Char (ord, isUpper, isSpace)
5+import Data.Char (ord)
13import qualified Data.ByteString.Lazy as BS
6import qualified Data.ByteString.Lazy as BS
7+import ProjectM36.Base
8+import ProjectM36.Relation
9+import ProjectM36.Error
14import Data.Text.Encoding (decodeUtf8)
10import Data.Text.Encoding (decodeUtf8)
11+import qualified ProjectM36.Attribute as A
15import qualified Data.Set as S
12import qualified Data.Set as S
16−import qualified Data.HashMap.Lazy as HM
13+import Data.HashMap.Lazy as HM
17import qualified Data.List as L
14import qualified Data.List as L
18import qualified Data.Text as T
15import qualified Data.Text as T
19−import qualified Data.Attoparsec.ByteString.Lazy as APBL
16+import Data.Attoparsec.ByteString.Lazy
20−import qualified Data.Attoparsec.Text as APT
17+import ProjectM36.Atom
21import Control.Arrow
18import Control.Arrow
22−import Text.Read hiding (parens)
23−import Control.Applicative
24−import Data.Either
25
19
26data CsvImportError = CsvParseError String |
20data CsvImportError = CsvParseError String |
27 AttributeMappingError RelationalError |
21 AttributeMappingError RelationalError |
@@ -31,22 +25,25 @@ data CsvImportError = CsvParseError String |
31csvDecodeOptions :: DecodeOptions
25csvDecodeOptions :: DecodeOptions
32csvDecodeOptions = DecodeOptions {decDelimiter = fromIntegral (ord ',')}
26csvDecodeOptions = DecodeOptions {decDelimiter = fromIntegral (ord ',')}
33
27
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+
34−csvAsRelation :: Attributes -> TypeConstructorMapping -> BS.ByteString -> Either CsvImportError Relation
35+csvAsRelation :: BS.ByteString -> Attributes -> Either CsvImportError Relation
35−csvAsRelation attrs tConsMap inString = case APBL.parse (csvWithHeader csvDecodeOptions) inString of
36+csvAsRelation inString attrs = case parse (csvWithHeader csvDecodeOptions) inString of
36− APBL.Fail _ _ err -> Left (CsvParseError err)
37+ Fail _ _ err -> Left (CsvParseError err)
37− APBL.Done _ (headerRaw,vecMapsRaw) -> do
38+ Done _ (headerRaw,vecMapsRaw) -> do
38 let strHeader = V.map decodeUtf8 headerRaw
39 let strHeader = V.map decodeUtf8 headerRaw
39 strMapRecords = V.map convertMap vecMapsRaw
40 strMapRecords = V.map convertMap vecMapsRaw
40 convertMap hmap = HM.fromList $ L.map (decodeUtf8 *** (T.unpack . decodeUtf8)) (HM.toList hmap)
41 convertMap hmap = HM.fromList $ L.map (decodeUtf8 *** (T.unpack . decodeUtf8)) (HM.toList hmap)
41− attrNameSet = A.attributeNameSet attrs
42+ attrNames = V.map A.attributeName attrs
43+ attrNameSet = S.fromList (V.toList attrNames)
42 headerSet = S.fromList (V.toList strHeader)
44 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
46 makeTupleList :: HM.HashMap AttributeName String -> [Either CsvImportError Atom]
45 makeTupleList :: HM.HashMap AttributeName String -> [Either CsvImportError Atom]
47− makeTupleList tupMap = V.toList $ V.map (\attr ->
48− either (Left . AttributeMappingError) Right $
49− parseAtom (A.attributeName attr) (A.atomType attr) (T.pack $ tupMap HM.! A.attributeName attr)) (attributesVec attrs)
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
50 if attrNameSet == headerSet then do
47 if attrNameSet == headerSet then do
51 tupleList <- mapM sequence $ V.toList (V.map makeTupleList strMapRecords)
48 tupleList <- mapM sequence $ V.toList (V.map makeTupleList strMapRecords)
52 case mkRelationFromList attrs tupleList of
49 case mkRelationFromList attrs tupleList of
@@ -55,111 +52,3 @@ csvAsRelation attrs tConsMap inString = case APBL.parse (csvWithHeader csvDecode
55 else
52 else
56 Left $ HeaderAttributeMismatchError (S.difference attrNameSet headerSet)
53 Left $ HeaderAttributeMismatchError (S.difference attrNameSet headerSet)
57
54
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+8−6
@@ -1,13 +1,14 @@
1{-# OPTIONS_GHC -fno-warn-orphans #-}
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2module ProjectM36.Relation.Show.CSV where
2module ProjectM36.Relation.Show.CSV where
3import ProjectM36.Base
3import ProjectM36.Base
4−import ProjectM36.Attribute as A
4+import ProjectM36.Attribute
5import Data.Csv
5import Data.Csv
6import ProjectM36.Tuple
6import ProjectM36.Tuple
7import qualified Data.ByteString.Lazy as BS
7import qualified Data.ByteString.Lazy as BS
8import qualified Data.Vector as V
8import qualified Data.Vector as V
9import ProjectM36.Error
9import ProjectM36.Error
10import qualified Data.Text.Encoding as TE
10import qualified Data.Text.Encoding as TE
11+import qualified Data.Text as T
11import ProjectM36.Atom
12import ProjectM36.Atom
12
13
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
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
@@ -17,13 +18,13 @@ relationAsCSV (Relation attrs tupleSet)
17 | relValAttrs /= [] =
18 | relValAttrs /= [] =
18 Left $ RelationValuedAttributesNotSupportedError (map attributeName relValAttrs)
19 Left $ RelationValuedAttributesNotSupportedError (map attributeName relValAttrs)
19 --check that there is at least one attribute
20 --check that there is at least one attribute
20− | A.null attrs =
21+ | V.null attrs =
21 Left $ TupleAttributeCountMismatchError 0
22 Left $ TupleAttributeCountMismatchError 0
22 | otherwise =
23 | otherwise =
23 Right $ encodeByName bsAttrNames $ map RecordRelationTuple (asList tupleSet)
24 Right $ encodeByName bsAttrNames $ map RecordRelationTuple (asList tupleSet)
24 where
25 where
25− relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) (attributesVec attrs)
26+ relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) attrs
26− bsAttrNames = V.map (TE.encodeUtf8 . attributeName) (attributesVec attrs)
27+ bsAttrNames = V.map (TE.encodeUtf8 . attributeName) attrs
27
28
28{-
29{-
29instance ToRecord RelationTuple where
30instance ToRecord RelationTuple where
@@ -36,12 +37,13 @@ instance ToNamedRecord RecordRelationTuple where
36 toNamedRecord rTuple = namedRecord $ map (\(k,v) -> TE.encodeUtf8 k .= RecordAtom v) (tupleAssocs $ unTuple rTuple)
37 toNamedRecord rTuple = namedRecord $ map (\(k,v) -> TE.encodeUtf8 k .= RecordAtom v) (tupleAssocs $ unTuple rTuple)
37
38
38instance DefaultOrdered RecordRelationTuple where
39instance DefaultOrdered RecordRelationTuple where
39− headerOrder (RecordRelationTuple tuple) = V.map (TE.encodeUtf8 . attributeName) (attributesVec (tupleAttributes tuple))
40+ headerOrder (RecordRelationTuple tuple) = V.map (TE.encodeUtf8 . attributeName) (tupleAttributes tuple)
40
41
41newtype RecordAtom = RecordAtom {unAtom :: Atom}
42newtype RecordAtom = RecordAtom {unAtom :: Atom}
42
43
43instance ToField RecordAtom where
44instance ToField RecordAtom where
44− toField (RecordAtom (TextAtom atomVal)) = TE.encodeUtf8 atomVal --without this, CSV text atoms are doubly quoted
45+ toField (RecordAtom (ConstructedAtom dConsName _ atomList)) = TE.encodeUtf8 $ dConsName `T.append` T.intercalate " " (map atomToText atomList)
46+ toField (RecordAtom (TextAtom atomVal)) = TE.encodeUtf8 atomVal --squelch extraneous quotes for text type- the CSV library will add them if necessary
45 toField (RecordAtom atomVal) = (TE.encodeUtf8 . atomToText) atomVal
47 toField (RecordAtom atomVal) = (TE.encodeUtf8 . atomToText) atomVal
46
48
47
49
src/lib/ProjectM36/Relation/Show/Gnuplot.hs+2−2
@@ -23,8 +23,8 @@ data PlotError = InvalidAttributeCountError |
23
23
24--plotRelation :: Relation -> Either PlotError
24--plotRelation :: Relation -> Either PlotError
25
25
26−intFromAtomIndex :: Int -> RelationTuple -> Int --warning- clips or overflows Integer -> Int
26+intFromAtomIndex :: Int -> RelationTuple -> Int
27−intFromAtomIndex index tup = fromIntegral $ castInt $ tupleAtoms tup V.! index
27+intFromAtomIndex index tup = castInt $ tupleAtoms tup V.! index
28
28
29graph1DRelation :: Relation -> Plot2D.T Int Int
29graph1DRelation :: Relation -> Plot2D.T Int Int
30graph1DRelation rel = Plot2D.list Graph2D.listPoints $ points1DRelation rel
30graph1DRelation rel = Plot2D.list Graph2D.listPoints $ points1DRelation rel
src/lib/ProjectM36/Relation/Show/HTML.hs+10−36
@@ -3,44 +3,22 @@ import ProjectM36.Base
3import ProjectM36.Relation
3import ProjectM36.Relation
4import ProjectM36.Tuple
4import ProjectM36.Tuple
5import ProjectM36.Atom
5import ProjectM36.Atom
6−import ProjectM36.Attribute as A
7−import ProjectM36.AtomType
8import qualified Data.List as L
6import qualified Data.List as L
7+import ProjectM36.Attribute
9−import Data.Text (Text, pack)
8+import Data.Text (append, Text, pack)
10import qualified Data.Text as T
9import qualified Data.Text as T
11import qualified Data.Text.IO as TIO
10import qualified Data.Text.IO as TIO
12−#if __GLASGOW_HASKELL__ < 804
13−import Data.Monoid
14−#endif
15
11
16attributesAsHTML :: Attributes -> Text
12attributesAsHTML :: Attributes -> Text
17−attributesAsHTML attrs = "<tr>" <> T.concat (map oneAttrHTML (A.toList attrs)) <> "</tr>"
13+attributesAsHTML attrs = "<tr>" `append` T.concat (map oneAttrHTML attrNameList) `append` "</tr>"
18 where
14 where
19− oneAttrHTML attr = "<th>" <> prettyAttribute attr <> "</th>"
15+ oneAttrHTML attrName = "<th>" `append` attrName `append` "</th>"
16+ attrNameList = sortedAttributeNameList (attributeNameSet attrs)
20
17
21relationAsHTML :: Relation -> Text
18relationAsHTML :: 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
23−relationAsHTML rel@(Relation attrNameSet tupleSet)
19+relationAsHTML rel@(Relation attrNameSet tupleSet) = "<table border=\"1\">" `append` attributesAsHTML attrNameSet `append` tupleSetAsHTML tupleSet `append` "<tfoot>" `append` tablefooter `append` "</tfoot></table>"
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>"
40 where
20 where
41− pm36relcss = "<style>.pm36relation {empty-cells: show;} .pm36relation tbody td, .pm36relation th { border: 1px solid black;}</style>"
42− tablefooter = "<tfoot><tr><td colspan=\"100%\">" <> pack (show (cardinality rel)) <> " tuples</td></tr></tfoot>"
21+ tablefooter = "<tr><td colspan=\"100%\">" `append` pack (show (cardinality rel)) `append` " tuples</td></tr>"
43− tablestart = "<table class=\"pm36relation\"\">"
44
22
45writeHTML :: Text -> IO ()
23writeHTML :: Text -> IO ()
46writeHTML = TIO.writeFile "/home/agentm/rel.html"
24writeHTML = TIO.writeFile "/home/agentm/rel.html"
@@ -49,15 +27,11 @@ writeRel :: Relation -> IO ()
49writeRel = writeHTML . relationAsHTML
27writeRel = writeHTML . relationAsHTML
50
28
51tupleAsHTML :: RelationTuple -> Text
29tupleAsHTML :: RelationTuple -> Text
52−tupleAsHTML tuple = "<tr>" <> T.concat (L.map tupleFrag (tupleAssocs tuple)) <> "</tr>"
30+tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleSortedAssocs tuple)) `append` "</tr>"
53 where
31 where
54− tupleFrag tup = "<td>" <> atomAsHTML (snd tup) <> "</td>"
32+ tupleFrag tup = "<td>" `append` atomToText (snd tup) `append` "</td>"
55− atomAsHTML (RelationAtom rel) = relationAsHTML rel
56− atomAsHTML (TextAtom t) = "&quot;" <> t <> "&quot;"
57− atomAsHTML atom = atomToText atom
58
33
59tupleSetAsHTML :: RelationTupleSet -> Text
34tupleSetAsHTML :: RelationTupleSet -> Text
60tupleSetAsHTML tupSet = foldr folder "" (asList tupSet)
35tupleSetAsHTML tupSet = foldr folder "" (asList tupSet)
61 where
36 where
62− folder tuple acc = acc <> tupleAsHTML tuple
37+ folder tuple acc = acc `append` tupleAsHTML tuple
63−
src/lib/ProjectM36/Relation/Show/Term.hs+21−24
@@ -8,13 +8,8 @@ import ProjectM36.Relation
8import ProjectM36.Attribute hiding (null)
8import ProjectM36.Attribute hiding (null)
9import qualified Data.List as L
9import qualified Data.List as L
10import qualified Data.Text as T
10import qualified Data.Text as T
11+import qualified Data.Vector as V
11import Control.Arrow hiding (left)
12import 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
18
13
19boxV :: StringType
14boxV :: StringType
20boxV = "│"
15boxV = "│"
@@ -42,6 +37,16 @@ boxBB = "┴"
42boxC :: StringType
37boxC :: StringType
43boxC = "┼"
38boxC = "┼"
44
39
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+
45--represent a relation as a table similar to those drawn by Date
50--represent a relation as a table similar to those drawn by Date
46type Cell = StringType
51type Cell = StringType
47type Table = ([Cell], [[Cell]]) --header, body
52type Table = ([Cell], [[Cell]]) --header, body
@@ -73,14 +78,14 @@ cellSizes (header, body) = map (map maxRowWidth &&& map (length . breakLines)) a
73 0
78 0
74 else
79 else
75 L.maximum (lengths row)
80 L.maximum (lengths row)
76− lengths row = map stringDisplayLength (breakLines row)
81+ lengths row = map T.length (breakLines row)
77 allRows = header : body
82 allRows = header : body
78
83
79relationAsTable :: Relation -> Table
84relationAsTable :: Relation -> Table
80relationAsTable rel@(Relation _ tupleSet) = (header, body)
85relationAsTable rel@(Relation _ tupleSet) = (header, body)
81 where
86 where
82− oAttrs = orderedAttributes (attributes rel)
87+ oAttrs = orderedAttributes rel
83− oAttrNames = orderedAttributeNames (attributes rel)
88+ oAttrNames = orderedAttributeNames rel
84 header = map prettyAttribute oAttrs
89 header = map prettyAttribute oAttrs
85 body :: [[Cell]]
90 body :: [[Cell]]
86 body = L.foldl' tupleFolder [] (asList tupleSet)
91 body = L.foldl' tupleFolder [] (asList tupleSet)
@@ -98,8 +103,6 @@ showParens predicate f = if predicate then
98showAtom :: Int -> Atom -> StringType
103showAtom :: Int -> Atom -> StringType
99showAtom _ (RelationAtom rel) = renderTable $ relationAsTable rel
104showAtom _ (RelationAtom rel) = renderTable $ relationAsTable rel
100showAtom level (ConstructedAtom dConsName _ atoms) = showParens (level >= 1 && not (null atoms)) $ T.concat (L.intersperse " " (dConsName : map (showAtom 1) atoms))
105showAtom 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)
103showAtom _ atom = atomToText atom
106showAtom _ atom = atomToText atom
104
107
105renderTable :: Table -> StringType
108renderTable :: Table -> StringType
@@ -118,14 +121,13 @@ renderHeader (header, body) columnLocations = renderTopBar `T.append` renderHead
118renderHBar :: StringType -> StringType -> StringType -> [Int] -> StringType
121renderHBar :: StringType -> StringType -> StringType -> [Int] -> StringType
119renderHBar left middle end columnLocations = left `T.append` T.concat (L.intersperse middle (map (`repeatString` boxH) columnLocations)) `T.append` end
122renderHBar left middle end columnLocations = left `T.append` T.concat (L.intersperse middle (map (`repeatString` boxH) columnLocations)) `T.append` end
120
123
121−--pad a block of potentially multi-lined text
122leftPaddedString :: Int -> Int -> StringType -> StringType
124leftPaddedString :: Int -> Int -> StringType -> StringType
123leftPaddedString lineNum size str = if lineNum > length paddedLines -1 then
125leftPaddedString lineNum size str = if lineNum > length paddedLines -1 then
124 repeatString size " "
126 repeatString size " "
125 else
127 else
126 paddedLines !! lineNum
128 paddedLines !! lineNum
127 where
129 where
128− paddedLines = map (\line -> line `T.append` repeatString (size - stringDisplayLength line) " ") (breakLines str)
130+ paddedLines = map (\line -> line `T.append` repeatString (size - T.length line) " ") (breakLines str)
129
131
130renderRow :: [Cell] -> [Int] -> Int -> StringType -> StringType
132renderRow :: [Cell] -> [Int] -> Int -> StringType -> StringType
131renderRow cells columnLocations rowHeight interspersed = T.unlines $ map renderOneLine [0..rowHeight-1]
133renderRow cells columnLocations rowHeight interspersed = T.unlines $ map renderOneLine [0..rowHeight-1]
@@ -141,19 +143,14 @@ renderBody cellMatrix cellLocs = renderRows `T.append` renderBottomBar
141 rowHeightMatrix = zip cellMatrix (tail rowLocations)
143 rowHeightMatrix = zip cellMatrix (tail rowLocations)
142 renderBottomBar = renderHBar boxBL boxBB boxBR columnLocations
144 renderBottomBar = renderHBar boxBL boxBB boxBR columnLocations
143
145
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+
144repeatString :: Int -> StringType -> StringType
152repeatString :: Int -> StringType -> StringType
145repeatString c s = T.concat (replicate c s)
153repeatString c s = T.concat (replicate c s)
146
154
147showRelation :: Relation -> StringType
155showRelation :: Relation -> StringType
148showRelation rel = renderTable (relationAsTable rel)
156showRelation 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+575−1097
@@ -1,53 +1,32 @@
1{-# LANGUAGE ScopedTypeVariables #-}
1{-# LANGUAGE ScopedTypeVariables #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE OverloadedStrings #-}
5module ProjectM36.RelationalExpression where
2module ProjectM36.RelationalExpression where
6import ProjectM36.Relation
3import ProjectM36.Relation
7import ProjectM36.Tuple
4import ProjectM36.Tuple
8import ProjectM36.TupleSet
5import ProjectM36.TupleSet
9import ProjectM36.Base
6import ProjectM36.Base
10−import qualified Data.UUID as U
11import ProjectM36.Error
7import ProjectM36.Error
12import ProjectM36.AtomType
8import ProjectM36.AtomType
13−import ProjectM36.Attribute (emptyAttributes, attributesFromList)
9+import ProjectM36.Attribute (emptyAttributes)
14import ProjectM36.ScriptSession
10import ProjectM36.ScriptSession
15import ProjectM36.DataTypes.Primitive
11import ProjectM36.DataTypes.Primitive
16import ProjectM36.AtomFunction
12import ProjectM36.AtomFunction
17import ProjectM36.DatabaseContextFunction
13import ProjectM36.DatabaseContextFunction
18−import ProjectM36.Arbitrary
19−import ProjectM36.GraphRefRelationalExpr
20−import ProjectM36.Transaction
21import qualified ProjectM36.Attribute as A
14import qualified ProjectM36.Attribute as A
22import qualified Data.Map as M
15import qualified Data.Map as M
23import qualified Data.HashSet as HS
16import qualified Data.HashSet as HS
24−import qualified Data.Set as S
25import Control.Monad.State hiding (join)
17import Control.Monad.State hiding (join)
26−import Data.Bifunctor (second)
18+import Control.Exception
27import Data.Maybe
19import Data.Maybe
28import Data.Either
20import Data.Either
29import Data.Char (isUpper)
21import Data.Char (isUpper)
30−import Data.Time
31−import qualified Data.List.NonEmpty as NE
32−import Data.Functor.Identity
33import qualified Data.Text as T
22import qualified Data.Text as T
34import qualified Data.Vector as V
23import qualified Data.Vector as V
35import qualified ProjectM36.TypeConstructorDef as TCD
24import qualified ProjectM36.TypeConstructorDef as TCD
36−import qualified Control.Monad.RWS.Strict as RWS
25+import Control.Monad.Trans.Except
37−import Control.Monad.RWS.Strict (RWST, execRWST, runRWST)
38−import Control.Monad.Except hiding (join)
39−import Control.Monad.Trans.Except (except)
26+import Control.Monad.Trans.Reader
40−import Control.Monad.Reader as R hiding (join)
27+
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
47−import GHC hiding (getContext)
28+import GHC
48−import Control.Exception
49import GHC.Paths
29import GHC.Paths
50−#endif
51
30
52data DatabaseContextExprDetails = CountUpdatedTuples
31data DatabaseContextExprDetails = CountUpdatedTuples
53
32
@@ -64,63 +43,32 @@ databaseContextExprDetailsFunc CountUpdatedTuples _ relIn = Relation attrs newTu
64 Right ts -> ts
43 Right ts -> ts
65
44
66-- | Used to start a fresh database state for a new database context expression.
45-- | Used to start a fresh database state for a new database context expression.
67−mkDatabaseContextEvalState :: DatabaseContext -> DatabaseContextEvalState
46+freshDatabaseState :: DatabaseContext -> DatabaseStateElems
68−mkDatabaseContextEvalState context = DatabaseContextEvalState {
69− dbc_context = context,
70− dbc_accum = M.empty,
71− dbc_dirty = False
72− } --future work: propagate return accumulator
47+freshDatabaseState ctx = (ctx, M.empty, False) --future work: propagate return accumulator
73
48
74-- we need to pass around a higher level RelationTuple and Attributes in order to solve #52
49-- we need to pass around a higher level RelationTuple and Attributes in order to solve #52
75−data RelationalExprEnv = RelationalExprEnv {
50+data RelationalExprStateElems = RelationalExprStateTupleElems DatabaseContext RelationTuple | -- used when fully evaluating a relexpr
76− re_context :: DatabaseContext,
51+ RelationalExprStateAttrsElems DatabaseContext Attributes | --used when evaluating the type of a relexpr
77− re_graph :: TransactionGraph,
52+ RelationalExprStateElems DatabaseContext --used by default at the top level of evaluation
78− re_extra :: Maybe (Either RelationTuple Attributes)
53+
79− }
54+instance Show RelationalExprStateElems where
80−
55+ show (RelationalExprStateTupleElems _ tup) = "RelationalExprStateTupleElems " ++ show tup
81−envTuple :: GraphRefRelationalExprEnv -> RelationTuple
56+ show (RelationalExprStateAttrsElems _ attrs) = "RelationalExprStateAttrsElems" ++ show attrs
82−envTuple e = fromLeft emptyTuple (fromMaybe (Left emptyTuple) (gre_extra e))
57+ show (RelationalExprStateElems _) = "RelationalExprStateElems"
83−
58+
84−envAttributes :: GraphRefRelationalExprEnv -> Attributes
59+mkRelationalExprState :: DatabaseContext -> RelationalExprStateElems
85−envAttributes e = fromRight emptyAttributes (fromMaybe (Right emptyAttributes) (gre_extra e))
60+mkRelationalExprState = RelationalExprStateElems
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)
86
67
87−instance Show RelationalExprEnv where
68+mergeAttributesIntoRelationalExprState :: Attributes -> RelationalExprStateElems -> RelationalExprStateElems
88− show e@RelationalExprEnv{} = "RelationalExprEnv " ++ show (re_extra e)
69+mergeAttributesIntoRelationalExprState attrs (RelationalExprStateElems ctx) = RelationalExprStateAttrsElems ctx attrs
89−
70+mergeAttributesIntoRelationalExprState _ st@(RelationalExprStateTupleElems _ _) = st
90−--used to eval relationalexpr
71+mergeAttributesIntoRelationalExprState attrsIn (RelationalExprStateAttrsElems ctx attrs) = RelationalExprStateAttrsElems ctx (A.union attrsIn attrs)
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
72
125type ResultAccumName = StringType
73type ResultAccumName = StringType
126
74
@@ -130,403 +78,415 @@ data ResultAccum = ResultAccum { resultAccumFunc :: ResultAccumFunc,
130 resultAccumResult :: Relation
78 resultAccumResult :: Relation
131 }
79 }
132
80
133−data DatabaseContextEvalState = DatabaseContextEvalState {
134− dbc_context :: DatabaseContext, --new, alterable context for a new transaction
135− dbc_accum :: M.Map ResultAccumName ResultAccum,
81+type DatabaseStateElems = (DatabaseContext, M.Map ResultAccumName ResultAccum, DirtyFlag)
136− dbc_dirty :: DirtyFlag
137− }
138
82
139−data DatabaseContextEvalEnv = DatabaseContextEvalEnv
83+type DatabaseState a = State DatabaseStateElems a
140− { dce_transId :: TransactionId,
141− dce_graph :: TransactionGraph
142− }
143
84
144−mkDatabaseContextEvalEnv :: TransactionId -> TransactionGraph -> DatabaseContextEvalEnv
85+getStateContext :: DatabaseState DatabaseContext
145−mkDatabaseContextEvalEnv = DatabaseContextEvalEnv
86+getStateContext = do
146−
87+ (ctx,_, _) <- get
147−type DatabaseContextEvalMonad a = RWST DatabaseContextEvalEnv () DatabaseContextEvalState (ExceptT RelationalError Identity) a
88+ pure ctx
148−
89+
149−runDatabaseContextEvalMonad :: DatabaseContext -> DatabaseContextEvalEnv -> DatabaseContextEvalMonad () -> Either RelationalError DatabaseContextEvalState
90+putStateContext :: DatabaseContext -> DatabaseState ()
150−runDatabaseContextEvalMonad ctx env m = runIdentity (runExceptT (fst <$> execRWST m env freshEnv))
91+putStateContext ctx = do
151− where
92+ (_, accum, _) <- get
152− freshEnv = mkDatabaseContextEvalState ctx
93+ put (ctx, accum, True)
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
153
152
154−
153+evalRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do
155−dbcTransId :: DatabaseContextEvalMonad TransactionId
154+ currentContext <- fmap stateElemsContext ask
156−dbcTransId = dce_transId <$> RWS.ask
155+ let tConss = typeConstructorMapping currentContext
157−
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
158−dbcGraph :: DatabaseContextEvalMonad TransactionGraph
157+ runExceptT $ do
159−dbcGraph = dce_graph <$> RWS.ask
158+ mAttrs <- case mAttrExprs of
160−
159+ Just _ -> do
161−dbcRelationalExprEnv :: DatabaseContextEvalMonad RelationalExprEnv
160+ attrs <- mapM (either throwE pure . evalAttrExpr tConss) (fromMaybe [] mAttrExprs)
162−dbcRelationalExprEnv =
161+ pure (Just (A.attributesFromList attrs))
163− mkRelationalExprEnv <$> getStateContext <*> dbcGraph
162+ Nothing -> pure Nothing
164−
163+ tuples <- mapM (liftE . evalTupleExpr mAttrs) tupleExprs
165−getStateContext :: DatabaseContextEvalMonad DatabaseContext
164+ let attrs = fromMaybe firstTupleAttrs mAttrs
166−getStateContext = gets dbc_context
165+ firstTupleAttrs = if null tuples then A.emptyAttributes else tupleAttributes (head tuples)
167−
166+ either throwE pure (mkRelation attrs (RelationTupleSet tuples))
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− }
180
167
181−type GraphRefRelationalExprM a = ReaderT GraphRefRelationalExprEnv (ExceptT RelationalError Identity) a
168+evalRelationalExpr (ExistingRelation rel) = pure (Right rel)
182−
169+
183−gfTransForId :: TransactionId -> GraphRefRelationalExprM Transaction
170+evalRelationalExpr (Rename oldAttrName newAttrName relExpr) = do
184−gfTransForId tid = do
171+ evald <- evalRelationalExpr relExpr
185− graph <- gfGraph
172+ case evald of
186− lift $ except $ transactionForId tid graph
173+ Right rel -> return $ rename oldAttrName newAttrName rel
187−
174+ Left err -> return $ Left err
188−gfDatabaseContextForMarker :: GraphRefTransactionMarker -> GraphRefRelationalExprM DatabaseContext
175+
189−gfDatabaseContextForMarker (TransactionMarker transId) = concreteDatabaseContext <$> gfTransForId transId
176+evalRelationalExpr (Group oldAttrNameSet newAttrName relExpr) = do
190−gfDatabaseContextForMarker UncommittedContextMarker = do
177+ evald <- evalRelationalExpr relExpr
191− mctx <- gre_context <$> askEnv
192− case mctx of
178+ case evald of
193− Nothing -> throwError NoUncommittedContextInEvalError
179+ Right rel -> return $ group oldAttrNameSet newAttrName rel
194− Just ctx -> pure ctx
180+ Left err -> return $ Left err
195−
181+
196−runGraphRefRelationalExprM :: GraphRefRelationalExprEnv -> GraphRefRelationalExprM a -> Either RelationalError a
182+evalRelationalExpr (Ungroup attrName relExpr) = do
197−runGraphRefRelationalExprM env m = runIdentity (runExceptT (runReaderT m env))
183+ evald <- evalRelationalExpr relExpr
198−
184+ case evald of
199−freshGraphRefRelationalExprEnv :: Maybe DatabaseContext -> TransactionGraph -> GraphRefRelationalExprEnv
185+ Right rel -> return $ ungroup attrName rel
200−freshGraphRefRelationalExprEnv mctx graph = GraphRefRelationalExprEnv {
186+ Left err -> return $ Left err
201− gre_context = mctx,
187+
202− gre_graph = graph,
188+evalRelationalExpr (Restrict predicateExpr relExpr) = do
203− gre_extra = Nothing
189+ evald <- evalRelationalExpr relExpr
204− }
190+ case evald of
205−
191+ Left err -> return $ Left err
206−gfGraph :: GraphRefRelationalExprM TransactionGraph
192+ Right rel -> do
207−gfGraph = asks gre_graph
193+ eFilterFunc <- predicateRestrictionFilter (attributes rel) predicateExpr
208−
194+ case eFilterFunc of
209−envContext :: RelationalExprEnv -> DatabaseContext
195+ Left err -> return $ Left err
210−envContext = re_context
196+ Right filterfunc ->
211−
197+ pure (restrict filterfunc rel)
212−setEnvContext :: RelationalExprEnv -> DatabaseContext -> RelationalExprEnv
198+
213−setEnvContext e ctx = e { re_context = ctx }
199+evalRelationalExpr (Equals relExprA relExprB) = do
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
214
229
215--helper function to process relation variable creation/assignment
230--helper function to process relation variable creation/assignment
216−setRelVar :: RelVarName -> GraphRefRelationalExpr -> DatabaseContextEvalMonad ()
231+setRelVar :: RelVarName -> Relation -> DatabaseState (Maybe RelationalError)
217−setRelVar relVarName relExpr = do
232+setRelVar relVarName rel = do
218 currentContext <- getStateContext
233 currentContext <- getStateContext
219− --prevent recursive relvar definition by resolving references to relvars in previous states
220− relExpr' <- resolve relExpr
221− let newRelVars = M.insert relVarName relExpr' $ relationVariables currentContext
234+ let newRelVars = M.insert relVarName rel $ relationVariables currentContext
222 potentialContext = currentContext { relationVariables = newRelVars }
235 potentialContext = currentContext { relationVariables = newRelVars }
223− --optimization: if the relexpr is unchanged, skip the update
236+
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
230− case checkConstraints potentialContext tid graph of
237+ case checkConstraints potentialContext of
231− Left err -> dbErr err
238+ Just err -> return $ Just err
239+ Nothing -> do
232− Right _ -> putStateContext potentialContext
240+ putStateContext potentialContext
233−
241+ return Nothing
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 ()
236
242
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
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
238−deleteRelVar :: RelVarName -> DatabaseContextEvalMonad ()
244+deleteRelVar :: RelVarName -> DatabaseState (Maybe RelationalError)
239deleteRelVar relVarName = do
245deleteRelVar relVarName = do
240 currContext <- getStateContext
246 currContext <- getStateContext
241 let relVars = relationVariables currContext
247 let relVars = relationVariables currContext
242 if M.notMember relVarName relVars then
248 if M.notMember relVarName relVars then
243− pure ()
249+ pure Nothing
244 else do
250 else do
245 let newRelVars = M.delete relVarName relVars
251 let newRelVars = M.delete relVarName relVars
246 newContext = currContext { relationVariables = newRelVars }
252 newContext = currContext { relationVariables = newRelVars }
247 putStateContext newContext
253 putStateContext newContext
248− pure ()
254+ pure Nothing
249
255
250−evalGraphRefDatabaseContextExpr :: GraphRefDatabaseContextExpr -> DatabaseContextEvalMonad ()
256+evalDatabaseContextExpr :: DatabaseContextExpr -> DatabaseState (Maybe RelationalError)
251−evalGraphRefDatabaseContextExpr NoOperation = pure ()
257+evalDatabaseContextExpr NoOperation = pure Nothing
252
258
253−evalGraphRefDatabaseContextExpr (Define relVarName attrExprs) = do
259+evalDatabaseContextExpr (Define relVarName attrExprs) = do
254− context <- getStateContext
255 relvars <- fmap relationVariables getStateContext
260 relvars <- fmap relationVariables getStateContext
256 tConss <- fmap typeConstructorMapping getStateContext
261 tConss <- fmap typeConstructorMapping getStateContext
257− graph <- dbcGraph
262+ let eAttrs = map (evalAttrExpr tConss) attrExprs
258− let eAttrs = runGraphRefRelationalExprM gfEnv (mapM evalGraphRefAttrExpr attrExprs)
263+ case lefts eAttrs of
259− gfEnv = freshGraphRefRelationalExprEnv (Just context) graph
264+ err:_ -> pure (Just err)
260− case eAttrs of
261− Left err -> dbErr err
262− Right attrsList -> do
263− lift $ except $ validateAttributes tConss (A.attributesFromList attrsList)
264− case M.member relVarName relvars of
265+ [] -> case M.member relVarName relvars of
265− True -> dbErr (RelVarAlreadyDefinedError relVarName)
266+ True -> return (Just (RelVarAlreadyDefinedError relVarName))
266− False -> setRelVar relVarName (ExistingRelation emptyRelation)
267+ False -> setRelVar relVarName emptyRelation >> pure Nothing
267− where
268+ where
268− attrs = A.attributesFromList attrsList
269+ attrs = A.attributesFromList (rights eAttrs)
269− emptyRelation = Relation attrs emptyTupleSet
270+ emptyRelation = Relation attrs emptyTupleSet
270−
271+
271−evalGraphRefDatabaseContextExpr (Undefine relVarName) = deleteRelVar relVarName
272+evalDatabaseContextExpr (Undefine relVarName) = deleteRelVar relVarName
272−
273+
273−evalGraphRefDatabaseContextExpr (Assign relVarName expr) = do
274+evalDatabaseContextExpr (Assign relVarName expr) = do
274− graph <- re_graph <$> dbcRelationalExprEnv
275+ -- in the future, it would be nice to get types from the RelationalExpr instead of needing to evaluate it
275 context <- getStateContext
276 context <- getStateContext
276− let existingRelVar = M.lookup relVarName (relationVariables context)
277+ let existingRelVar = M.lookup relVarName relVarTable
277− reEnv = freshGraphRefRelationalExprEnv (Just context) graph
278+ relVarTable = relationVariables context
278− eNewExprType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr)
279+ value = runReader (evalRelationalExpr expr) (RelationalExprStateElems context)
279− case existingRelVar of
280+ case value of
280− Nothing -> do
281− case runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr expr) of
282− Left err -> dbErr err
281+ Left err -> return $ Just err
283− Right reltype -> do
282+ Right rel -> case existingRelVar of
284− lift $ except $ validateAttributes (typeConstructorMapping context) (attributes reltype)
285− setRelVar relVarName expr
283+ Nothing -> setRelVar relVarName rel
286− Just existingRel -> do
284+ Just existingRel -> let expectedAttributes = attributes existingRel
287− let eExpectedType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr existingRel)
285+ foundAttributes = attributes rel in
288− case eExpectedType of
286+ if A.attributesEqual expectedAttributes foundAttributes then
289− Left err -> dbErr err
290− Right expectedType ->
291− case eNewExprType of
292− Left err -> dbErr err
293− Right newExprType -> do
294− if newExprType == expectedType then do
295− lift $ except $ validateAttributes (typeConstructorMapping context) (attributes newExprType)
296− setRelVar relVarName expr
287+ setRelVar relVarName rel
297− else
288+ else
298− dbErr (RelationTypeMismatchError (attributes expectedType) (attributes newExprType))
289+ return $ Just (RelVarAssignmentTypeMismatchError expectedAttributes foundAttributes)
299−
290+
300−evalGraphRefDatabaseContextExpr (Insert relVarName relExpr) = do
291+evalDatabaseContextExpr (Insert relVarName relExpr) = do
301− gfExpr <- relVarByName relVarName
292+ context <- getStateContext
302− let optExpr = applyUnionCollapse (Union
303− relExpr
293+ let unionexp = Union relExpr rv
304− gfExpr)
294+ rv = RelationVariable relVarName ()
305− evalGraphRefDatabaseContextExpr (Assign relVarName optExpr)
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
308+ let rv = RelationVariable relVarName ()
309+ let updatedRel = runReader (evalRelationalExpr (Restrict (NotPredicate predicate) rv)) (RelationalExprStateElems context)
310+ origRel = runReader (evalRelationalExpr rv) (RelationalExprStateElems context)
311+ case updatedRel of
312+ Left err -> pure (Just err)
313+ Right updatedRel' -> case origRel of
314+ Left err -> pure (Just err)
315+ Right origRel' -> if cardinality origRel' == cardinality updatedRel' then
316+ pure Nothing
317+ else
318+ setRelVar relVarName updatedRel'
306
319
307−evalGraphRefDatabaseContextExpr (Delete relVarName predicate) = do
308− gfExpr <- relVarByName relVarName
309− let optExpr = applyRestrictionCollapse (Restrict (NotPredicate predicate) gfExpr)
310− setRelVar relVarName optExpr
311−
312--union of restricted+updated portion and the unrestricted+unupdated portion
320--union of restricted+updated portion and the unrestricted+unupdated portion
313−evalGraphRefDatabaseContextExpr (Update relVarName atomExprMap pred') = do
321+evalDatabaseContextExpr (Update relVarName atomExprMap restrictionPredicateExpr) = do
314− rvExpr <- relVarByName relVarName
315− graph <- re_graph <$> dbcRelationalExprEnv
316 context <- getStateContext
322 context <- getStateContext
317− let reEnv = freshGraphRefRelationalExprEnv (Just context) graph
323+ let relVarTable = relationVariables context
318− --get the current attributes name in the relvar to ensure that we don't conflict when renaming
324+ case M.lookup relVarName relVarTable of
319− eExprType = runGraphRefRelationalExprM reEnv (typeForGraphRefRelationalExpr rvExpr)
325+ Nothing -> return $ Just (RelVarNotDefinedError relVarName)
320− exprType' <- case eExprType of
326+ Just rel ->
327+ case runReader (predicateRestrictionFilter (attributes rel) restrictionPredicateExpr) (RelationalExprStateElems context) of
321− Left err -> throwError err
328+ Left err -> return $ Just err
322− Right t -> pure t
329+ Right predicateFunc -> do
323− let unrestrictedPortion = Restrict (NotPredicate pred') rvExpr
330+ let ret = do
324− tmpAttr = tmpAttrC 1
331+ restrictedPortion <- restrict predicateFunc rel
325− tmpAttrC :: Int -> AttributeName -> AttributeName
332+ if cardinality restrictedPortion == Finite 0 then
326− tmpAttrC c attr =
333+ pure Nothing
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
330− else
334+ else do
331− tmpAttrName
335+ unrestrictedPortion <- restrict (predicateFunc >=> (pure . not)) rel
332− updateAttr nam atomExpr = Extend (AttributeExtendTupleExpr (tmpAttr nam) atomExpr)
336+ updatedPortion <- relMap (updateTupleWithAtomExprs atomExprMap context) restrictedPortion
333− projectAndRename attr expr = Rename (tmpAttr attr) attr (Project (InvertedAttributeNames (S.singleton attr)) expr)
337+ updatedRel <- updatedPortion `union` unrestrictedPortion
334− restrictedPortion = Restrict pred' rvExpr
338+ pure (Just updatedRel)
335− updated = foldr (\(oldname, atomExpr) accum ->
339+ case ret of
336− let procAtomExpr = runProcessExprM UncommittedContextMarker (processAtomExpr atomExpr) in
340+ Left err -> pure (Just err)
337− updateAttr oldname procAtomExpr accum
341+ Right Nothing -> pure Nothing
338− ) restrictedPortion (M.toList atomExprMap)
342+ Right (Just updatedRel) -> setRelVar relVarName updatedRel
339− -- the atomExprMap could reference other attributes, so we must perform multi-pass folds
343+
340− updatedPortion = foldr projectAndRename updated (M.keys atomExprMap)
341− setRelVar relVarName (Union unrestrictedPortion updatedPortion)
342−
343−evalGraphRefDatabaseContextExpr (AddInclusionDependency newDepName newDep) = do
344+evalDatabaseContextExpr (AddInclusionDependency newDepName newDep) = do
344 currContext <- getStateContext
345 currContext <- getStateContext
345− transId <- dbcTransId
346− graph <- dbcGraph
347 let currDeps = inclusionDependencies currContext
346 let currDeps = inclusionDependencies currContext
348 newDeps = M.insert newDepName newDep currDeps
347 newDeps = M.insert newDepName newDep currDeps
349 if M.member newDepName currDeps then
348 if M.member newDepName currDeps then
350− dbErr (InclusionDependencyNameInUseError newDepName)
349+ return $ Just (InclusionDependencyNameInUseError newDepName)
351 else do
350 else do
352 let potentialContext = currContext { inclusionDependencies = newDeps }
351 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
355− case checkConstraints potentialContext transId graph of
352+ case checkConstraints potentialContext of
356− Left err -> dbErr err
353+ Just err -> return $ Just err
357− Right _ ->
354+ Nothing -> do
358 putStateContext potentialContext
355 putStateContext potentialContext
356+ return Nothing
359
357
360−evalGraphRefDatabaseContextExpr (RemoveInclusionDependency depName) = do
358+evalDatabaseContextExpr (RemoveInclusionDependency depName) = do
361 currContext <- getStateContext
359 currContext <- getStateContext
362 let currDeps = inclusionDependencies currContext
360 let currDeps = inclusionDependencies currContext
363 newDeps = M.delete depName currDeps
361 newDeps = M.delete depName currDeps
364 if M.notMember depName currDeps then
362 if M.notMember depName currDeps then
365− dbErr (InclusionDependencyNameNotInUseError depName)
363+ return $ Just (InclusionDependencyNameNotInUseError depName)
366− else
364+ else do
367 putStateContext $ currContext {inclusionDependencies = newDeps }
365 putStateContext $ currContext {inclusionDependencies = newDeps }
366+ return Nothing
368
367
369-- | Add a notification which will send the resultExpr when triggerExpr changes between commits.
368-- | Add a notification which will send the resultExpr when triggerExpr changes between commits.
370−evalGraphRefDatabaseContextExpr (AddNotification notName triggerExpr resultOldExpr resultNewExpr) = do
369+evalDatabaseContextExpr (AddNotification notName triggerExpr resultExpr) = do
371 currentContext <- getStateContext
370 currentContext <- getStateContext
372 let nots = notifications currentContext
371 let nots = notifications currentContext
373 if M.member notName nots then
372 if M.member notName nots then
374− dbErr (NotificationNameInUseError notName)
373+ return $ Just (NotificationNameInUseError notName)
375 else do
374 else do
376 let newNotifications = M.insert notName newNotification nots
375 let newNotifications = M.insert notName newNotification nots
377 newNotification = Notification { changeExpr = triggerExpr,
376 newNotification = Notification { changeExpr = triggerExpr,
378− reportOldExpr = resultOldExpr,
377+ reportExpr = resultExpr }
379− reportNewExpr = resultNewExpr}
380 putStateContext $ currentContext { notifications = newNotifications }
378 putStateContext $ currentContext { notifications = newNotifications }
379+ return Nothing
381
380
382−evalGraphRefDatabaseContextExpr (RemoveNotification notName) = do
381+evalDatabaseContextExpr (RemoveNotification notName) = do
383 currentContext <- getStateContext
382 currentContext <- getStateContext
384 let nots = notifications currentContext
383 let nots = notifications currentContext
385 if M.notMember notName nots then
384 if M.notMember notName nots then
386− dbErr (NotificationNameNotInUseError notName)
385+ return $ Just (NotificationNameNotInUseError notName)
387 else do
386 else do
388 let newNotifications = M.delete notName nots
387 let newNotifications = M.delete notName nots
389 putStateContext $ currentContext { notifications = newNotifications }
388 putStateContext $ currentContext { notifications = newNotifications }
390−
389+ return Nothing
391
390
392-- | Adds type and data constructors to the database context.
391-- | Adds type and data constructors to the database context.
393-- validate that the type *and* constructor names are unique! not yet implemented!
392-- validate that the type *and* constructor names are unique! not yet implemented!
394−evalGraphRefDatabaseContextExpr (AddTypeConstructor tConsDef dConsDefList) = do
393+evalDatabaseContextExpr (AddTypeConstructor tConsDef dConsDefList) = do
395 currentContext <- getStateContext
394 currentContext <- getStateContext
396 let oldTypes = typeConstructorMapping currentContext
395 let oldTypes = typeConstructorMapping currentContext
397 tConsName = TCD.name tConsDef
396 tConsName = TCD.name tConsDef
398 -- validate that the constructor's types exist
397 -- validate that the constructor's types exist
399− case validateTypeConstructorDef tConsDef dConsDefList oldTypes of
398+ case validateTypeConstructorDef tConsDef dConsDefList of
400− Left err -> throwError err
399+ errs@(_:_) -> pure $ Just (someErrors errs)
401− Right () | T.null tConsName || not (isUpper (T.head tConsName)) -> dbErr (InvalidAtomTypeName tConsName)
400+ [] | T.null tConsName || not (isUpper (T.head tConsName)) -> pure $ Just (InvalidAtomTypeName tConsName)
402− | isJust (findTypeConstructor tConsName oldTypes) -> dbErr (AtomTypeNameInUseError tConsName)
401+ | isJust (findTypeConstructor tConsName oldTypes) -> pure $ Just (AtomTypeNameInUseError tConsName)
403− | otherwise -> do
402+ | otherwise -> do
404 let newTypes = oldTypes ++ [(tConsDef, dConsDefList)]
403 let newTypes = oldTypes ++ [(tConsDef, dConsDefList)]
405 putStateContext $ currentContext { typeConstructorMapping = newTypes }
404 putStateContext $ currentContext { typeConstructorMapping = newTypes }
405+ pure Nothing
406
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.
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−evalGraphRefDatabaseContextExpr (RemoveTypeConstructor tConsName) = do
408+evalDatabaseContextExpr (RemoveTypeConstructor tConsName) = do
409 currentContext <- getStateContext
409 currentContext <- getStateContext
410 let oldTypes = typeConstructorMapping currentContext
410 let oldTypes = typeConstructorMapping currentContext
411 if isNothing (findTypeConstructor tConsName oldTypes) then
411 if isNothing (findTypeConstructor tConsName oldTypes) then
412− dbErr (AtomTypeNameNotInUseError tConsName)
412+ pure $ Just (AtomTypeNameNotInUseError tConsName)
413 else do
413 else do
414 let newTypes = filter (\(tCons, _) -> TCD.name tCons /= tConsName) oldTypes
414 let newTypes = filter (\(tCons, _) -> TCD.name tCons /= tConsName) oldTypes
415 putStateContext $ currentContext { typeConstructorMapping = newTypes }
415 putStateContext $ currentContext { typeConstructorMapping = newTypes }
416+ pure Nothing
416
417
417−evalGraphRefDatabaseContextExpr (MultipleExpr exprs) =
418+evalDatabaseContextExpr (MultipleExpr exprs) = do
418 --the multiple expressions must pass the same context around- not the old unmodified context
419 --the multiple expressions must pass the same context around- not the old unmodified context
419− mapM_ evalGraphRefDatabaseContextExpr exprs
420+ evald <- forM exprs evalDatabaseContextExpr
420−
421+ --some lifting magic needed here
422+ case catMaybes evald of
423+ [] -> pure Nothing
424+ err:_ -> pure (Just err)
425+
421−evalGraphRefDatabaseContextExpr (RemoveAtomFunction funcName) = do
426+evalDatabaseContextExpr (RemoveAtomFunction funcName) = do
422 currentContext <- getStateContext
427 currentContext <- getStateContext
423 let atomFuncs = atomFunctions currentContext
428 let atomFuncs = atomFunctions currentContext
424 case atomFunctionForName funcName atomFuncs of
429 case atomFunctionForName funcName atomFuncs of
425− Left err -> dbErr err
430+ Left err -> pure (Just err)
426− Right realFunc ->
427− if isScriptedAtomFunction realFunc then do
431+ Right realFunc -> if isScriptedAtomFunction realFunc then do
428− let updatedFuncs = HS.delete realFunc atomFuncs
432+ let updatedFuncs = HS.delete realFunc atomFuncs
429− putStateContext (currentContext {atomFunctions = updatedFuncs })
433+ putStateContext (currentContext {atomFunctions = updatedFuncs })
434+ pure Nothing
430− else
435+ else
431− dbErr (PrecompiledFunctionRemoveError funcName)
436+ pure (Just (PrecompiledFunctionRemoveError funcName))
437+
432
438
433−evalGraphRefDatabaseContextExpr (RemoveDatabaseContextFunction funcName) = do
439+evalDatabaseContextExpr (RemoveDatabaseContextFunction funcName) = do
434 context <- getStateContext
440 context <- getStateContext
435 let dbcFuncs = dbcFunctions context
441 let dbcFuncs = dbcFunctions context
436 case databaseContextFunctionForName funcName dbcFuncs of
442 case databaseContextFunctionForName funcName dbcFuncs of
437− Left err -> dbErr err
443+ Left err -> pure (Just err)
438− Right realFunc ->
439− if isScriptedDatabaseContextFunction realFunc then do
444+ Right realFunc -> if isScriptedDatabaseContextFunction realFunc then do
440− let updatedFuncs = HS.delete realFunc dbcFuncs
445+ let updatedFuncs = HS.delete realFunc dbcFuncs
441− putStateContext (context { dbcFunctions = updatedFuncs })
446+ putStateContext (context { dbcFunctions = updatedFuncs })
447+ pure Nothing
442− else
448+ else
443− dbErr (PrecompiledFunctionRemoveError funcName)
449+ pure (Just (PrecompiledFunctionRemoveError funcName))
444
450
445−evalGraphRefDatabaseContextExpr (ExecuteDatabaseContextFunction funcName atomArgExprs) = do
451+evalDatabaseContextExpr (ExecuteDatabaseContextFunction funcName atomArgExprs) = do
446 context <- getStateContext
452 context <- getStateContext
447− graph <- dbcGraph
448 --resolve atom arguments
453 --resolve atom arguments
449− let eAtomTypes = mapM (runGraphRefRelationalExprM gfEnv . typeForGraphRefAtomExpr emptyAttributes) atomArgExprs
454+ let relExprState = mkRelationalExprState context
455+ eAtomTypes = map (\atomExpr -> runReader (typeFromAtomExpr emptyAttributes atomExpr) relExprState) atomArgExprs
450 eFunc = databaseContextFunctionForName funcName (dbcFunctions context)
456 eFunc = databaseContextFunctionForName funcName (dbcFunctions context)
451− gfEnv = freshGraphRefRelationalExprEnv (Just context) graph
452 case eFunc of
457 case eFunc of
453− Left err -> dbErr err
458+ Left err -> pure (Just err)
454 Right func -> do
459 Right func -> do
455 let expectedArgCount = length (dbcFuncType func)
460 let expectedArgCount = length (dbcFuncType func)
456 actualArgCount = length atomArgExprs
461 actualArgCount = length atomArgExprs
457 if expectedArgCount /= actualArgCount then
462 if expectedArgCount /= actualArgCount then
458− dbErr (FunctionArgumentCountMismatchError expectedArgCount actualArgCount)
463+ pure (Just (FunctionArgumentCountMismatch expectedArgCount actualArgCount))
459 else
464 else
460 --check that the atom types are valid
465 --check that the atom types are valid
461− case eAtomTypes of
466+ case lefts eAtomTypes of
462− Left err -> dbErr err
467+ _:_ -> pure (Just (someErrors (lefts eAtomTypes)))
463− Right atomTypes -> do
468+ [] -> do
464− let mValidTypes = zipWith (\ expType actType
469+ let atomTypes = rights eAtomTypes
465− -> case atomTypeVerify expType actType of
470+ let mValidTypes = map (\(expType, actType) -> case atomTypeVerify expType actType of
466− Left err -> Just err
471+ Left err -> Just err
467− Right _ -> Nothing)
468− (dbcFuncType func) atomTypes
472+ Right _ -> Nothing) (zip (dbcFuncType func) atomTypes)
469− typeErrors = catMaybes mValidTypes
473+ typeErrors = catMaybes mValidTypes
470− eAtomArgs = map (runGraphRefRelationalExprM gfEnv . evalGraphRefAtomExpr emptyTuple) atomArgExprs
474+ eAtomArgs = map (\arg -> runReader (evalAtomExpr emptyTuple arg) relExprState) atomArgExprs
471 if length (lefts eAtomArgs) > 1 then
475 if length (lefts eAtomArgs) > 1 then
472− dbErr (someErrors (lefts eAtomArgs))
476+ pure (Just (someErrors (lefts eAtomArgs)))
473 else if not (null typeErrors) then
477 else if not (null typeErrors) then
474− dbErr (someErrors typeErrors)
478+ pure (Just (someErrors typeErrors))
475 else
479 else
476 case evalDatabaseContextFunction func (rights eAtomArgs) context of
480 case evalDatabaseContextFunction func (rights eAtomArgs) context of
477− Left err -> dbErr err
481+ Left err -> pure (Just err)
478− Right newContext -> putStateContext newContext
482+ Right newContext -> putStateContext newContext >> pure Nothing
479−data DatabaseContextIOEvalEnv = DatabaseContextIOEvalEnv
483+
480− { dbcio_transId :: TransactionId,
484+evalDatabaseContextIOExpr :: Maybe ScriptSession -> DatabaseContext -> DatabaseContextIOExpr -> IO (Either RelationalError DatabaseContext)
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
523−evalGraphRefDatabaseContextIOExpr (AddAtomFunction funcName funcType script) = do
485+evalDatabaseContextIOExpr mScriptSession currentContext (AddAtomFunction funcName funcType script) =
524− eScriptSession <- requireScriptSession
486+ case mScriptSession of
525− currentContext <- getDBCIOContext
487+ Nothing -> pure (Left (ScriptError ScriptCompilationDisabledError))
526− case eScriptSession of
527− Left err -> pure (Left err)
528− Right scriptSession -> do
488+ Just scriptSession -> do
529− res <- liftIO $ try $ runGhc (Just libdir) $ do
489+ res <- try $ runGhc (Just libdir) $ do
530 setSession (hscEnv scriptSession)
490 setSession (hscEnv scriptSession)
531 let atomFuncs = atomFunctions currentContext
491 let atomFuncs = atomFunctions currentContext
532 case extractAtomFunctionType funcType of
492 case extractAtomFunctionType funcType of
@@ -537,7 +497,7 @@ evalGraphRefDatabaseContextIOExpr (AddAtomFunction funcName funcType script) = d
537 pure $ case eCompiledFunc of
497 pure $ case eCompiledFunc of
538 Left err -> Left (ScriptError err)
498 Left err -> Left (ScriptError err)
539 Right compiledFunc -> do
499 Right compiledFunc -> do
540− funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructorValidate False funcTypeArg (typeConstructorMapping currentContext) M.empty) adjustedAtomTypeCons
500+ funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructor funcTypeArg (typeConstructorMapping currentContext)) adjustedAtomTypeCons
541 let updatedFuncs = HS.insert newAtomFunc atomFuncs
501 let updatedFuncs = HS.insert newAtomFunc atomFuncs
542 newContext = currentContext { atomFunctions = updatedFuncs }
502 newContext = currentContext { atomFunctions = updatedFuncs }
543 newAtomFunc = AtomFunction { atomFuncName = funcName,
503 newAtomFunc = AtomFunction { atomFuncName = funcName,
@@ -552,13 +512,12 @@ evalGraphRefDatabaseContextIOExpr (AddAtomFunction funcName funcType script) = d
552 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))
512 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))
553 Right eContext -> case eContext of
513 Right eContext -> case eContext of
554 Left err -> pure (Left err)
514 Left err -> pure (Left err)
555− Right context' -> putDBCIOContext context'
515+ Right context' -> pure (Right context')
516+
556−evalGraphRefDatabaseContextIOExpr (AddDatabaseContextFunction funcName funcType script) = do
517+evalDatabaseContextIOExpr mScriptSession currentContext (AddDatabaseContextFunction funcName funcType script) =
557− eScriptSession <- requireScriptSession
518+ case mScriptSession of
558− currentContext <- getDBCIOContext
519+ Nothing -> pure (Left (ScriptError ScriptCompilationDisabledError))
559− case eScriptSession of
560− Left err -> pure (Left err)
561− Right scriptSession -> do
520+ Just scriptSession -> do
562 --validate that the function signature is of the form x -> y -> ... -> DatabaseContext -> DatabaseContext
521 --validate that the function signature is of the form x -> y -> ... -> DatabaseContext -> DatabaseContext
563 let last2Args = reverse (take 2 (reverse funcType))
522 let last2Args = reverse (take 2 (reverse funcType))
564 atomArgs = take (length funcType - 2) funcType
523 atomArgs = take (length funcType - 2) funcType
@@ -568,14 +527,14 @@ evalGraphRefDatabaseContextIOExpr (AddDatabaseContextFunction funcName funcType
568 if last2Args /= [ADTypeConstructor "DatabaseContext" [], dbContextTypeCons] then
527 if last2Args /= [ADTypeConstructor "DatabaseContext" [], dbContextTypeCons] then
569 pure (Left (ScriptError (TypeCheckCompilationError expectedType actualType)))
528 pure (Left (ScriptError (TypeCheckCompilationError expectedType actualType)))
570 else do
529 else do
571− res <- liftIO $ try $ runGhc (Just libdir) $ do
530+ res <- try $ runGhc (Just libdir) $ do
572 setSession (hscEnv scriptSession)
531 setSession (hscEnv scriptSession)
573 eCompiledFunc <- compileScript (dbcFunctionBodyType scriptSession) script
532 eCompiledFunc <- compileScript (dbcFunctionBodyType scriptSession) script
574 pure $ case eCompiledFunc of
533 pure $ case eCompiledFunc of
575 Left err -> Left (ScriptError err)
534 Left err -> Left (ScriptError err)
576 Right compiledFunc -> do
535 Right compiledFunc -> do
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
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
578− funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructor funcTypeArg (typeConstructorMapping currentContext) M.empty) atomArgs
537+ funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructor funcTypeArg (typeConstructorMapping currentContext)) atomArgs
579 let updatedDBCFuncs = HS.insert newDBCFunc (dbcFunctions currentContext)
538 let updatedDBCFuncs = HS.insert newDBCFunc (dbcFunctions currentContext)
580 newContext = currentContext { dbcFunctions = updatedDBCFuncs }
539 newContext = currentContext { dbcFunctions = updatedDBCFuncs }
581 dbcFuncs = dbcFunctions currentContext
540 dbcFuncs = dbcFunctions currentContext
@@ -593,170 +552,123 @@ evalGraphRefDatabaseContextIOExpr (AddDatabaseContextFunction funcName funcType
593 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))
552 Left (exc :: SomeException) -> pure $ Left (ScriptError (OtherScriptCompilationError (show exc)))
594 Right eContext -> case eContext of
553 Right eContext -> case eContext of
595 Left err -> pure (Left err)
554 Left err -> pure (Left err)
596− Right context' -> putDBCIOContext context'
555+ Right context' -> pure (Right context')
597−evalGraphRefDatabaseContextIOExpr (LoadAtomFunctions modName funcName modPath) = do
556+
598− currentContext <- getDBCIOContext
557+
599− eLoadFunc <- liftIO $ loadAtomFunctions (T.unpack modName) (T.unpack funcName) modPath
558+updateTupleWithAtomExprs :: M.Map AttributeName AtomExpr -> DatabaseContext -> RelationTuple -> Either RelationalError RelationTuple
600− case eLoadFunc of
559+updateTupleWithAtomExprs exprMap context tupIn = do
601− Left LoadSymbolError -> pure (Left LoadFunctionError)
560+ --resolve all atom exprs
602− Right atomFunctionListFunc -> let newContext = currentContext { atomFunctions = mergedFuncs }
561+ atomsAssoc <- mapM (\(attrName, atomExpr) -> do
603− mergedFuncs = HS.union (atomFunctions currentContext) (HS.fromList atomFunctionListFunc)
562+ atom <- runReader (evalAtomExpr tupIn atomExpr) (RelationalExprStateElems context)
604− in putDBCIOContext newContext
563+ pure (attrName, atom)
605−evalGraphRefDatabaseContextIOExpr (LoadDatabaseContextFunctions modName funcName modPath) = do
564+ ) (M.toList exprMap)
606− currentContext <- getDBCIOContext
565+ pure (updateTupleWithAtoms (M.fromList atomsAssoc) tupIn)
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')
644
566
645--run verification on all constraints
567--run verification on all constraints
646−checkConstraints :: DatabaseContext -> TransactionId -> TransactionGraph -> Either RelationalError ()
568+checkConstraints :: DatabaseContext -> Maybe RelationalError
647−checkConstraints context transId graph@(TransactionGraph graphHeads transSet) = do
569+checkConstraints context = case failures of
648− mapM_ (uncurry checkIncDep) (M.toList deps)
570+ [] -> Nothing
571+ l:_ -> Just l
649 where
572 where
650− potentialGraph = TransactionGraph graphHeads (S.insert tempTrans transSet)
573+ failures = M.elems $ M.mapMaybeWithKey checkIncDep deps
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−
660 deps = inclusionDependencies context
574 deps = inclusionDependencies 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
575+ eval expr = runReader (evalRelationalExpr expr) (RelationalExprStateElems context)
662 checkIncDep depName (InclusionDependency subsetExpr supersetExpr) = do
576 checkIncDep depName (InclusionDependency subsetExpr supersetExpr) = do
663− let process = runProcessExprM UncommittedContextMarker
577+ let checkExpr = Equals supersetExpr (Union subsetExpr supersetExpr)
664− gfSubsetExpr = process (processRelationalExpr subsetExpr)
578+ case eval checkExpr of
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
676− Left err -> Left err
579+ Left err -> Just err
677 Right resultRel -> if resultRel == relationTrue then
580 Right resultRel -> if resultRel == relationTrue then
678− pure ()
581+ Nothing
679 else
582 else
680− Left (InclusionDependencyCheckError depName)
583+ Just $ InclusionDependencyCheckError depName
681
584
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
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
683-- furthermore, the type of a relational expression is the resultant header of the evaluated empty-tupled relation
586-- furthermore, the type of a relational expression is the resultant header of the evaluated empty-tupled relation
684
587
685−typeForRelationalExpr :: RelationalExpr -> RelationalExprM Relation
588+typeForRelationalExpr :: RelationalExpr -> RelationalExprState (Either RelationalError Relation)
686typeForRelationalExpr expr = do
589typeForRelationalExpr expr = do
590+ rstate <- ask
591+ let context = stateElemsContext rstate
687 --replace the relationVariables context element with a cloned set of relation devoid of tuples
592 --replace the relationVariables context element with a cloned set of relation devoid of tuples
688− --evalRelationalExpr could still return an existing relation with tuples, so strip them
593+ let context' = contextWithEmptyTupleSets context
689− graph <- reGraph
594+ rstate' = setStateElemsContext rstate context'
690− context <- reContext
595+ pure (runReader (evalRelationalExpr expr) rstate')
691− let gfExpr = runProcessExprM UncommittedContextMarker (processRelationalExpr expr)
596+
692− gfEnv = freshGraphRefRelationalExprEnv (Just context) graph
597+--returns a database context with all tuples removed
693− runGf = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr gfExpr)
598+--this is useful for type checking and optimization
694− lift $ except runGf
599+contextWithEmptyTupleSets :: DatabaseContext -> DatabaseContext
600+contextWithEmptyTupleSets contextIn = contextIn { relationVariables = relVars }
601+ where
602+ relVars = M.map (\rel -> Relation (attributes rel) emptyTupleSet) (relationVariables contextIn)
695
603
696liftE :: (Monad m) => m (Either a b) -> ExceptT a m b
604liftE :: (Monad m) => m (Either a b) -> ExceptT a m b
697liftE v = do
605liftE v = do
698 y <- lift v
606 y <- lift v
699 case y of
607 case y of
700− Left err -> throwError err
608+ Left err -> throwE err
701 Right val -> pure val
609 Right val -> pure val
702
610
703{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}
611{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}
704−predicateRestrictionFilter :: Attributes -> GraphRefRestrictionPredicateExpr -> GraphRefRelationalExprM RestrictionFilter
612+predicateRestrictionFilter :: Attributes -> RestrictionPredicateExpr -> RelationalExprState (Either RelationalError RestrictionFilter)
705−predicateRestrictionFilter attrs (AndPredicate expr1 expr2) = do
613+predicateRestrictionFilter attrs (AndPredicate expr1 expr2) =
614+ runExceptT $ do
706− expr1v <- predicateRestrictionFilter attrs expr1
615+ expr1v <- liftE (predicateRestrictionFilter attrs expr1)
707− expr2v <- predicateRestrictionFilter attrs expr2
616+ expr2v <- liftE (predicateRestrictionFilter attrs expr2)
708− pure (\x -> do
617+ pure (\x -> do
709− ev1 <- expr1v x
618+ ev1 <- expr1v x
710− ev2 <- expr2v x
619+ ev2 <- expr2v x
711− pure (ev1 && ev2))
620+ pure (ev1 && ev2))
712
621
713−predicateRestrictionFilter attrs (OrPredicate expr1 expr2) = do
622+predicateRestrictionFilter attrs (OrPredicate expr1 expr2) =
623+ runExceptT $ do
714− expr1v <- predicateRestrictionFilter attrs expr1
624+ expr1v <- liftE (predicateRestrictionFilter attrs expr1)
715− expr2v <- predicateRestrictionFilter attrs expr2
625+ expr2v <- liftE (predicateRestrictionFilter attrs expr2)
716 pure (\x -> do
626 pure (\x -> do
717 ev1 <- expr1v x
627 ev1 <- expr1v x
718 ev2 <- expr2v x
628 ev2 <- expr2v x
719 pure (ev1 || ev2))
629 pure (ev1 || ev2))
720
630
721−predicateRestrictionFilter _ TruePredicate = pure (\_ -> pure True)
631+predicateRestrictionFilter _ TruePredicate = pure (Right (\_ -> pure True))
722
632
723−predicateRestrictionFilter attrs (NotPredicate expr) = do
633+predicateRestrictionFilter attrs (NotPredicate expr) =
634+ runExceptT $ do
724− exprv <- predicateRestrictionFilter attrs expr
635+ exprv <- liftE (predicateRestrictionFilter attrs expr)
725− pure (fmap not . exprv)
636+ pure (\x -> do
637+ ev <- exprv x
638+ pure (not ev))
726
639
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
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
728predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = do
641predicateRestrictionFilter _ (RelationalExprPredicate relExpr) = do
729− renv <- askEnv
642+ rstate <- ask
730− let eval :: RelationTuple -> Either RelationalError Relation
643+ pure (Right (\tup -> case runReader (evalRelationalExpr relExpr) (mergeTuplesIntoRelationalExprState tup rstate) of
731− eval tup =
732− let gfEnv = mergeTuplesIntoGraphRefRelationalExprEnv tup renv in
733− runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr relExpr)
734− pure (\tup -> case eval tup of
735 Left err -> Left err
644 Left err -> Left err
736 Right rel -> if arity rel /= 0 then
645 Right rel -> if arity rel /= 0 then
737 Left (PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'")
646 Left (PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'")
738 else
647 else
739− pure (rel == relationTrue))
648+ pure (rel == relationTrue)))
740
649
741predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do
650predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr) = do
742− env <- askEnv
651+ rstate <- ask
743− let attrs' = A.union attrs (envAttributes env)
652+ let (attrs', ctxtup') = case rstate of
744− ctxtup' = envTuple env
653+ RelationalExprStateElems _ -> (attrs, emptyTuple)
654+ RelationalExprStateAttrsElems _ _ -> (attrs, emptyTuple)
655+ RelationalExprStateTupleElems _ ctxtup -> (A.union attrs (tupleAttributes ctxtup), ctxtup)
656+ runExceptT $ do
745− atomExprType <- typeForGraphRefAtomExpr attrs' atomExpr
657+ atomExprType <- liftE (typeFromAtomExpr attrs' atomExpr)
746− attr <- lift $ except $ case A.attributeForName attrName attrs of
658+ attr <- either throwE pure $ case A.attributeForName attrName attrs of
747 Right attr -> Right attr
659 Right attr -> Right attr
748 Left (NoSuchAttributeNamesError _) -> case A.attributeForName attrName (tupleAttributes ctxtup') of
660 Left (NoSuchAttributeNamesError _) -> case A.attributeForName attrName (tupleAttributes ctxtup') of
749 Right ctxattr -> Right ctxattr
661 Right ctxattr -> Right ctxattr
750 Left err2@(NoSuchAttributeNamesError _) -> Left err2
662 Left err2@(NoSuchAttributeNamesError _) -> Left err2
751 Left err -> Left err
663 Left err -> Left err
752 Left err -> Left err
664 Left err -> Left err
753− if atomExprType /= A.atomType attr then
665+ if atomExprType /= A.atomType attr then
754− throwError (TupleAttributeTypeMismatchError (A.attributesFromList [attr]))
666+ throwE (TupleAttributeTypeMismatchError (A.attributesFromList [attr]))
755− else
667+ else
756 pure $ \tupleIn -> let evalAndCmp atomIn = case atomEvald of
668 pure $ \tupleIn -> let evalAndCmp atomIn = case atomEvald of
757 Right atomCmp -> atomCmp == atomIn
669 Right atomCmp -> atomCmp == atomIn
758 Left _ -> False
670 Left _ -> False
759− atomEvald = runGraphRefRelationalExprM env (evalGraphRefAtomExpr tupleIn atomExpr)
671+ atomEvald = runReader (evalAtomExpr tupleIn atomExpr) rstate
760 in
672 in
761 pure $ case atomForAttributeName attrName tupleIn of
673 pure $ case atomForAttributeName attrName tupleIn of
762 Left (NoSuchAttributeNamesError _) -> case atomForAttributeName attrName ctxtup' of
674 Left (NoSuchAttributeNamesError _) -> case atomForAttributeName attrName ctxtup' of
@@ -767,626 +679,192 @@ predicateRestrictionFilter attrs (AttributeEqualityPredicate attrName atomExpr)
767-- in the future, it would be useful to do typechecking on the attribute and atom expr filters in advance
679-- in the future, it would be useful to do typechecking on the attribute and atom expr filters in advance
768predicateRestrictionFilter attrs (AtomExprPredicate atomExpr) = do
680predicateRestrictionFilter attrs (AtomExprPredicate atomExpr) = do
769 --merge attrs into the state attributes
681 --merge attrs into the state attributes
770− renv <- askEnv
682+ rstate <- ask
683+ runExceptT $ do
771− aType <- typeForGraphRefAtomExpr attrs atomExpr
684+ aType <- liftE (typeFromAtomExpr attrs atomExpr)
772− if aType /= BoolAtomType then
685+ if aType /= BoolAtomType then
773− throwError (AtomTypeMismatchError aType BoolAtomType)
686+ throwE (AtomTypeMismatchError aType BoolAtomType)
774− else
687+ else
775 pure (\tupleIn ->
688 pure (\tupleIn ->
776− case runGraphRefRelationalExprM renv (evalGraphRefAtomExpr tupleIn atomExpr) of
689+ pure $ case runReader (evalAtomExpr tupleIn atomExpr) rstate of
777− Left err -> Left err
690+ Left _ -> False
778− Right boolAtomValue -> pure (boolAtomValue == BoolAtom True))
691+ Right boolAtomValue -> boolAtomValue == BoolAtom True)
779
692
780tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation
693tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation
781tupleExprCheckNewAttrName attrName rel = if isRight (attributeForName attrName rel) then
694tupleExprCheckNewAttrName attrName rel = if isRight (attributeForName attrName rel) then
782− Left (AttributeNameInUseError attrName)
695+ Left (error "SPAMMIT" $ AttributeNameInUseError attrName)
783 else
696 else
784 Right rel
697 Right rel
785
698
786−extendGraphRefTupleExpressionProcessor :: Relation -> GraphRefExtendTupleExpr -> GraphRefRelationalExprM (Attributes, RelationTuple -> Either RelationalError RelationTuple)
699+extendTupleExpressionProcessor :: Relation -> ExtendTupleExpr -> RelationalExprState (Either RelationalError (Attributes, RelationTuple -> Either RelationalError RelationTuple))
787−extendGraphRefTupleExpressionProcessor relIn (AttributeExtendTupleExpr newAttrName atomExpr) =
700+extendTupleExpressionProcessor relIn (AttributeExtendTupleExpr newAttrName atomExpr) = do
788−-- renv <- askEnv
701+ rstate <- ask
789 -- check that the attribute name is not in use
702 -- check that the attribute name is not in use
790 case tupleExprCheckNewAttrName newAttrName relIn of
703 case tupleExprCheckNewAttrName newAttrName relIn of
791− Left err -> throwError err
704+ Left err -> pure (Left err)
792− Right _ -> do
705+ Right _ -> runExceptT $ do
793− atomExprType <- typeForGraphRefAtomExpr (attributes relIn) atomExpr
706+ atomExprType <- liftE (typeFromAtomExpr (attributes relIn) atomExpr)
794− atomExprType' <- verifyGraphRefAtomExprTypes relIn atomExpr atomExprType
707+ atomExprType' <- liftE (verifyAtomExprTypes relIn atomExpr atomExprType)
795 let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType']
708 let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType']
796 newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs
709 newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs
797− env <- ask
710+ pure (newAndOldAttrs, \tup -> let substate = mergeTuplesIntoRelationalExprState tup rstate in case runReader (evalAtomExpr tup atomExpr) substate of
798− pure (newAndOldAttrs, \tup -> do
711+ Left err -> Left err
799− let gfEnv = mergeTuplesIntoGraphRefRelationalExprEnv tup env
800− atom <- runGraphRefRelationalExprM gfEnv (evalGraphRefAtomExpr tup atomExpr)
801− Right (tupleAtomExtend newAttrName atom tup)
712+ Right atom -> Right (tupleAtomExtend newAttrName atom tup)
802 )
713 )
803
714
804−evalGraphRefAtomExpr :: RelationTuple -> GraphRefAtomExpr -> GraphRefRelationalExprM Atom
715+evalAtomExpr :: RelationTuple -> AtomExpr -> RelationalExprState (Either RelationalError Atom)
805−evalGraphRefAtomExpr tupIn (AttributeAtomExpr attrName) =
806− case atomForAttributeName attrName tupIn of
716+evalAtomExpr tupIn (AttributeAtomExpr attrName) = case atomForAttributeName attrName tupIn of
807− Right atom -> pure atom
717+ Right atom -> pure (Right atom)
808− Left err@(NoSuchAttributeNamesError _) -> do
718+ err@(Left (NoSuchAttributeNamesError _)) -> do
809− env <- askEnv
719+ rstate <- ask
810− case gre_extra env of
720+ case rstate of
811− Nothing -> throwError err
721+ RelationalExprStateElems _ -> pure err
722+ RelationalExprStateAttrsElems _ _ -> pure err
812− Just (Left ctxtup) -> lift $ except $ atomForAttributeName attrName ctxtup
723+ RelationalExprStateTupleElems _ ctxtup -> pure (atomForAttributeName attrName ctxtup)
813− Just (Right _) -> throwError err
814− Left err -> throwError err
724+ Left err -> pure (Left err)
815−evalGraphRefAtomExpr _ (NakedAtomExpr atom) = pure atom
725+evalAtomExpr _ (NakedAtomExpr atom) = pure (Right atom)
816−evalGraphRefAtomExpr tupIn (FunctionAtomExpr funcName arguments tid) = do
726+evalAtomExpr tupIn (FunctionAtomExpr funcName arguments ()) = do
817− argTypes <- mapM (typeForGraphRefAtomExpr (tupleAttributes tupIn)) arguments
727+ argTypes <- mapM (typeFromAtomExpr (tupleAttributes tupIn)) arguments
818− context <- gfDatabaseContextForMarker tid
728+ context <- fmap stateElemsContext ask
729+ runExceptT $ do
819− let functions = atomFunctions context
730+ let functions = atomFunctions context
820− func <- lift $ except (atomFunctionForName funcName functions)
731+ func <- either throwE pure (atomFunctionForName funcName functions)
821− let expectedArgCount = length (atomFuncType func) - 1
732+ let expectedArgCount = length (atomFuncType func) - 1
822− actualArgCount = length argTypes
733+ actualArgCount = length argTypes
734+ safeInit [_] = []
823− safeInit [] = [] -- different behavior from normal init
735+ safeInit [] = [] -- different behavior from normal init
824− safeInit xs = init xs
736+ safeInit (_:xs) = safeInit xs
825− if expectedArgCount /= actualArgCount then
737+ if expectedArgCount /= actualArgCount then
826− throwError (FunctionArgumentCountMismatchError expectedArgCount actualArgCount)
738+ throwE (FunctionArgumentCountMismatch expectedArgCount actualArgCount)
827− else do
739+ else do
828− let zippedArgs = zip (safeInit (atomFuncType func)) argTypes
740+ _ <- mapM (\(expType, actType) -> either throwE pure (atomTypeVerify expType actType)) (safeInit (zip (atomFuncType func) argTypes))
829− mapM_ (\(expType, actType) ->
830− lift $ except (atomTypeVerify expType actType)) zippedArgs
831− evaldArgs <- mapM (evalGraphRefAtomExpr tupIn) arguments
741+ evaldArgs <- mapM (liftE . evalAtomExpr tupIn) arguments
832 case evalAtomFunction func evaldArgs of
742 case evalAtomFunction func evaldArgs of
833− Left err -> throwError (AtomFunctionUserError err)
743+ Left err -> throwE (AtomFunctionUserError err)
834− Right result -> do
744+ Right result -> pure result
835− --validate that the result matches the expected type
836− _ <- lift $ except (atomTypeVerify (last (atomFuncType func)) (atomTypeForAtom result))
837− pure result
838−evalGraphRefAtomExpr tupIn (RelationAtomExpr relExpr) = do
745+evalAtomExpr tupIn (RelationAtomExpr relExpr) = do
839 --merge existing state tuple context into new state tuple context to support an arbitrary number of levels, but new attributes trounce old attributes
746 --merge existing state tuple context into new state tuple context to support an arbitrary number of levels, but new attributes trounce old attributes
840− env <- ask
747+ rstate <- ask
841− let gfEnv = mergeTuplesIntoGraphRefRelationalExprEnv tupIn env
748+ runExceptT $ do
842− relAtom <- lift $ except $ runGraphRefRelationalExprM gfEnv (evalGraphRefRelationalExpr relExpr)
749+ let newState = mergeTuplesIntoRelationalExprState tupIn rstate
750+ relAtom <- either throwE pure (runReader (evalRelationalExpr relExpr) newState)
843− pure (RelationAtom relAtom)
751+ pure (RelationAtom relAtom)
844−evalGraphRefAtomExpr tupIn cons@(ConstructedAtomExpr dConsName dConsArgs _) = do --why is the tid unused here? suspicious
752+evalAtomExpr tupIn cons@(ConstructedAtomExpr dConsName dConsArgs ()) = runExceptT $ do
845− let mergeEnv = mergeTuplesIntoGraphRefRelationalExprEnv tupIn
753+ rstate <- lift ask
754+ let newState = mergeTuplesIntoRelationalExprState tupIn rstate
846− aType <- local mergeEnv (typeForGraphRefAtomExpr (tupleAttributes tupIn) cons)
755+ aType <- either throwE pure (runReader (typeFromAtomExpr (tupleAttributes tupIn) cons) newState)
847− argAtoms <- local mergeEnv $
756+ argAtoms <- mapM (\arg -> either throwE pure (runReader (evalAtomExpr tupIn arg) newState)) dConsArgs
848− mapM (evalGraphRefAtomExpr tupIn) dConsArgs
849 pure (ConstructedAtom dConsName aType argAtoms)
757 pure (ConstructedAtom dConsName aType argAtoms)
850
758
851−typeForGraphRefAtomExpr :: Attributes -> GraphRefAtomExpr -> GraphRefRelationalExprM AtomType
759+typeFromAtomExpr :: Attributes -> AtomExpr -> RelationalExprState (Either RelationalError AtomType)
852−typeForGraphRefAtomExpr attrs (AttributeAtomExpr attrName) = do
760+typeFromAtomExpr attrs (AttributeAtomExpr attrName) = do
853− renv <- askEnv
761+ rstate <- ask
854 case A.atomTypeForAttributeName attrName attrs of
762 case A.atomTypeForAttributeName attrName attrs of
855− Right aType -> pure aType
763+ Right aType -> pure (Right aType)
856− Left err@(NoSuchAttributeNamesError _) ->
764+ Left err@(NoSuchAttributeNamesError _) -> case rstate of
857− let envTup = envTuple renv
858− envAttrs = envAttributes renv in
859− case A.attributeForName attrName envAttrs of
765+ RelationalExprStateAttrsElems _ attrs' -> case A.attributeForName attrName attrs' of
766+ Left err' -> pure (error "SPAMMO2" $ Left err')
860− Right attr -> pure (A.atomType attr)
767+ Right attr -> pure (Right (A.atomType attr))
768+ RelationalExprStateElems _ -> pure (error (show attrs) $ Left err)
861− Left _ -> case atomForAttributeName attrName envTup of
769+ RelationalExprStateTupleElems _ tup -> case atomForAttributeName attrName tup of
862− Right atom -> pure (atomTypeForAtom atom)
770+ Left err' -> pure (error "STAMP" $ Left err')
863− Left _ -> --throwError (traceStack (show ("typeForGRAtomExpr", attrs, envTup)) err)
771+ Right atom -> pure (Right (atomTypeForAtom atom))
864− throwError err
865− Left err -> throwError err
772+ Left err -> pure (error "GONK" $ Left err)
866−
867−typeForGraphRefAtomExpr _ (NakedAtomExpr atom) = pure (atomTypeForAtom atom)
773+typeFromAtomExpr _ (NakedAtomExpr atom) = pure (Right (atomTypeForAtom atom))
868−typeForGraphRefAtomExpr attrs (FunctionAtomExpr funcName atomArgs transId) = do
774+typeFromAtomExpr attrs (FunctionAtomExpr funcName atomArgs _) = do
775+ context <- fmap stateElemsContext ask
869− funcs <- atomFunctions <$> gfDatabaseContextForMarker transId
776+ let funcs = atomFunctions context
870 case atomFunctionForName funcName funcs of
777 case atomFunctionForName funcName funcs of
871− Left err -> throwError err
778+ Left err -> pure (Left err)
872 Right func -> do
779 Right func -> do
873 let funcRetType = last (atomFuncType func)
780 let funcRetType = last (atomFuncType func)
874 funcArgTypes = init (atomFuncType func)
781 funcArgTypes = init (atomFuncType func)
875− argTypes <- mapM (typeForGraphRefAtomExpr attrs) atomArgs
782+ eArgTypes <- mapM (typeFromAtomExpr attrs) atomArgs
783+ case lefts eArgTypes of
784+ errs@(_:_) -> pure (Left (someErrors errs))
785+ [] -> do
876− let eTvMap = resolveTypeVariables funcArgTypes argTypes
786+ let eTvMap = resolveTypeVariables funcArgTypes argTypes
787+ argTypes = rights eArgTypes
877− case eTvMap of
788+ case eTvMap of
878− Left err -> throwError err
789+ Left err -> pure (Left err)
879− Right tvMap -> lift $ except $ resolveFunctionReturnValue funcName tvMap funcRetType
790+ Right tvMap -> pure (resolveFunctionReturnValue funcName tvMap funcRetType)
880−typeForGraphRefAtomExpr attrs (RelationAtomExpr relExpr) = do
791+typeFromAtomExpr attrs (RelationAtomExpr relExpr) = runExceptT $ do
881− relType <- R.local (mergeAttributesIntoGraphRefRelationalExprEnv attrs) (typeForGraphRefRelationalExpr relExpr)
792+ rstate <- lift ask
793+ relType <- either throwE pure (runReader (typeForRelationalExpr relExpr) (mergeAttributesIntoRelationalExprState attrs rstate))
882 pure (RelationAtomType (attributes relType))
794 pure (RelationAtomType (attributes relType))
883-- grab the type of the data constructor, then validate that the args match the expected types
795-- grab the type of the data constructor, then validate that the args match the expected types
884−typeForGraphRefAtomExpr attrs (ConstructedAtomExpr dConsName dConsArgs tid) =
796+typeFromAtomExpr attrs (ConstructedAtomExpr dConsName dConsArgs _) =
885− do
797+ runExceptT $ do
886− argsTypes <- mapM (typeForGraphRefAtomExpr attrs) dConsArgs
798+ argsTypes <- mapM (liftE . typeFromAtomExpr attrs) dConsArgs
887− tConsMap <- typeConstructorMapping <$> gfDatabaseContextForMarker tid
799+ context <- fmap stateElemsContext (lift ask)
888− lift $ except $ atomTypeForDataConstructor tConsMap dConsName argsTypes
800+ aType <- either throwE pure (atomTypeForDataConstructor (typeConstructorMapping context) dConsName argsTypes)
801+ pure aType
889
802
890-- | Validate that the type of the AtomExpr matches the expected type.
803-- | Validate that the type of the AtomExpr matches the expected type.
891−verifyGraphRefAtomExprTypes :: Relation -> GraphRefAtomExpr -> AtomType -> GraphRefRelationalExprM AtomType
804+verifyAtomExprTypes :: Relation -> AtomExpr -> AtomType -> RelationalExprState (Either RelationalError AtomType)
892−verifyGraphRefAtomExprTypes relIn (AttributeAtomExpr attrName) expectedType = do
805+verifyAtomExprTypes relIn (AttributeAtomExpr attrName) expectedType = runExceptT $ do
893− env <- askEnv
806+ rstate <- lift ask
894 case A.atomTypeForAttributeName attrName (attributes relIn) of
807 case A.atomTypeForAttributeName attrName (attributes relIn) of
895− Right aType -> lift $ except $ atomTypeVerify expectedType aType
808+ Right aType -> pure aType
896− (Left err@(NoSuchAttributeNamesError _)) ->
809+ (Left err@(NoSuchAttributeNamesError _)) -> case rstate of
897− let attrs' = envAttributes env in
810+ RelationalExprStateTupleElems _ _ -> throwE err
898− if attrs' == emptyAttributes then
811+ RelationalExprStateElems _ -> throwE err
899− throwError err
900− else
901− case A.attributeForName attrName attrs' of
812+ RelationalExprStateAttrsElems _ attrs -> case A.attributeForName attrName attrs of
902− Left err' -> throwError err'
813+ Left err' -> throwE (error "GONK" err')
903− Right attrType -> lift $ except $ atomTypeVerify expectedType (A.atomType attrType)
814+ Right attrType -> either throwE pure (atomTypeVerify expectedType (A.atomType attrType))
904− Left err -> throwError err
815+ Left err -> throwE err
905−
906−verifyGraphRefAtomExprTypes _ (NakedAtomExpr atom) expectedType =
907− lift $ except $ atomTypeVerify expectedType (atomTypeForAtom atom)
816+verifyAtomExprTypes _ (NakedAtomExpr atom) expectedType = pure (atomTypeVerify expectedType (atomTypeForAtom atom))
908−verifyGraphRefAtomExprTypes relIn (FunctionAtomExpr funcName funcArgExprs tid) expectedType = do
817+verifyAtomExprTypes relIn (FunctionAtomExpr funcName funcArgExprs _) expectedType = do
909− context <- gfDatabaseContextForMarker tid
818+ rstate <- ask
910 let functions = atomFunctions context
819 let functions = atomFunctions context
820+ context = stateElemsContext rstate
821+ runExceptT $ do
911− func <- lift $ except $ atomFunctionForName funcName functions
822+ func <- either throwE pure (atomFunctionForName funcName functions)
912− let expectedArgTypes = atomFuncType func
823+ let expectedArgTypes = atomFuncType func
913− funcArgVerifier (atomExpr, expectedType2, argCount) = do
824+ funcArgTypes <- mapM (\(atomExpr,expectedType2,argCount) -> case runReader (verifyAtomExprTypes relIn atomExpr expectedType2) rstate of
914− let handler :: RelationalError -> GraphRefRelationalExprM AtomType
915− handler (AtomTypeMismatchError expSubType actSubType) = throwError (AtomFunctionTypeError funcName argCount expSubType actSubType)
825+ Left (AtomTypeMismatchError expSubType actSubType) -> throwE (AtomFunctionTypeError funcName argCount expSubType actSubType)
916− handler err = throwError err
826+ Left err -> throwE err
917− verifyGraphRefAtomExprTypes relIn atomExpr expectedType2 `catchError` handler
827+ Right x -> pure x
918− funcArgTypes <- mapM funcArgVerifier $ zip3 funcArgExprs expectedArgTypes [1..]
828+ ) $ zip3 funcArgExprs expectedArgTypes [1..]
919− if length funcArgTypes /= length expectedArgTypes - 1 then
829+ if length funcArgTypes /= length expectedArgTypes - 1 then
920− throwError (AtomTypeCountError funcArgTypes expectedArgTypes)
830+ throwE (AtomTypeCountError funcArgTypes expectedArgTypes)
921 else
831 else
922− lift $ except $ atomTypeVerify expectedType (last expectedArgTypes)
832+ either throwE pure (atomTypeVerify expectedType (last expectedArgTypes))
923−verifyGraphRefAtomExprTypes relIn (RelationAtomExpr relationExpr) expectedType =
833+verifyAtomExprTypes relIn (RelationAtomExpr relationExpr) expectedType = runExceptT $ do
924− do
834+ rstate <- lift ask
925− let mergedAttrsEnv e = mergeAttributesIntoGraphRefRelationalExprEnv (attributes relIn) e
835+ relType <- either throwE pure (runReader (typeForRelationalExpr relationExpr) (mergeAttributesIntoRelationalExprState (attributes relIn) rstate))
926− relType <- R.local mergedAttrsEnv (typeForGraphRefRelationalExpr relationExpr)
927− lift $ except $ atomTypeVerify expectedType (RelationAtomType (attributes relType))
836+ either throwE pure (atomTypeVerify expectedType (RelationAtomType (attributes relType)))
928−verifyGraphRefAtomExprTypes rel cons@ConstructedAtomExpr{} expectedType = do
837+verifyAtomExprTypes rel cons@ConstructedAtomExpr{} expectedType = runExceptT $ do
929− cType <- typeForGraphRefAtomExpr (attributes rel) cons
838+ cType <- liftE (typeFromAtomExpr (attributes rel) cons)
930− lift $ except $ atomTypeVerify expectedType cType
839+ either throwE pure (atomTypeVerify expectedType cType)
931
840
932-- | Look up the type's name and create a new attribute.
841-- | Look up the type's name and create a new attribute.
933−evalGraphRefAttrExpr :: GraphRefAttributeExpr -> GraphRefRelationalExprM Attribute
842+evalAttrExpr :: TypeConstructorMapping -> AttributeExpr -> Either RelationalError Attribute
934−evalGraphRefAttrExpr (AttributeAndTypeNameExpr attrName tCons transId) = do
843+evalAttrExpr aTypes (AttributeAndTypeNameExpr attrName tCons ()) = do
935− tConsMap <- typeConstructorMapping <$> gfDatabaseContextForMarker transId
844+ aType <- atomTypeForTypeConstructor tCons aTypes
936− aType <- lift $ except $ atomTypeForTypeConstructorValidate True tCons tConsMap M.empty
937− lift $ except $ validateAtomType aType tConsMap
938− pure $ Attribute attrName aType
845+ Right (Attribute attrName aType)
939
846
940−evalGraphRefAttrExpr (NakedAttributeExpr attr) = pure attr
847+evalAttrExpr _ (NakedAttributeExpr attr) = Right attr
941−
848+
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
849+evalTupleExpr :: Maybe Attributes -> TupleExpr -> RelationalExprState (Either RelationalError RelationTuple)
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
991−evalGraphRefTupleExpr mAttrs (TupleExpr tupMap) = do
850+evalTupleExpr attrs (TupleExpr tupMap) = do
851+ context <- fmap stateElemsContext ask
852+ runExceptT $ do
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
853 -- 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
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
854 -- 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
995− resolveOneAtom (attrName, aExpr) =
855+ attrAtoms <- mapM (\(attrName, aExpr) -> do
996− do
856+ newAtomType <- liftE (typeFromAtomExpr A.emptyAttributes aExpr)
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?
1004− newAtom <- evalGraphRefAtomExpr emptyTuple aExpr
857+ newAtom <- liftE (evalAtomExpr emptyTuple aExpr)
1005− pure (attrName, newAtom, resolvedType)
858+ pure (attrName, newAtom, newAtomType)
1006− attrAtoms <- mapM resolveOneAtom (M.toList tupMap)
859+ ) (M.toList tupMap)
1007− let tupAttrs = A.attributesFromList $ map (\(attrName, _, aType) -> Attribute attrName aType) attrAtoms
860+ let tupAttrs = A.attributesFromList $ map (\(attrName, _, aType) -> Attribute attrName aType) attrAtoms
1008− atoms = V.fromList $ map (\(_, atom, _) -> atom) attrAtoms
861+ atoms = V.fromList $ map (\(_, atom, _) -> atom) attrAtoms
1009− tup = mkRelationTuple tupAttrs atoms
862+ tup = mkRelationTuple tupAttrs atoms
863+ tConss = typeConstructorMapping context
1010− finalAttrs = fromMaybe tupAttrs mAttrs
864+ finalAttrs = fromMaybe tupAttrs attrs
1011 --verify that the attributes match
865 --verify that the attributes match
1012− when (A.attributeNameSet finalAttrs /= A.attributeNameSet tupAttrs) $ throwError (TupleAttributeTypeMismatchError tupAttrs)
866+ when (A.attributeNameSet finalAttrs /= A.attributeNameSet tupAttrs) $ throwE (TupleAttributeTypeMismatchError tupAttrs)
1013− --we can't resolve types here- they have to be resolved at the atom level where the graph ref is held
1014− --tup' <- lift $ except (resolveTypesInTuple finalAttrs tConss (reorderTuple finalAttrs tup))
867+ tup' <- either throwE pure (resolveTypesInTuple finalAttrs (reorderTuple finalAttrs tup))
1015− let tup' = reorderTuple finalAttrs tup
1016− --TODO: restore type resolution
1017−-- _ <- lift $ except (validateTuple tup' tConss)
868+ _ <- either throwE pure (validateTuple tup' tConss)
1018− pure tup'
869+ pure tup'
1019−
1020−--temporary implementation until we have a proper planner+executor
1021−evalGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefRelationalExprM Relation
1022−evalGraphRefRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do
1023− mAttrs <- case mAttrExprs of
1024− Just _ ->
1025− Just . A.attributesFromList <$> mapM evalGraphRefAttrExpr (fromMaybe [] mAttrExprs)
1026− Nothing -> pure Nothing
1027− tuples <- evalGraphRefTupleExprs mAttrs tupleExprs
1028− let attrs = fromMaybe firstTupleAttrs mAttrs
1029− firstTupleAttrs = if null tuples then A.emptyAttributes else tupleAttributes (head tuples)
1030− lift $ except $ mkRelation attrs (RelationTupleSet tuples)
1031−evalGraphRefRelationalExpr (MakeStaticRelation attributeSet tupleSet) =
1032− lift $ except $ mkRelation attributeSet tupleSet
1033−evalGraphRefRelationalExpr (ExistingRelation rel) = pure rel
1034−evalGraphRefRelationalExpr (RelationVariable name tid) = do
1035− ctx <- gfDatabaseContextForMarker tid
1036− case M.lookup name (relationVariables ctx) of
1037− Nothing -> throwError (RelVarNotDefinedError name)
1038− Just rv -> evalGraphRefRelationalExpr rv
1039−evalGraphRefRelationalExpr (Project attrNames expr) = do
1040− attrNameSet <- evalGraphRefAttributeNames attrNames expr
1041− rel <- evalGraphRefRelationalExpr expr
1042− lift $ except $ project attrNameSet rel
1043−evalGraphRefRelationalExpr (Union exprA exprB) = do
1044− relA <- evalGraphRefRelationalExpr exprA
1045− relB <- evalGraphRefRelationalExpr exprB
1046− lift $ except $ union relA relB
1047−evalGraphRefRelationalExpr (Join exprA exprB) = do
1048− relA <- evalGraphRefRelationalExpr exprA
1049− relB <- evalGraphRefRelationalExpr exprB
1050− lift $ except $ join relA relB
1051−evalGraphRefRelationalExpr (Rename oldName newName expr) = do
1052− rel <- evalGraphRefRelationalExpr expr
1053− lift $ except $ rename oldName newName rel
1054−evalGraphRefRelationalExpr (Difference exprA exprB) = do
1055− relA <- evalGraphRefRelationalExpr exprA
1056− relB <- evalGraphRefRelationalExpr exprB
1057− lift $ except $ difference relA relB
1058−evalGraphRefRelationalExpr (Group groupAttrNames newAttrName expr) = do
1059− groupNames <- evalGraphRefAttributeNames groupAttrNames expr
1060− rel <- evalGraphRefRelationalExpr expr
1061− lift $ except $ group groupNames newAttrName rel
1062−evalGraphRefRelationalExpr (Ungroup groupAttrName expr) = do
1063− rel <- evalGraphRefRelationalExpr expr
1064− lift $ except $ ungroup groupAttrName rel
1065−evalGraphRefRelationalExpr (Restrict predExpr expr) = do
1066− rel <- evalGraphRefRelationalExpr expr
1067− filt <- predicateRestrictionFilter (attributes rel) predExpr
1068− lift $ except $ restrict filt rel
1069−evalGraphRefRelationalExpr (Equals exprA exprB) = do
1070− relA <- evalGraphRefRelationalExpr exprA
1071− relB <- evalGraphRefRelationalExpr exprB
1072− pure $ if relA == relB then relationTrue else relationFalse
1073−evalGraphRefRelationalExpr (NotEquals exprA exprB) = do
1074− relA <- evalGraphRefRelationalExpr exprA
1075− relB <- evalGraphRefRelationalExpr exprB
1076− pure $ if relA == relB then relationFalse else relationTrue
1077−evalGraphRefRelationalExpr (Extend extendTupleExpr expr) = do
1078− rel <- evalGraphRefRelationalExpr expr
1079− (newAttrs, tupProc) <- extendGraphRefTupleExpressionProcessor rel extendTupleExpr
1080− lift $ except $ relMogrify tupProc newAttrs rel
1081−evalGraphRefRelationalExpr expr@With{} =
1082− --strategy A: add relation variables to the contexts in the graph
1083− --strategy B: drop in macros in place (easier programmatically)
1084− --strategy B implementation
1085− evalGraphRefRelationalExpr (substituteWithNameMacros [] expr)
1086
870
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+32−133
@@ -1,12 +1,7 @@
1−{-# LANGUAGE UnboxedTuples, KindSignatures, DataKinds #-}
2−#ifdef PM36_HASKELL_SCRIPTING
3−{-# LANGUAGE MagicHash #-}
4−#endif
5module ProjectM36.ScriptSession where
1module ProjectM36.ScriptSession where
6
2
7−#ifdef PM36_HASKELL_SCRIPTING
8import ProjectM36.Error
3import ProjectM36.Error
9−import GHC
4+
10import Control.Exception
5import Control.Exception
11import Control.Monad
6import Control.Monad
12import System.IO.Error
7import System.IO.Error
@@ -14,63 +9,32 @@ import System.Directory
14import Control.Monad.IO.Class
9import Control.Monad.IO.Class
15import System.FilePath.Glob
10import System.FilePath.Glob
16import System.FilePath
11import System.FilePath
17−import System.Info (os, arch)
18import Data.Text (Text, unpack)
12import Data.Text (Text, unpack)
19import Data.Maybe
13import Data.Maybe
14+
15+import GHC
20import GHC.Paths (libdir)
16import GHC.Paths (libdir)
21−import System.Environment
22#if __GLASGOW_HASKELL__ >= 800
17#if __GLASGOW_HASKELL__ >= 800
23import GHC.LanguageExtensions
18import GHC.LanguageExtensions
24−import GHCi.ObjLink
25−#else
26−import ObjLink
27−#endif
28−#if __GLASGOW_HASKELL__ >= 802
29−import BasicTypes
30#endif
19#endif
31import DynFlags
20import DynFlags
32import Panic
21import Panic
33import Outputable --hiding ((<>))
22import Outputable --hiding ((<>))
34import PprTyThing
23import PprTyThing
35import Unsafe.Coerce
24import Unsafe.Coerce
36−#if __GLASGOW_HASKELL__ >= 802
37−import Type
38−#elif __GLASGOW_HASKELL__ >= 710
39−import Type hiding (pprTyThing)
25+import Type hiding (pprTyThing)
40−#else
41−#endif
42−import GHC.Exts (addrToAny#)
43−import GHC.Ptr (Ptr(..))
44−import Encoding
45−#endif
46−
47
26
48data ScriptSession = ScriptSession {
27data ScriptSession = ScriptSession {
49−#ifdef PM36_HASKELL_SCRIPTING
50− hscEnv :: HscEnv,
28+ hscEnv :: HscEnv,
51 atomFunctionBodyType :: Type,
29 atomFunctionBodyType :: Type,
52 dbcFunctionBodyType :: Type
30 dbcFunctionBodyType :: Type
53−#endif
54 }
31 }
55−
32+
56−#ifdef PM36_HASKELL_SCRIPTING
57−data ScriptSessionError = ScriptSessionLoadError GhcException
33+newtype ScriptSessionError = ScriptSessionLoadError GhcException
58− | ScriptingDisabled
59 deriving (Show)
34 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
68
35
69-- | Configure a GHC environment/session which we will use for all script compilation.
36-- | Configure a GHC environment/session which we will use for all script compilation.
70initScriptSession :: [String] -> IO (Either ScriptSessionError ScriptSession)
37initScriptSession :: [String] -> IO (Either ScriptSessionError ScriptSession)
71−#if !defined(PM36_HASKELL_SCRIPTING)
72−initScriptSession _ = pure (Left ScriptingDisabled)
73−#else
74initScriptSession ghcPkgPaths = do
38initScriptSession ghcPkgPaths = do
75 --for the sake of convenience, for developers' builds, include the local cabal sandbox package database and the cabal new-build package database
39 --for the sake of convenience, for developers' builds, include the local cabal sandbox package database and the cabal new-build package database
76 eHomeDir <- tryJust (guard . isDoesNotExistError) getHomeDirectory
40 eHomeDir <- tryJust (guard . isDoesNotExistError) getHomeDirectory
@@ -79,47 +43,36 @@ initScriptSession ghcPkgPaths = do
79 handleGhcException excHandler $ runGhc (Just libdir) $ do
43 handleGhcException excHandler $ runGhc (Just libdir) $ do
80 dflags <- getSessionDynFlags
44 dflags <- getSessionDynFlags
81 let ghcVersion = projectVersion dflags
45 let ghcVersion = projectVersion dflags
82− -- get nix packages dir, if available
83− mNixLibDir <- liftIO $ lookupEnv "NIX_GHC_LIBDIR"
84
46
85 sandboxPkgPaths <- liftIO $ concat <$> mapM glob [
47 sandboxPkgPaths <- liftIO $ concat <$> mapM glob [
86− --"./dist-newstyle/packagedb/ghc-" ++ ghcVersion, --rely on cabal 3's ghc.environment install: "cabal install --lib project-m36"
48+ "./dist-newstyle/packagedb/ghc-" ++ ghcVersion,
87− ".cabal-sandbox/*ghc-" ++ ghcVersion ++ "-packages.conf.d",
49+ ".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"
92− --homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"
50+ homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"
93 ]
51 ]
94−
52+
95− let localPkgPaths = map PkgConfFile (ghcPkgPaths ++ sandboxPkgPaths ++ maybeToList mNixLibDir)
53+ let localPkgPaths = map PkgConfFile (ghcPkgPaths ++ sandboxPkgPaths)
96−
54+
97− let dflags' = applyGopts . applyXopts $ dflags { hscTarget = HscInterpreted ,
55+ let dflags' = applyGopts . applyXopts $ dflags { hscTarget = HscInterpreted ,
98− ghcLink = LinkInMemory,
56+ ghcLink = LinkInMemory,
99 safeHaskell = Sf_Trustworthy,
57 safeHaskell = Sf_Trustworthy,
100 safeInfer = True,
58 safeInfer = True,
101 safeInferred = True,
59 safeInferred = True,
102 --verbosity = 3,
60 --verbosity = 3,
103−#if __GLASGOW_HASKELL__ >= 800
61+#if __GLASGOW_HASKELL__ >= 800
104 trustFlags = map TrustPackage required_packages,
62 trustFlags = map TrustPackage required_packages,
105−#endif
63+#endif
106 packageFlags = packageFlags dflags ++ packages,
64 packageFlags = packageFlags dflags ++ packages,
107−#if __GLASGOW_HASKELL__ >= 802
108− packageDBFlags = map PackageDB localPkgPaths
109−#else
110 extraPkgConfs = const (localPkgPaths ++ [UserPkgConf, GlobalPkgConf])
65 extraPkgConfs = const (localPkgPaths ++ [UserPkgConf, GlobalPkgConf])
111−#endif
112−
113 }
66 }
114 applyGopts flags = foldl gopt_set flags gopts
67 applyGopts flags = foldl gopt_set flags gopts
115 applyXopts flags = foldl xopt_set flags xopts
68 applyXopts flags = foldl xopt_set flags xopts
116#if __GLASGOW_HASKELL__ >= 800
69#if __GLASGOW_HASKELL__ >= 800
117 xopts = [OverloadedStrings, ExtendedDefaultRules, ImplicitPrelude, ScopedTypeVariables]
70 xopts = [OverloadedStrings, ExtendedDefaultRules, ImplicitPrelude, ScopedTypeVariables]
118−#else
71+#else
119 xopts = [Opt_OverloadedStrings, Opt_ExtendedDefaultRules, Opt_ImplicitPrelude, Opt_ScopedTypeVariables]
72 xopts = [Opt_OverloadedStrings, Opt_ExtendedDefaultRules, Opt_ImplicitPrelude, Opt_ScopedTypeVariables]
120#endif
73#endif
121 gopts = [] --[Opt_DistrustAllPackages, Opt_PackageTrust]
74 gopts = [] --[Opt_DistrustAllPackages, Opt_PackageTrust]
122− required_packages = ["base",
75+ required_packages = ["base",
123 "containers",
76 "containers",
124 "Glob",
77 "Glob",
125 "directory",
78 "directory",
@@ -128,6 +81,8 @@ initScriptSession ghcPkgPaths = do
128 "uuid",
81 "uuid",
129 "vector",
82 "vector",
130 "text",
83 "text",
84+ "binary",
85+ "vector-binary-instances",
131 "time",
86 "time",
132 "project-m36",
87 "project-m36",
133 "bytestring"]
88 "bytestring"]
@@ -139,33 +94,16 @@ initScriptSession ghcPkgPaths = do
139 --liftIO $ traceShowM (showSDoc dflags' (ppr packages))
94 --liftIO $ traceShowM (showSDoc dflags' (ppr packages))
140 _ <- setSessionDynFlags dflags'
95 _ <- setSessionDynFlags dflags'
141 let safeImportDecl mn mQual = ImportDecl {
96 let safeImportDecl mn mQual = ImportDecl {
142−#if __GLASGOW_HASKELL__ >= 802
143− ideclSourceSrc = NoSourceText,
144−#else
145 ideclSourceSrc = Nothing,
97 ideclSourceSrc = Nothing,
146−#endif
147−
148−#if __GLASGOW_HASKELL__ >= 810
149− ideclExt = noExtField,
150−#elif __GLASGOW_HASKELL__ >= 806
151− ideclExt = NoExt,
152−#endif
153 ideclName = noLoc mn,
98 ideclName = noLoc mn,
154 ideclPkgQual = Nothing,
99 ideclPkgQual = Nothing,
155 ideclSource = False,
100 ideclSource = False,
156 ideclSafe = True,
101 ideclSafe = True,
157 ideclImplicit = False,
102 ideclImplicit = False,
158−#if __GLASGOW_HASKELL__ >= 810
159− ideclQualified = if isJust mQual then QualifiedPre else NotQualified,
160−#else
161 ideclQualified = isJust mQual,
103 ideclQualified = isJust mQual,
162−#endif
163 ideclAs = mQual,
104 ideclAs = mQual,
164 ideclHiding = Nothing
105 ideclHiding = Nothing
165 }
106 }
166−#if __GLASGOW_HASKELL__ >= 806
167− :: ImportDecl (GhcPass (c :: Pass))
168−#endif
169 unqualifiedModules = map (\modn -> IIDecl $ safeImportDecl (mkModuleName modn) Nothing) [
107 unqualifiedModules = map (\modn -> IIDecl $ safeImportDecl (mkModuleName modn) Nothing) [
170 "Prelude",
108 "Prelude",
171 "Data.Map",
109 "Data.Map",
@@ -178,12 +116,7 @@ initScriptSession ghcPkgPaths = do
178 "ProjectM36.DatabaseContextFunctionError",
116 "ProjectM36.DatabaseContextFunctionError",
179 "ProjectM36.DatabaseContextFunctionUtils",
117 "ProjectM36.DatabaseContextFunctionUtils",
180 "ProjectM36.RelationalExpression"]
118 "ProjectM36.RelationalExpression"]
181−#if __GLASGOW_HASKELL__ >= 802
182− mkModName = noLoc . mkModuleName
183−#else
184− mkModName = mkModuleName
185−#endif
186− qualifiedModules = map (\(modn, qualNam) -> IIDecl $ safeImportDecl (mkModuleName modn) (Just (mkModName qualNam))) [
119+ qualifiedModules = map (\(modn, qualNam) -> IIDecl $ safeImportDecl (mkModuleName modn) (Just (mkModuleName qualNam))) [
187 ("Data.Text", "T")
120 ("Data.Text", "T")
188 ]
121 ]
189 setContext (unqualifiedModules ++ qualifiedModules)
122 setContext (unqualifiedModules ++ qualifiedModules)
@@ -195,8 +128,8 @@ initScriptSession ghcPkgPaths = do
195addImport :: String -> Ghc ()
128addImport :: String -> Ghc ()
196addImport moduleNam = do
129addImport moduleNam = do
197 ctx <- getContext
130 ctx <- getContext
198− setContext (IIDecl (simpleImportDecl (mkModuleName moduleNam)) : ctx)
131+ setContext ( (IIDecl $ simpleImportDecl (mkModuleName moduleNam)) : ctx )
199−
132+
200showType :: DynFlags -> Type -> String
133showType :: DynFlags -> Type -> String
201showType dflags ty = showSDocForUser dflags alwaysQualify (pprTypeForUser ty)
134showType dflags ty = showSDocForUser dflags alwaysQualify (pprTypeForUser ty)
202
135
@@ -221,55 +154,21 @@ compileScript funcType script = do
221 mErr <- typeCheckScript funcType script
154 mErr <- typeCheckScript funcType script
222 case mErr of
155 case mErr of
223 Just err -> pure (Left err)
156 Just err -> pure (Left err)
224− Nothing ->
157+ Nothing -> do
225 --catch exception here
158 --catch exception here
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.
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.
227 -- we can't use dynCompileExpr here because
160 -- we can't use dynCompileExpr here because
228− Right . unsafeCoerce <$> compileExpr sScript
161+ func <- compileExpr sScript
229−
162+ pure $ Right (unsafeCoerce func)
163+
230−typeCheckScript :: Type -> Text -> Ghc (Maybe ScriptCompilationError)
164+typeCheckScript :: Type -> Text -> Ghc (Maybe ScriptCompilationError)
231typeCheckScript expectedType inp = do
165typeCheckScript expectedType inp = do
232− dflags <- getSessionDynFlags
166+ dflags <- getSessionDynFlags
233 --catch exception for SyntaxError
167 --catch exception for SyntaxError
234−#if __GLASGOW_HASKELL__ >= 802
235− funcType <- GHC.exprType TM_Inst (unpack inp)
236−#else
237 funcType <- GHC.exprType (unpack inp)
168 funcType <- GHC.exprType (unpack inp)
238−#endif
239− --liftIO $ putStrLn $ showType dflags expectedType ++ ":::" ++ showType dflags funcType
169+ --liftIO $ putStrLn $ showType dflags expectedType ++ ":::" ++ showType dflags funcType
240 if eqType funcType expectedType then
170 if eqType funcType expectedType then
241 pure Nothing
171 pure Nothing
242 else
172 else
243 pure (Just (TypeCheckCompilationError (showType dflags expectedType) (showType dflags funcType)))
173 pure (Just (TypeCheckCompilationError (showType dflags expectedType) (showType dflags funcType)))
244−
174+
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.hsdeleted−7
@@ -1,7 +0,0 @@
1−{-# LANGUAGE DerivingVia, StandaloneDeriving #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
3−module ProjectM36.Serialise.AtomFunctionError where
4−import Codec.Winery
5−import ProjectM36.AtomFunctionError
6−
7−deriving via WineryVariant AtomFunctionError instance Serialise AtomFunctionError
src/lib/ProjectM36/Serialise/Base.hsdeleted−85
@@ -1,85 +0,0 @@
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.hsdeleted−13
@@ -1,13 +0,0 @@
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 ()
7−
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.hsdeleted−7
@@ -1,7 +0,0 @@
1−{-# LANGUAGE DerivingVia, StandaloneDeriving #-}
2−{-# OPTIONS_GHC -fno-warn-orphans #-}
3−module ProjectM36.Serialise.DatabaseContextFunctionError where
4−import Codec.Winery
5−import ProjectM36.DatabaseContextFunctionError
6−
7−deriving via WineryVariant DatabaseContextFunctionError instance Serialise DatabaseContextFunctionError
src/lib/ProjectM36/Serialise/Error.hsdeleted−15
@@ -1,15 +0,0 @@
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 ()
9−
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.hsdeleted−7
@@ -1,7 +0,0 @@
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
6−
7−deriving via WineryVariant SchemaExpr instance Serialise SchemaExpr
src/lib/ProjectM36/Serialise/MergeError.hsdeleted−1
@@ -1 +0,0 @@
1−
src/lib/ProjectM36/Server.hs+87−200
@@ -5,213 +5,100 @@ import ProjectM36.Client
5import ProjectM36.Server.EntryPoints
5import ProjectM36.Server.EntryPoints
6import ProjectM36.Server.RemoteCallTypes
6import ProjectM36.Server.RemoteCallTypes
7import ProjectM36.Server.Config (ServerConfig(..))
7import ProjectM36.Server.Config (ServerConfig(..))
8−import ProjectM36.FSType
9
8
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(..))
10−import Control.Concurrent.MVar (MVar)
16+import Control.Concurrent.MVar (putMVar, MVar)
11import System.IO (stderr, hPutStrLn)
17import 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
18
18
19−type TestMode = Bool
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
20−
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
21−requestHandlers :: TestMode -> Maybe Timeout -> RequestHandlers ServerState
21+serverDefinition :: Bool -> Timeout -> ProcessDefinition Connection
22−requestHandlers testFlag ti =
22+serverDefinition testBool ti = defaultProcess {
23− [
23+ apiHandlers = [
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
34− handleExecuteHeadName ti sessionId conn,
24+ handleCall (\conn (ExecuteHeadName sessionId) -> handleExecuteHeadName ti sessionId conn),
35− RequestHandler (\sState (ExecuteRelationalExpr sessionId expr) -> do
36− conn <- getConn sState
37− handleExecuteRelationalExpr ti sessionId conn expr),
25+ handleCall (\conn (ExecuteRelationalExpr sessionId expr) -> handleExecuteRelationalExpr ti sessionId conn expr),
38− RequestHandler (\sState (ExecuteDataFrameExpr sessionId expr) -> do
39− conn <- getConn sState
40− handleExecuteDataFrameExpr ti sessionId conn expr),
41− RequestHandler (\sState (ExecuteDatabaseContextExpr sessionId expr) -> do
42− conn <- getConn sState
43− handleExecuteDatabaseContextExpr ti sessionId conn expr),
26+ handleCall (\conn (ExecuteDatabaseContextExpr sessionId expr) -> handleExecuteDatabaseContextExpr ti sessionId conn expr),
44− RequestHandler (\sState (ExecuteDatabaseContextIOExpr sessionId expr) -> do
45− conn <- getConn sState
46− handleExecuteDatabaseContextIOExpr ti sessionId conn expr),
27+ handleCall (\conn (ExecuteDatabaseContextIOExpr sessionId expr) -> handleExecuteDatabaseContextIOExpr ti sessionId conn expr),
47− RequestHandler (\sState (ExecuteGraphExpr sessionId expr) -> do
48− conn <- getConn sState
49− handleExecuteGraphExpr ti sessionId conn expr),
28+ handleCall (\conn (ExecuteGraphExpr sessionId expr) -> handleExecuteGraphExpr ti sessionId conn expr),
50− RequestHandler (\sState (ExecuteTransGraphRelationalExpr sessionId expr) -> do
51− conn <- getConn sState
52− handleExecuteTransGraphRelationalExpr ti sessionId conn expr),
29+ handleCall (\conn (ExecuteTransGraphRelationalExpr sessionId expr) -> handleExecuteTransGraphRelationalExpr ti sessionId conn expr),
53− RequestHandler (\sState (ExecuteTypeForRelationalExpr sessionId expr) -> do
54− conn <- getConn sState
55− handleExecuteTypeForRelationalExpr ti sessionId conn expr),
30+ handleCall (\conn (ExecuteTypeForRelationalExpr sessionId expr) -> handleExecuteTypeForRelationalExpr ti sessionId conn expr),
56− RequestHandler (\sState (RetrieveInclusionDependencies sessionId) -> do
57− conn <- getConn sState
58− handleRetrieveInclusionDependencies ti sessionId conn),
31+ handleCall (\conn (RetrieveInclusionDependencies sessionId) -> handleRetrieveInclusionDependencies ti sessionId conn),
59− RequestHandler (\sState (RetrievePlanForDatabaseContextExpr sessionId dbExpr) -> do
60− conn <- getConn sState
61− handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr),
32+ handleCall (\conn (RetrievePlanForDatabaseContextExpr sessionId dbExpr) -> handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr),
62− RequestHandler (\sState (RetrieveHeadTransactionId sessionId) -> do
63− conn <- getConn sState
64− handleRetrieveHeadTransactionId ti sessionId conn),
33+ handleCall (\conn (RetrieveHeadTransactionId sessionId) -> handleRetrieveHeadTransactionId ti sessionId conn),
65− RequestHandler (\sState (RetrieveTransactionGraph sessionId) -> do
66− conn <- getConn sState
67− handleRetrieveTransactionGraph ti sessionId conn),
34+ handleCall (\conn (RetrieveTransactionGraph sessionId) -> handleRetrieveTransactionGraph ti sessionId conn),
68− RequestHandler (\sState (CreateSessionAtHead headn) -> do
35+ handleCall (\conn (Login procId) -> handleLogin ti conn procId),
69− conn <- getConn sState
70− handleCreateSessionAtHead ti conn headn),
36+ handleCall (\conn (CreateSessionAtHead headn) -> handleCreateSessionAtHead ti conn headn),
71− RequestHandler (\sState (CreateSessionAtCommit commitId) -> do
72− conn <- getConn sState
73− handleCreateSessionAtCommit ti conn commitId),
37+ handleCall (\conn (CreateSessionAtCommit commitId) -> handleCreateSessionAtCommit ti conn commitId),
74− RequestHandler (\sState (CloseSession sessionId) -> do
75− conn <- getConn sState
76− handleCloseSession sessionId conn),
38+ handleCall (\conn (CloseSession sessionId) -> handleCloseSession ti sessionId conn),
77− RequestHandler (\sState (RetrieveAtomTypesAsRelation sessionId) -> do
78− conn <- getConn sState
79− handleRetrieveAtomTypesAsRelation ti sessionId conn),
39+ handleCall (\conn (RetrieveAtomTypesAsRelation sessionId) -> handleRetrieveAtomTypesAsRelation ti sessionId conn),
80− RequestHandler (\sState (RetrieveRelationVariableSummary sessionId) -> do
81− conn <- getConn sState
82− handleRetrieveRelationVariableSummary ti sessionId conn),
40+ handleCall (\conn (RetrieveRelationVariableSummary sessionId) -> handleRetrieveRelationVariableSummary ti sessionId conn),
83− RequestHandler (\sState (RetrieveAtomFunctionSummary sessionId) -> do
84− conn <- getConn sState
85− handleRetrieveAtomFunctionSummary ti sessionId conn),
86− RequestHandler (\sState (RetrieveDatabaseContextFunctionSummary sessionId) -> do
87− conn <- getConn sState
88− handleRetrieveDatabaseContextFunctionSummary ti sessionId conn), RequestHandler (\sState (RetrieveCurrentSchemaName sessionId) -> do
89− conn <- getConn sState
90− handleRetrieveCurrentSchemaName ti sessionId conn),
41+ handleCall (\conn (RetrieveCurrentSchemaName sessionId) -> handleRetrieveCurrentSchemaName ti sessionId conn),
91− RequestHandler (\sState (ExecuteSchemaExpr sessionId schemaExpr) -> do
92− conn <- getConn sState
93− handleExecuteSchemaExpr ti sessionId conn schemaExpr),
42+ handleCall (\conn (ExecuteSchemaExpr sessionId schemaExpr) -> handleExecuteSchemaExpr ti sessionId conn schemaExpr),
94− RequestHandler (\sState (RetrieveSessionIsDirty sessionId) -> do
95− conn <- getConn sState
96− handleRetrieveSessionIsDirty ti sessionId conn),
43+ handleCall (\conn (RetrieveSessionIsDirty sessionId) -> handleRetrieveSessionIsDirty ti sessionId conn),
97− RequestHandler (\sState (ExecuteAutoMergeToHead sessionId strat headName') -> do
98− conn <- getConn sState
99− handleExecuteAutoMergeToHead ti sessionId conn strat headName'),
44+ handleCall (\conn (ExecuteAutoMergeToHead sessionId strat headName') -> handleExecuteAutoMergeToHead ti sessionId conn strat headName'),
100− RequestHandler (\sState (RetrieveTypeConstructorMapping sessionId) -> do
45+ handleCall (\conn Logout -> handleLogout ti conn)
101− conn <- getConn sState
46+ ] ++ testModeHandlers,
102− handleRetrieveTypeConstructorMapping ti sessionId conn),
47+ unhandledMessagePolicy = Terminate
103− RequestHandler (\sState (ExecuteValidateMerkleHashes sessionId) -> do
48+ --unhandledMessagePolicy = Log
104− conn <- getConn sState
49+ }
105− handleValidateMerkleHashes ti sessionId conn)
50+ where
106− ] ++ if testFlag then testModeHandlers ti else []
51+ testModeHandlers = if not testBool then
107−
52+ []
108−getConn :: ConnectionState ServerState -> IO Connection
53+ else
109−getConn connState = do
54+ [handleCall (\conn (TestTimeout sessionId) -> handleTestTimeout ti sessionId conn)]
110− let sock = lockless (connectionSocket connState)
55+
111− sState = connectionServerState connState
56+
112− mConn <- connectionForClient sock sState
57+initServer :: InitHandler (Connection, DatabaseName, Maybe (MVar EndPointAddress), EndPointAddress) Connection
58+initServer (conn, dbname, mAddressMVar, saddress) = do
59+ registerDB dbname
113− case mConn of
60+ case mAddressMVar of
114− Nothing -> error "failed to find socket in client map"
61+ Nothing -> pure ()
62+ Just addressMVar -> liftIO $ putMVar addressMVar saddress
63+ --traceShowM ("server started on " ++ show saddress)
115− Just conn -> pure conn
64+ pure $ InitOk conn Infinity
116
65
117−testModeHandlers :: Maybe Timeout -> RequestHandlers ServerState
66+registerDB :: DatabaseName -> Process ()
118−testModeHandlers ti = [RequestHandler (\sState (TestTimeout sessionId) -> do
67+registerDB dbname = do
119− conn <- getConn sState
68+ self <- getSelfPid
120− handleTestTimeout ti sessionId conn)]
69+ let dbname' = remoteDBLookupName dbname
70+ register dbname' self
71+ --liftIO $ putStrLn $ "registered " ++ (show self) ++ " " ++ dbname'
121
72
122−
123-- | A notification callback which logs the notification to stderr and does nothing else.
73-- | A notification callback which logs the notification to stderr and does nothing else.
124loggingNotificationCallback :: NotificationCallback
74loggingNotificationCallback :: NotificationCallback
125loggingNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received \"" ++ show notName ++ "\": " ++ show evaldNot
75loggingNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received \"" ++ show notName ++ "\": " ++ show evaldNot
126
76
127−checkFSType :: Bool -> PersistenceStrategy -> IO Bool
128−checkFSType performCheck strat =
129− case strat of
130− NoPersistence -> pure True
131− MinimalPersistence _ -> pure True
132− CrashSafePersistence path ->
133− if performCheck then do
134− -- if the path does not (yet) exist, then walk back a step- the db directory may not yet have been created
135− fullpathexists <- doesDirectoryExist path
136− let fscheckpath = if fullpathexists then
137− path
138− else
139− takeDirectory path
140− fsTypeSupportsJournaling fscheckpath
141− else
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
165− case mVal of
166− Nothing -> StmMap.insert dbName (show sock) clientMap
167− Just _ -> pure () --TODO: throw exception- user already logged in
168−
169−connectionForClient :: Socket -> ServerState -> IO (Maybe Connection)
170−connectionForClient sock sState =
171− atomically $ do
172− mdbname <- StmMap.lookup (show sock) (stateClientMap sState)
173− case mdbname of
174− Nothing -> pure Nothing
175− Just dbname ->
176− StmMap.lookup dbname (stateDBMap sState)
177−
178−initialServerState :: DatabaseName -> Connection -> IO ServerState
179−initialServerState dbName conn =
180− atomically $ do
181− dbmap <- StmMap.new
182− clientMap <- StmMap.new
183− StmMap.insert conn dbName dbmap
184− pure (ServerState { stateDBMap = dbmap, stateClientMap = clientMap })
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.
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.
186−launchServer :: ServerConfig -> Maybe (MVar SockAddr) -> IO Bool
78+launchServer :: ServerConfig -> Maybe (MVar EndPointAddress) -> IO Bool
187−launchServer daemonConfig mAddr = do
79+launchServer daemonConfig mAddressMVar = 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))
80+ econn <- connectProjectM36 (InProcessConnectionInfo (persistenceStrategy daemonConfig) loggingNotificationCallback (ghcPkgPaths daemonConfig))
194− case econn of
81+ case econn of
195− Left err -> do
82+ Left err -> do
196− hPutStrLn stderr ("Failed to create database connection: " ++ show err)
83+ hPutStrLn stderr ("Failed to create database connection: " ++ show err)
197− pure False
84+ pure False
198− Right conn -> do
85+ Right conn -> do
199− let hostname = bindHost daemonConfig
86+ let hostname = bindHost daemonConfig
200− port = fromIntegral (bindPort daemonConfig)
87+ port = bindPort daemonConfig
201−
88+ etransport <- createTransport hostname (show port) defaultTCPParameters
202−
89+ case etransport of
203− --curryer only supports IPv4 for now
90+ Left err -> error ("failed to create transport: " ++ show err)
204− let addrHints = defaultHints { addrSocketType = Stream, addrFamily = AF_INET }
91+ Right transport -> do
205− hostAddrs <- getAddrInfo (Just addrHints) (Just hostname) Nothing
92+ eEndpoint <- newEndPoint transport
206− case hostAddrs of
93+ case eEndpoint of
207− [] -> hPutStrLn stderr ("Failed to resolve: " <> hostname) >> pure False
94+ Left err -> hPutStrLn stderr ("Failed to create transport: " ++ show err) >> pure False
208− (AddrInfo _ _ _ _ (SockAddrInet _ addr32) _):_ -> do
95+ Right endpoint -> do
209− let hostAddr = hostAddressToTuple addr32
96+ localTCPNode <- newLocalNode transport initRemoteTable
97+ --traceShowM ("newLocalNode in Server " ++ show (localNodeId localTCPNode))
98+ runProcess localTCPNode $ do
99+ let testBool = testMode daemonConfig
210− mTimeout = fromIntegral <$> case perRequestTimeout daemonConfig of
100+ reqTimeout = perRequestTimeout daemonConfig
211− 0 -> Nothing
101+ serve (conn, databaseName daemonConfig, mAddressMVar, address endpoint) initServer (serverDefinition testBool reqTimeout)
212− v -> Just v
102+ liftIO $ putStrLn "serve returned"
213−
103+ pure True
214− sState <- initialServerState (databaseName daemonConfig) conn
104+
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+1−9
@@ -1,8 +1,7 @@
1module ProjectM36.Server.Config where
1module ProjectM36.Server.Config where
2import ProjectM36.Client
2import ProjectM36.Client
3
3
4−data ServerConfig = ServerConfig { persistenceStrategy :: PersistenceStrategy,
4+data ServerConfig = ServerConfig { persistenceStrategy :: PersistenceStrategy,
5− checkFS :: Bool,
6 databaseName :: DatabaseName,
5 databaseName :: DatabaseName,
7 bindHost :: Hostname,
6 bindHost :: Hostname,
8 bindPort :: Port,
7 bindPort :: Port,
@@ -12,15 +11,8 @@ data ServerConfig = ServerConfig { persistenceStrategy :: PersistenceStrategy,
12 }
11 }
13 deriving (Show)
12 deriving (Show)
14
13
15−data WebsocketServerConfig = WebsocketServerConfig { wsServerConfig :: ServerConfig,
16− tlsCertificatePath :: Maybe String,
17− tlsKeyPath :: Maybe String
18− }
19− deriving (Show)
20−
21defaultServerConfig :: ServerConfig
14defaultServerConfig :: ServerConfig
22defaultServerConfig = ServerConfig { persistenceStrategy = NoPersistence,
15defaultServerConfig = ServerConfig { persistenceStrategy = NoPersistence,
23− checkFS = True,
24 databaseName = "base",
16 databaseName = "base",
25 bindHost = "127.0.0.1",
17 bindHost = "127.0.0.1",
26 bindPort = 6543,
18 bindPort = 6543,
src/lib/ProjectM36/Server/EntryPoints.hs+135−127
@@ -1,146 +1,154 @@
1−{-# LANGUAGE MonoLocalBinds #-}
2module ProjectM36.Server.EntryPoints where
1module ProjectM36.Server.EntryPoints where
3import ProjectM36.Base hiding (inclusionDependencies)
2import ProjectM36.Base hiding (inclusionDependencies)
4import ProjectM36.IsomorphicSchema
3import ProjectM36.IsomorphicSchema
5−import ProjectM36.Client as C
4+import ProjectM36.Client
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)
6import Data.Map
12import Data.Map
7import Control.Concurrent (threadDelay)
13import Control.Concurrent (threadDelay)
8−import Network.RPC.Curryer.Server
9−import System.Timeout hiding (Timeout)
10−import Network.Socket
11−import Control.Exception
12
14
13−timeoutOrDie :: Maybe Timeout -> IO a -> IO (Maybe a)
15+timeoutOrDie :: Serializable a => Timeout -> IO a -> Process (Either ServerError a)
14−timeoutOrDie mMicros act =
16+timeoutOrDie micros 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
15− case mMicros of
22+ case asyncRes of
16− Nothing -> Just <$> act
23+ AsyncDone x -> pure (Right x)
17− Just micros ->
24+ AsyncCancelled -> pure (Left RequestTimeoutError)
18− timeout (fromIntegral micros) act
25+ AsyncFailed reason -> pure (Left (ProcessDiedError (show reason)))
26+ AsyncLinkFailed reason -> pure (Left (ProcessDiedError (show reason)))
27+ AsyncPending -> pure (Left (ProcessDiedError "process pending"))
28+
29+type Timeout = Int
19
30
20−timeoutRelErr :: Maybe Timeout -> IO (Either RelationalError a) -> IO (Either RelationalError a)
31+type Reply a = Process (ProcessReply (Either ServerError a) Connection)
21−timeoutRelErr mMicros act = do
32+
33+handleExecuteRelationalExpr :: Timeout -> SessionId -> Connection -> RelationalExpr -> Reply (Either RelationalError Relation)
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
22− ret <- timeoutOrDie mMicros act
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)
23 case ret of
56 case ret of
24− Nothing -> throw TimeoutException
57+ Right () -> reply (Right True) conn
25− Just v -> pure v
58+ Left err -> reply (Left err) conn
26−
59+
27−
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+
28−handleExecuteRelationalExpr :: Maybe Timeout -> SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)
65+handleExecuteTransGraphRelationalExpr :: Timeout -> SessionId -> Connection -> TransGraphRelationalExpr -> Reply (Either RelationalError Relation)
29−handleExecuteRelationalExpr ti sessionId conn expr =
66+handleExecuteTransGraphRelationalExpr ti sessionId conn graphExpr = do
30− timeoutRelErr ti (executeRelationalExpr sessionId conn expr)
67+ ret <- timeoutOrDie ti (executeTransGraphRelationalExpr sessionId conn graphExpr)
68+ reply ret conn
31
69
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)
70+handleExecuteTypeForRelationalExpr :: Timeout -> SessionId -> Connection -> RelationalExpr -> Reply (Either RelationalError Relation)
62−handleExecuteTypeForRelationalExpr ti sessionId conn relExpr =
71+handleExecuteTypeForRelationalExpr ti sessionId conn relExpr = do
63− timeoutRelErr ti (typeForRelationalExpr sessionId conn relExpr)
72+ ret <- timeoutOrDie ti (typeForRelationalExpr sessionId conn relExpr)
64−
73+ reply ret conn
74+
65−handleRetrieveInclusionDependencies :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError (Map IncDepName InclusionDependency))
75+handleRetrieveInclusionDependencies :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError (Map IncDepName InclusionDependency))
66−handleRetrieveInclusionDependencies ti sessionId conn =
76+handleRetrieveInclusionDependencies ti sessionId conn = do
67− timeoutRelErr ti (inclusionDependencies sessionId conn)
77+ ret <- timeoutOrDie ti (inclusionDependencies sessionId conn)
68−
78+ reply ret conn
79+
69−handleRetrievePlanForDatabaseContextExpr :: Maybe Timeout -> SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError GraphRefDatabaseContextExpr)
80+handleRetrievePlanForDatabaseContextExpr :: Timeout -> SessionId -> Connection -> DatabaseContextExpr -> Reply (Either RelationalError DatabaseContextExpr)
70−handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr =
81+handleRetrievePlanForDatabaseContextExpr ti sessionId conn dbExpr = do
71− timeoutRelErr ti (planForDatabaseContextExpr sessionId conn dbExpr)
82+ ret <- timeoutOrDie ti (planForDatabaseContextExpr sessionId conn dbExpr)
72−
83+ reply ret conn
84+
73−handleRetrieveTransactionGraph :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
85+handleRetrieveTransactionGraph :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)
74−handleRetrieveTransactionGraph ti sessionId conn =
86+handleRetrieveTransactionGraph ti sessionId conn = do
75− timeoutRelErr ti (transactionGraphAsRelation sessionId conn)
87+ ret <- timeoutOrDie ti (transactionGraphAsRelation sessionId conn)
76−
88+ reply ret conn
89+
77−handleRetrieveHeadTransactionId :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError TransactionId)
90+handleRetrieveHeadTransactionId :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError TransactionId)
78−handleRetrieveHeadTransactionId ti sessionId conn =
91+handleRetrieveHeadTransactionId ti sessionId conn = do
79− timeoutRelErr ti (headTransactionId sessionId conn)
92+ ret <- timeoutOrDie ti (headTransactionId sessionId conn)
80−
93+ reply ret conn
94+
81−handleCreateSessionAtCommit :: Maybe Timeout -> Connection -> TransactionId -> IO (Either RelationalError SessionId)
95+handleCreateSessionAtCommit :: Timeout -> Connection -> TransactionId -> Reply (Either RelationalError SessionId)
82−handleCreateSessionAtCommit ti conn commitId =
96+handleCreateSessionAtCommit ti conn commitId = do
83− timeoutRelErr ti (createSessionAtCommit conn commitId)
97+ ret <- timeoutOrDie ti (createSessionAtCommit conn commitId)
84−
98+ reply ret conn
99+
85−handleCreateSessionAtHead :: Maybe Timeout -> Connection -> HeadName -> IO (Either RelationalError SessionId)
100+handleCreateSessionAtHead :: Timeout -> Connection -> HeadName -> Reply (Either RelationalError SessionId)
86−handleCreateSessionAtHead ti conn headn =
101+handleCreateSessionAtHead ti conn headn = do
87− timeoutRelErr ti (createSessionAtHead conn headn)
102+ ret <- timeoutOrDie ti (createSessionAtHead conn headn)
88−
103+ reply ret conn
104+
89−handleCloseSession :: SessionId -> Connection -> IO ()
105+handleCloseSession :: Timeout -> SessionId -> Connection -> Reply ()
90−handleCloseSession =
106+handleCloseSession ti sessionId conn = do
91− closeSession
107+ ret <- timeoutOrDie ti (closeSession sessionId conn)
108+ case ret of
109+ Right () -> reply (Right ()) conn
110+ Left err -> reply (Left err) conn
92
111
93−handleRetrieveAtomTypesAsRelation :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
112+handleRetrieveAtomTypesAsRelation :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)
94−handleRetrieveAtomTypesAsRelation ti sessionId conn =
113+handleRetrieveAtomTypesAsRelation ti sessionId conn = do
95− timeoutRelErr ti (atomTypesAsRelation sessionId conn)
114+ ret <- timeoutOrDie ti (atomTypesAsRelation sessionId conn)
115+ reply ret conn
96
116
97-- | Returns a relation which lists the names of relvars in the current session as well as its types.
117-- | Returns a relation which lists the names of relvars in the current session as well as its types.
98−handleRetrieveRelationVariableSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
118+handleRetrieveRelationVariableSummary :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Relation)
99−handleRetrieveRelationVariableSummary ti sessionId conn =
119+handleRetrieveRelationVariableSummary ti sessionId conn = do
100− timeoutRelErr ti (relationVariablesAsRelation sessionId conn)
120+ ret <- timeoutOrDie ti (relationVariablesAsRelation sessionId conn)
101−
121+ reply ret conn
102−handleRetrieveAtomFunctionSummary :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Relation)
122+
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−
110−handleRetrieveCurrentSchemaName :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError SchemaName)
123+handleRetrieveCurrentSchemaName :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError SchemaName)
111−handleRetrieveCurrentSchemaName ti sessionId conn =
124+handleRetrieveCurrentSchemaName ti sessionId conn = do
112− timeoutRelErr ti (currentSchemaName sessionId conn)
125+ ret <- timeoutOrDie ti (currentSchemaName sessionId conn)
126+ reply ret conn
113
127
114−handleExecuteSchemaExpr :: Maybe Timeout -> SessionId -> Connection -> SchemaExpr -> IO (Either RelationalError ())
128+handleExecuteSchemaExpr :: Timeout -> SessionId -> Connection -> SchemaExpr -> Reply (Either RelationalError ())
115−handleExecuteSchemaExpr ti sessionId conn schemaExpr =
129+handleExecuteSchemaExpr ti sessionId conn schemaExpr = do
116− timeoutRelErr ti (executeSchemaExpr sessionId conn schemaExpr)
130+ ret <- timeoutOrDie ti (executeSchemaExpr sessionId conn schemaExpr)
131+ reply ret conn
117
132
118−handleLogout :: Maybe Timeout -> Connection -> IO Bool
133+handleLogout :: Timeout -> Connection -> Reply Bool
119−handleLogout _ _ =
134+handleLogout _ =
120 --liftIO $ closeRemote_ conn
135 --liftIO $ closeRemote_ conn
121− pure True
136+ reply (pure True)
122
137
123−handleTestTimeout :: Maybe Timeout -> SessionId -> Connection -> IO Bool
138+handleTestTimeout :: Timeout -> SessionId -> Connection -> Reply Bool
124−handleTestTimeout ti _ _ = do
139+handleTestTimeout ti _ conn = do
125− ret <- timeoutRelErr ti (threadDelay 100000 >> pure (Right ()))
140+ ret <- timeoutOrDie ti (threadDelay 100000 >> pure True)
126− case ret of
141+ reply ret conn
127− Right () -> pure True
128− Left _ -> pure False
129
142
130−
143+handleRetrieveSessionIsDirty :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError Bool)
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
131
152
132−handleRetrieveSessionIsDirty :: Maybe Timeout -> SessionId -> Connection -> IO (Either RelationalError Bool)
133−handleRetrieveSessionIsDirty ti sessionId conn =
134− timeoutRelErr ti (disconnectedTransactionIsDirty sessionId conn)
135
153
136−handleExecuteAutoMergeToHead :: Maybe Timeout -> SessionId -> Connection -> MergeStrategy -> HeadName -> IO (Either RelationalError ())
154+
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+24−64
@@ -3,100 +3,60 @@ import ProjectM36.Base
3import ProjectM36.Client
3import ProjectM36.Client
4import Options.Applicative
4import Options.Applicative
5import ProjectM36.Server.Config
5import ProjectM36.Server.Config
6−#if __GLASGOW_HASKELL__ < 804
7import Data.Monoid
6import Data.Monoid
8−#endif
9
7
10parseArgsWithDefaults :: ServerConfig -> Parser ServerConfig
8parseArgsWithDefaults :: ServerConfig -> Parser ServerConfig
11−parseArgsWithDefaults defaults = ServerConfig <$>
9+parseArgsWithDefaults defaults = ServerConfig <$>
12− parsePersistenceStrategy <*>
10+ parsePersistenceStrategy <*>
13− parseCheckFS <*>
14− parseDatabaseName <*>
11+ parseDatabaseName <*>
15− parseHostname (bindHost defaults) <*>
12+ parseHostname (bindHost defaults) <*>
16− parsePort (bindPort defaults) <*>
13+ parsePort (bindPort defaults) <*>
17− many parseGhcPkgPath <*>
14+ many parseGhcPkgPaths <*>
18− parseTimeout (perRequestTimeout defaults) <*>
15+ parseTimeout (perRequestTimeout defaults) <*>
19− parseTestMode
16+ pure False
20−
17+
21parsePersistenceStrategy :: Parser PersistenceStrategy
18parsePersistenceStrategy :: Parser PersistenceStrategy
22parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>
19parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>
23 MinimalPersistence <$> dbdirOpt <|>
20 MinimalPersistence <$> dbdirOpt <|>
24 pure NoPersistence
21 pure NoPersistence
25− where
22+ where
26− dbdirOpt = strOption (short 'd' <>
23+ dbdirOpt = strOption (short 'd' <>
27− long "database-directory" <>
24+ long "database-directory" <>
28 metavar "DIRECTORY" <>
25 metavar "DIRECTORY" <>
29 showDefaultWith show
26 showDefaultWith show
30 )
27 )
31 fsyncOpt = switch (short 'f' <>
28 fsyncOpt = switch (short 'f' <>
32 long "fsync" <>
29 long "fsync" <>
33 help "Fsync all new transactions.")
30 help "Fsync all new transactions.")
34−
31+
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−
42parseDatabaseName :: Parser DatabaseName
32parseDatabaseName :: Parser DatabaseName
43parseDatabaseName = strOption (short 'n' <>
33parseDatabaseName = strOption (short 'n' <>
44 long "database" <>
34 long "database" <>
45 metavar "DATABASE_NAME")
35 metavar "DATABASE_NAME")
46−
36+
47−parseHostname :: Hostname -> Parser Hostname
37+parseHostname :: Hostname -> Parser Hostname
48parseHostname defHostname = strOption (short 'h' <>
38parseHostname defHostname = strOption (short 'h' <>
49 long "hostname" <>
39 long "hostname" <>
50 metavar "HOST_NAME" <>
40 metavar "HOST_NAME" <>
51 value defHostname)
41 value defHostname)
52−
42+
53−parsePort :: Port -> Parser Port
43+parsePort :: Port -> Parser Port
54parsePort defPort = option auto (short 'p' <>
44parsePort defPort = option auto (short 'p' <>
55 long "port" <>
45 long "port" <>
56 metavar "PORT_NUMBER" <>
46 metavar "PORT_NUMBER" <>
57 value defPort)
47 value defPort)
58−
48+
59−parseGhcPkgPath :: Parser String
49+parseGhcPkgPaths :: Parser String
60−parseGhcPkgPath = strOption (long "ghc-pkg-dir" <>
50+parseGhcPkgPaths = strOption (long "ghc-pkg-dir" <>
61 metavar "GHC_PACKAGE_DIRECTORY")
51 metavar "GHC_PACKAGE_DIRECTORY")
62−
52+
63−parseTimeout :: Int -> Parser Int
53+parseTimeout :: Int -> Parser Int
64parseTimeout defTimeout = option auto (long "timeout" <>
54parseTimeout defTimeout = option auto (long "timeout" <>
65 metavar "MICROSECONDS" <>
55 metavar "MICROSECONDS" <>
66 value defTimeout)
56 value defTimeout)
67
57
68parseConfig :: IO ServerConfig
58parseConfig :: IO ServerConfig
69parseConfig = parseConfigWithDefaults defaultServerConfig
59parseConfig = parseConfigWithDefaults defaultServerConfig
70−
60+
71parseConfigWithDefaults :: ServerConfig -> IO ServerConfig
61parseConfigWithDefaults :: ServerConfig -> IO ServerConfig
72−parseConfigWithDefaults defaults = execParser (info (parseArgsWithDefaults defaults <**> helpOption) idm)
62+parseConfigWithDefaults defaults = execParser (info (parseArgsWithDefaults defaults) 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+31−72
@@ -1,103 +1,62 @@
1−{-# LANGUAGE DeriveGeneric, DerivingVia, CPP #-}
1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}
2module ProjectM36.Server.RemoteCallTypes where
2module ProjectM36.Server.RemoteCallTypes where
3import ProjectM36.Base
3import ProjectM36.Base
4import ProjectM36.IsomorphicSchema
4import ProjectM36.IsomorphicSchema
5import ProjectM36.TransactionGraph
5import ProjectM36.TransactionGraph
6−import ProjectM36.DataFrame
7import ProjectM36.TransGraphRelationalExpression
6import ProjectM36.TransGraphRelationalExpression
8import ProjectM36.Session
7import ProjectM36.Session
9−import ProjectM36.Serialise.DataFrame ()
10−import ProjectM36.Serialise.IsomorphicSchema ()
11import GHC.Generics
8import GHC.Generics
12−import Codec.Winery
9+import Data.Binary
13−
10+import Control.Distributed.Process (ProcessId)
14−#define RPCData(typeName) deriving Generic \
15− deriving Serialise via WineryVariant typeName
16
11
17{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
12{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
18-- | The initial login message. The argument should be the process id of the initiating client. This ProcessId will receive notification callbacks.
13-- | The initial login message. The argument should be the process id of the initiating client. This ProcessId will receive notification callbacks.
19−data Login = Login DatabaseName
14+data Login = Login ProcessId
20− RPCData(Login)
15+ deriving (Binary, Generic)
21
16
22data Logout = Logout
17data Logout = Logout
23− RPCData(Logout)
18+ deriving (Binary, Generic)
24−
25−data ExecuteRelationalExpr = ExecuteRelationalExpr SessionId RelationalExpr
19+data ExecuteRelationalExpr = ExecuteRelationalExpr SessionId RelationalExpr
26− RPCData(ExecuteRelationalExpr)
20+ deriving (Binary, Generic)
27−
28−data ExecuteDataFrameExpr = ExecuteDataFrameExpr SessionId DataFrameExpr
29− RPCData(ExecuteDataFrameExpr)
30−
31data ExecuteDatabaseContextExpr = ExecuteDatabaseContextExpr SessionId DatabaseContextExpr
21data ExecuteDatabaseContextExpr = ExecuteDatabaseContextExpr SessionId DatabaseContextExpr
32− RPCData(ExecuteDatabaseContextExpr)
22+ deriving (Binary, Generic)
33−
34data ExecuteDatabaseContextIOExpr = ExecuteDatabaseContextIOExpr SessionId DatabaseContextIOExpr
23data ExecuteDatabaseContextIOExpr = ExecuteDatabaseContextIOExpr SessionId DatabaseContextIOExpr
35− RPCData(ExecuteDatabaseContextIOExpr)
24+ deriving (Binary, Generic)
36−
37data ExecuteGraphExpr = ExecuteGraphExpr SessionId TransactionGraphOperator
25data ExecuteGraphExpr = ExecuteGraphExpr SessionId TransactionGraphOperator
38− RPCData(ExecuteGraphExpr)
26+ deriving (Binary, Generic)
39−
40data ExecuteTransGraphRelationalExpr = ExecuteTransGraphRelationalExpr SessionId TransGraphRelationalExpr
27data ExecuteTransGraphRelationalExpr = ExecuteTransGraphRelationalExpr SessionId TransGraphRelationalExpr
41− RPCData(ExecuteTransGraphRelationalExpr)
28+ deriving (Binary, Generic)
42−
43data ExecuteHeadName = ExecuteHeadName SessionId
29data ExecuteHeadName = ExecuteHeadName SessionId
44− RPCData(ExecuteHeadName)
30+ deriving (Binary, Generic)
45−
46data ExecuteTypeForRelationalExpr = ExecuteTypeForRelationalExpr SessionId RelationalExpr
31data ExecuteTypeForRelationalExpr = ExecuteTypeForRelationalExpr SessionId RelationalExpr
47− RPCData(ExecuteTypeForRelationalExpr)
32+ deriving (Binary, Generic)
48−
49−data ExecuteSchemaExpr = ExecuteSchemaExpr SessionId SchemaExpr RPCData(ExecuteSchemaExpr)
33+data ExecuteSchemaExpr = ExecuteSchemaExpr SessionId SchemaExpr
50−
34+ deriving (Binary, Generic)
51data ExecuteSetCurrentSchema = ExecuteSetCurrentSchema SessionId SchemaName
35data ExecuteSetCurrentSchema = ExecuteSetCurrentSchema SessionId SchemaName
52− RPCData(ExecuteSetCurrentSchema)
36+ deriving (Binary, Generic)
53−
54data RetrieveInclusionDependencies = RetrieveInclusionDependencies SessionId
37data RetrieveInclusionDependencies = RetrieveInclusionDependencies SessionId
55− RPCData(RetrieveInclusionDependencies)
38+ deriving (Binary, Generic)
56−
57data RetrievePlanForDatabaseContextExpr = RetrievePlanForDatabaseContextExpr SessionId DatabaseContextExpr
39data RetrievePlanForDatabaseContextExpr = RetrievePlanForDatabaseContextExpr SessionId DatabaseContextExpr
58− RPCData(RetrievePlanForDatabaseContextExpr)
40+ deriving (Binary, Generic)
59−
60data RetrieveTransactionGraph = RetrieveTransactionGraph SessionId
41data RetrieveTransactionGraph = RetrieveTransactionGraph SessionId
61− RPCData(RetrieveTransactionGraph)
42+ deriving (Binary, Generic)
62−
63data RetrieveHeadTransactionId = RetrieveHeadTransactionId SessionId
43data RetrieveHeadTransactionId = RetrieveHeadTransactionId SessionId
64− RPCData(RetrieveHeadTransactionId)
44+ deriving (Binary, Generic)
65−
66data CreateSessionAtCommit = CreateSessionAtCommit TransactionId
45data CreateSessionAtCommit = CreateSessionAtCommit TransactionId
67− RPCData(CreateSessionAtCommit)
46+ deriving (Binary, Generic)
68−
69data CreateSessionAtHead = CreateSessionAtHead HeadName
47data CreateSessionAtHead = CreateSessionAtHead HeadName
70− RPCData(CreateSessionAtHead)
48+ deriving (Binary, Generic)
71−
72data CloseSession = CloseSession SessionId
49data CloseSession = CloseSession SessionId
73− RPCData(CloseSession)
50+ deriving (Binary, Generic)
74−
75data RetrieveAtomTypesAsRelation = RetrieveAtomTypesAsRelation SessionId
51data RetrieveAtomTypesAsRelation = RetrieveAtomTypesAsRelation SessionId
76− RPCData(RetrieveAtomTypesAsRelation)
52+ deriving (Binary, Generic)
77−
78data RetrieveRelationVariableSummary = RetrieveRelationVariableSummary SessionId
53data RetrieveRelationVariableSummary = RetrieveRelationVariableSummary SessionId
79− RPCData(RetrieveRelationVariableSummary)
54+ deriving (Binary, Generic)
80−
81−data RetrieveAtomFunctionSummary = RetrieveAtomFunctionSummary SessionId
82− RPCData(RetrieveAtomFunctionSummary)
83−
84−data RetrieveDatabaseContextFunctionSummary = RetrieveDatabaseContextFunctionSummary SessionId
85− RPCData(RetrieveDatabaseContextFunctionSummary)
86−
87data RetrieveCurrentSchemaName = RetrieveCurrentSchemaName SessionId
55data RetrieveCurrentSchemaName = RetrieveCurrentSchemaName SessionId
88− RPCData(RetrieveCurrentSchemaName)
56+ deriving (Binary, Generic)
89−
90data TestTimeout = TestTimeout SessionId
57data TestTimeout = TestTimeout SessionId
91− RPCData(TestTimeout)
58+ deriving (Binary, Generic)
92−
93−data RetrieveSessionIsDirty = RetrieveSessionIsDirty SessionId
59+data RetrieveSessionIsDirty = RetrieveSessionIsDirty SessionId
94− RPCData(RetrieveSessionIsDirty)
60+ deriving (Binary, Generic)
95−
96data ExecuteAutoMergeToHead = ExecuteAutoMergeToHead SessionId MergeStrategy HeadName
61data ExecuteAutoMergeToHead = ExecuteAutoMergeToHead SessionId MergeStrategy HeadName
97− RPCData(ExecuteAutoMergeToHead)
62+ deriving (Binary, Generic)
98−
99−data RetrieveTypeConstructorMapping = RetrieveTypeConstructorMapping SessionId
100− RPCData(RetrieveTypeConstructorMapping)
101−
102−data ExecuteValidateMerkleHashes = ExecuteValidateMerkleHashes SessionId
103− RPCData(ExecuteValidateMerkleHashes)
src/lib/ProjectM36/Session.hs+2−3
@@ -3,7 +3,6 @@ import ProjectM36.Base
3import Data.UUID
3import Data.UUID
4import qualified Data.Map as M
4import qualified Data.Map as M
5import ProjectM36.Error
5import ProjectM36.Error
6−import qualified ProjectM36.DisconnectedTransaction as Discon
7
6
8type SessionId = UUID
7type SessionId = UUID
9
8
@@ -19,7 +18,7 @@ disconnectedTransaction :: Session -> DisconnectedTransaction
19disconnectedTransaction (Session discon _) = discon
18disconnectedTransaction (Session discon _) = discon
20
19
21isDirty :: Session -> DirtyFlag
20isDirty :: Session -> DirtyFlag
22−isDirty (Session discon _) = Discon.isDirty discon
21+isDirty (Session (DisconnectedTransaction _ _ dirtyFlag) _) = dirtyFlag
23
22
24concreteDatabaseContext :: Session -> DatabaseContext
23concreteDatabaseContext :: Session -> DatabaseContext
25concreteDatabaseContext (Session (DisconnectedTransaction _ (Schemas context _) _) _) = context
24concreteDatabaseContext (Session (DisconnectedTransaction _ (Schemas context _) _) _) = context
@@ -41,4 +40,4 @@ setSchemaName sname session = if sname == defaultSchemaName || M.member sname (s
41 pure (Session (disconnectedTransaction session) sname)
40 pure (Session (disconnectedTransaction session) sname)
42 else
41 else
43 Left (SubschemaNameNotInUseError sname)
42 Left (SubschemaNameNotInUseError sname)
44−
43+
src/lib/ProjectM36/Sessions.hs+7−29
@@ -1,42 +1,18 @@
1−{-# LANGUAGE PackageImports #-}
2module ProjectM36.Sessions where
1module ProjectM36.Sessions where
3import Control.Concurrent.STM
2import 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
8−import qualified STMContainers.Map as StmMap
3+import qualified STMContainers.Map as STMMap
9−import qualified STMContainers.Set as StmSet
4+import ListT
10−#endif
11import ProjectM36.Attribute
5import ProjectM36.Attribute
12import ProjectM36.Base
6import ProjectM36.Base
13import ProjectM36.Session
7import ProjectM36.Session
14import ProjectM36.Relation
8import ProjectM36.Relation
15import ProjectM36.Error
9import ProjectM36.Error
16import qualified Data.UUID as U
10import 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
23
11
24−type Sessions = StmMap.Map SessionId Session
12+type Sessions = STMMap.Map SessionId Session
25
13
26−--from https://github.com/nikita-volkov/stm-containers/blob/master/test/Main/MapTests.hs
27−stmMapToList :: StmMap.Map k v -> STM [(k, v)]
14+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
15+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
38−stmSetToList = ListT.fold (\l -> return . (:l)) [] . StmSet.stream
39−#endif
40
16
41uuidAtom :: U.UUID -> Atom
17uuidAtom :: U.UUID -> Atom
42uuidAtom = TextAtom . U.toText
18uuidAtom = TextAtom . U.toText
@@ -47,3 +23,5 @@ sessionsAsRelation sessions = do
47 let atomMatrix = map (\(sessionId, session) -> [uuidAtom sessionId, uuidAtom (parentId session)]) sessionAssocs
23 let atomMatrix = map (\(sessionId, session) -> [uuidAtom sessionId, uuidAtom (parentId session)]) sessionAssocs
48 pure $ mkRelationFromList (attributesFromList [Attribute "sessionid" TextAtomType,
24 pure $ mkRelationFromList (attributesFromList [Attribute "sessionid" TextAtomType,
49 Attribute "parentCommit" TextAtomType]) atomMatrix
25 Attribute "parentCommit" TextAtomType]) atomMatrix
26+
27+
src/lib/ProjectM36/Shortcuts.hsdeleted−247
@@ -1,247 +0,0 @@
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+143−530

This diff is too big to show here.

src/lib/ProjectM36/TransGraphRelationalExpression.hs+116−142

This diff is too big to show here.

src/lib/ProjectM36/Transaction.hs+12−25

This diff is too big to show here.

src/lib/ProjectM36/Transaction/Persist.hs+64−93

This diff is too big to show here.

src/lib/ProjectM36/Transaction/Type.hsdeleted−8

This diff is too big to show here.

src/lib/ProjectM36/TransactionDiffs.hsdeleted−12

This diff is too big to show here.

src/lib/ProjectM36/TransactionGraph.hs+157−276

This diff is too big to show here.

src/lib/ProjectM36/TransactionGraph/Merge.hs+12−16

This diff is too big to show here.

src/lib/ProjectM36/TransactionGraph/Persist.hs+37−74

This diff is too big to show here.

src/lib/ProjectM36/TransactionGraph/Show.hs+4−3

This diff is too big to show here.

src/lib/ProjectM36/TransactionGraph/Types.hsdeleted−12

This diff is too big to show here.

src/lib/ProjectM36/TransactionInfo.hsdeleted−12

This diff is too big to show here.

src/lib/ProjectM36/Tuple.hs+46−59

This diff is too big to show here.

src/lib/ProjectM36/TupleSet.hs−7

This diff is too big to show here.

src/lib/ProjectM36/Tupleable.hsdeleted−287

This diff is too big to show here.

src/lib/ProjectM36/Tupleable/Deriving.hsdeleted−229

This diff is too big to show here.

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

This diff is too big to show here.

src/lib/ProjectM36/WCWidth.hsdeleted−425

This diff is too big to show here.

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

This diff is too big to show here.

src/lib/ProjectM36/WithNameExpr.hsdeleted−86

This diff is too big to show here.

stack.ghc8.10.yamldeleted−19

This diff is too big to show here.

stack.ghc8.6.yamldeleted−62

This diff is too big to show here.

stack.ghc8.8.yaml → stack.yamlrenamed+13−30

This diff is too big to show here.

test/Client/Simple.hsdeleted−72

This diff is too big to show here.

test/DataFrame.hsdeleted−61

This diff is too big to show here.

test/IsomorphicSchema.hs+33−43

This diff is too big to show here.

test/MultiProcessDatabaseAccess.hs+1

This diff is too big to show here.

test/Relation/Atomable.hs+24−116

This diff is too big to show here.

test/Relation/Basic.hs+6−30

This diff is too big to show here.

test/Relation/Export/CSV.hs+18−85

This diff is too big to show here.

test/Relation/Import/CSV.hs+1−3

This diff is too big to show here.

test/Relation/StaticOptimizer.hs+25−157

This diff is too big to show here.

test/Relation/Tupleable.hsdeleted−380

This diff is too big to show here.

test/Server/Main.hs+30−47

This diff is too big to show here.

test/Server/WebSocket.hs+14−19

This diff is too big to show here.

test/TransactionGraph/Automerge.hs+2−4

This diff is too big to show here.

test/TransactionGraph/Merge.hs+41−77

This diff is too big to show here.

test/TransactionGraph/Persist.hs+22−100

This diff is too big to show here.

test/TutorialD/Interpreter.hsnew file+431

This diff is too big to show here.

test/TutorialD/Interpreter/AtomFunctionScript.hs+42−49

This diff is too big to show here.

test/TutorialD/Interpreter/DatabaseContextFunctionScript.hs+20−19

This diff is too big to show here.

test/TutorialD/Interpreter/Import/ImportTest.hsdeleted−47

This diff is too big to show here.

test/TutorialD/Interpreter/Import/TutorialD.hsnew file+21

This diff is too big to show here.

test/TutorialD/Interpreter/Import/httpimporttest.tutddeleted−2

This diff is too big to show here.

test/TutorialD/Interpreter/TestBase.hs+9−7

This diff is too big to show here.

test/TutorialD/InterpreterTest.hsdeleted−732

This diff is too big to show here.

test/TutorialD/PrinterTest.hsdeleted−47

This diff is too big to show here.

test/scripts.hs+2−5

This diff is too big to show here.