├── .github ├── FUNDING.yml └── workflows │ └── CI.yml ├── .gitignore ├── .tidyrc.json ├── LICENSE ├── PURESCRIPT-POSTGRESQL-CLIENT-LICENSE ├── README.md ├── bower.json ├── docs ├── CNAME ├── Gemfile ├── Gemfile.lock ├── _config.yml ├── _layouts │ └── default.html ├── assets │ └── css │ │ └── site.css ├── edsl.md ├── favicon.ico ├── index.md ├── mapper.md └── migrations.md ├── package-lock.json ├── package.json ├── packages.dhall ├── spago.dhall ├── src └── Droplet │ ├── Driver.purs │ ├── Driver │ ├── Internal │ │ ├── Migration.purs │ │ ├── Pool.js │ │ ├── Pool.purs │ │ ├── Query.js │ │ └── Query.purs │ ├── Migration.purs │ └── Unsafe.purs │ ├── Language.purs │ └── Language │ └── Internal │ ├── Condition.purs │ ├── Definition.js │ ├── Definition.purs │ ├── Function.purs │ ├── Syntax.purs │ ├── Token.purs │ └── Translate.purs └── test ├── Alter.purs ├── As.purs ├── Create.purs ├── Delete.purs ├── Distinct.purs ├── Drop.purs ├── From.purs ├── Function.purs ├── GroupBy.purs ├── Insert.purs ├── Join.purs ├── Limit.purs ├── Main.purs ├── Migration.purs ├── Model.purs ├── NakedSelect.purs ├── Offset.purs ├── OrderBy.purs ├── Returning.purs ├── SubQuery.purs ├── Transaction.purs ├── Types.purs ├── Union.purs ├── Unsafe.purs ├── Update.purs ├── Where.purs └── sql └── index.sql /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: easafe 4 | custom: ["https://asafe.dev/donate"] 5 | -------------------------------------------------------------------------------- /.github/workflows/CI.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: push 4 | 5 | jobs: 6 | build: 7 | runs-on: ubuntu-latest 8 | services: 9 | # Label used to access the service container 10 | postgres: 11 | # Docker Hub image 12 | image: postgres 13 | # Provide the password for postgres 14 | env: 15 | POSTGRES_USER: droplet 16 | POSTGRES_PASSWORD: droplet 17 | # Set health checks to wait until postgres has started 18 | options: >- 19 | --health-cmd pg_isready 20 | --health-interval 10s 21 | --health-timeout 5s 22 | --health-retries 5 23 | ports: 24 | # Maps tcp port 5432 on service container to the host 25 | - 5432:5432 26 | 27 | steps: 28 | - uses: actions/checkout@v2 29 | - uses: actions/setup-node@v2 30 | with: 31 | node-version: '14' 32 | cache: 'npm' 33 | 34 | - uses: purescript-contrib/setup-purescript@main 35 | 36 | - name: Cache PureScript dependencies 37 | uses: actions/cache@v2 38 | # This cache uses the .dhall files to know when it should reinstall 39 | # and rebuild packages. It caches both the installed packages from 40 | # the `.spago` directory and compilation artifacts from the `output` 41 | # directory. When restored the compiler will rebuild any files that 42 | # have changed. If you do not want to cache compiled output, remove 43 | # the `output` path. 44 | with: 45 | key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }} 46 | path: | 47 | .spago 48 | output 49 | - run: psql -f test/sql/index.sql postgresql://droplet:droplet@localhost:5432/droplet 50 | - run: npm install 51 | - run: spago build 52 | - run: spago test --no-install 53 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Dependencies 2 | .psci_modules 3 | bower_components 4 | node_modules 5 | 6 | # Generated files 7 | .psci 8 | output 9 | .psc-ide-port 10 | .purs-repl 11 | .spago 12 | Scratch.* 13 | 14 | Invalid.* 15 | Example.purs 16 | 17 | todo 18 | 19 | _site/ 20 | vendor/ 21 | .bundle/ 22 | .vscode -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "importWrap": "source", 3 | "indent": 6, 4 | "operatorsFile": null, 5 | "ribbon": 1, 6 | "typeArrowPlacement": "last", 7 | "unicode": "always", 8 | "width": null 9 | } 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Eduardo Asafe 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /PURESCRIPT-POSTGRESQL-CLIENT-LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2017, rightfold 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | 1. Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | 2. Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | 3. Neither the name of the copyright holder nor the names of its contributors 15 | may be used to endorse or promote products derived from this software without 16 | specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## purescript-droplet ![build status](https://github.com/easafe/purescript-droplet/actions/workflows/CI.yml/badge.svg) 2 | 3 | Composable, type-safe eDSL and query mapper for PureScript targeting PostgreSQL 4 | 5 | * eDSL made out of combinators (almost) identical to their SQL counterparts 6 | 7 | * Generated SQL matches eDSL one-to-one, and is guaranteed to be correct and unambiguous 8 | 9 | * Supports nearly all common SQL operations for ```SELECT```, ```INSERT```, ```UPDATE```, ``DELETE`` and others, including joins, aggregations, subqueries, etc 10 | 11 | * Very little boilerplate: query results are automatically mapped to records, (valid) queries never require type annotations 12 | 13 | * Migration support via [pebble](https://github.com/easafe/haskell-pebble) 14 | 15 | ### Documentation 16 | 17 | See the [project page](https://droplet.asafe.dev/) for an in-depth look, or [pursuit](https://pursuit.purescript.org/packages/purescript-droplet) for API docs 18 | 19 | ### Quick start 20 | 21 | Install 22 | 23 | ``` 24 | npm i big-integer pg @easafe/pebble 25 | 26 | spago install droplet 27 | ``` 28 | 29 | Create some tables 30 | 31 | ```sql 32 | create table users ( 33 | id integer generated always as identity primary key, 34 | name text not null, 35 | birthday date null 36 | ); 37 | 38 | create table messages ( 39 | id integer generated always as identity primary key, 40 | sender integer not null, 41 | recipient integer not null, 42 | date timestamptz default now(), 43 | 44 | constraint sender_user foreign key (sender) references users(id), 45 | constraint recipient_user foreign key (recipient) references users(id) 46 | ); 47 | ``` 48 | 49 | Define some types for your SQL 50 | 51 | ```purescript 52 | -- representation of the table itself 53 | type UsersTable = Table "users" Users 54 | 55 | users :: UsersTable 56 | users = Table 57 | 58 | messages :: Table "messages" Messages 59 | messages = Table 60 | 61 | -- representation of the table's columns definitions 62 | type Users = ( 63 | id :: Column Int (PrimaryKey /\ Identity), -- primary key, generated always as identity 64 | name :: String, 65 | birthday :: Maybe Date -- nullable column 66 | ) 67 | 68 | type Messages = ( 69 | id :: Column Int (PrimaryKey /\ Identity), 70 | sender :: Column Int (ForeignKey "id" UsersTable), -- foreign key to table users 71 | recipient :: Column Int (ForeignKey "id" UsersTable), 72 | date :: Column DateTime (Constraint "date_default_messages" Default) -- column with named default constrain 73 | ) 74 | 75 | -- representation of column names to be used in queries 76 | id :: Proxy "id" 77 | id = Proxy 78 | 79 | name :: Proxy "name" 80 | name = Proxy 81 | 82 | birthday :: Proxy "birthday" 83 | birthday = Proxy 84 | 85 | sender :: Proxy "sender" 86 | sender = Proxy 87 | 88 | recipient :: Proxy "recipient" 89 | recipient = Proxy 90 | 91 | date :: Proxy "date" 92 | date = Proxy 93 | 94 | -- alias 95 | u :: Proxy "u" 96 | u = Proxy 97 | 98 | m :: Proxy "m" 99 | m = Proxy 100 | 101 | t :: Proxy "t" 102 | t = Proxy 103 | ``` 104 | 105 | (Don't worry, table creation, typing and migration can be automated with [pebble](https://github.com/easafe/haskell-pebble)) 106 | 107 | Prepare some queries 108 | 109 | ```purescript 110 | mary :: _ 111 | mary = 112 | insert # 113 | into users (name) # 114 | values ("Mary Sue") # -- `name` is the only required field; it would be a type error to set `id`, as it is an identity column 115 | returning id -- output inserted `id` 116 | 117 | gary :: Date -> _ 118 | gary bday = 119 | insert # 120 | into users (name /\ birthday) # -- tuple for field list 121 | values ("Gary Stu" /\ Just bday) # -- set the nullable field `birthday` 122 | returning id 123 | 124 | chat :: Int -> Int -> _ 125 | chat from to = insert # into messages (sender /\ recipient) # values (from /\ to) -- `date` has a default value 126 | 127 | selectMessages :: _ 128 | selectMessages = 129 | select (id /\ date) # 130 | from messages 131 | 132 | selectUserMessages :: Int -> _ 133 | selectUserMessages userId = 134 | selectMessages # 135 | wher (id .=. userId) -- SQL operators are surrounded by dots; we can compare `id` to `userId` as `Column` type wrappers are automatically stripped 136 | 137 | joinUserMessages :: _ 138 | joinUserMessages = 139 | select (u ... name /\ -- `alias ... column` is equivalent to SQL alias.column 140 | (t ... name # as recipient) /\ -- `name` is displayed as recipient 141 | date) # 142 | from (((messages # as m) 143 | `join` 144 | (users # as u) # 145 | on (m ... sender .=. u ... id)) 146 | `join` 147 | (users # as t) # 148 | on (m ... recipient .=. t ... id)) 149 | ``` 150 | 151 | Connect to the database 152 | 153 | ```purescript 154 | connectionInfo :: Configuration 155 | connectionInfo = (Driver.defaultConfiguration "database") { 156 | user = Just "user" 157 | } 158 | 159 | example :: Aff Unit 160 | example = do 161 | pool <- liftEffect $ Pool.newPool connectionInfo -- connection pool from PostgreSQL 162 | Driver.withConnection pool case _ of 163 | Left error -> pure unit -- or some more sensible handling 164 | Right connection -> runSql connection 165 | ``` 166 | 167 | Run queries 168 | 169 | ```purescript 170 | runSql :: Connection -> Aff Unit 171 | runSql connection = do 172 | now <- liftEffect Now.nowDate 173 | mRow <- Driver.single connection mary -- run a query that returns a single row 174 | gRow <- Driver.single connection $ gary now 175 | case mRow, gRow of 176 | Right (Just {id: mId}), Right (Just {id: gId}) -> void do 177 | mErr <- Driver.execute connection $ chat mId gId -- run a query that doesn't produce an output 178 | gErr <- Driver.execute connection $ chat gId mId 179 | 180 | mMessages <- Driver.query connection $ selectUserMessages mId -- run a query that returns rows 181 | gMessages <- Driver.query connection $ selectUserMessages gId -- rows are always records, the keys are the projected columns 182 | Driver.query connection joinUserMessages 183 | 184 | _, _ -> pure unit 185 | ``` 186 | 187 | ### Licensing 188 | 189 | Wrapper code around [pg](https://github.com/brianc/node-postgres) was adapted from [purescript-postgresql-client](https://github.com/rightfold/purescript-postgresql-client) so its license has been included in [PURESCRIPT-POSTGRESQL-CLIENT-LICENSE](PURESCRIPT-POSTGRESQL-CLIENT-LICENSE) 190 | 191 | ### Funding 192 | 193 | If this project is useful for you, consider [throwing a buck](https://asafe.dev/donate) to keep development possible 194 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-droplet", 3 | "license": [ 4 | "MIT" 5 | ], 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/easafe/purescript-droplet" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "node_modules", 13 | "bower_components", 14 | "output" 15 | ], 16 | "dependencies": { 17 | "purescript-aff": "^v7.0.0", 18 | "purescript-arrays": "^v7.0.0", 19 | "purescript-bifunctors": "^v6.0.0", 20 | "purescript-bigints": "^v7.0.1", 21 | "purescript-datetime": "^v6.0.0", 22 | "purescript-debug": "^v6.0.0", 23 | "purescript-effect": "^v4.0.0", 24 | "purescript-either": "^v6.0.0", 25 | "purescript-enums": "^v6.0.0", 26 | "purescript-exceptions": "^v6.0.0", 27 | "purescript-foldable-traversable": "^v6.0.0", 28 | "purescript-foreign": "^v7.0.0", 29 | "purescript-foreign-object": "^v4.0.0", 30 | "purescript-integers": "^v6.0.0", 31 | "purescript-maybe": "^v6.0.0", 32 | "purescript-newtype": "^v5.0.0", 33 | "purescript-nonempty": "^v7.0.0", 34 | "purescript-nullable": "^v6.0.0", 35 | "purescript-ordered-collections": "^v3.0.0", 36 | "purescript-partial": "^v4.0.0", 37 | "purescript-prelude": "^v6.0.0", 38 | "purescript-profunctor": "^v6.0.0", 39 | "purescript-record": "^v4.0.0", 40 | "purescript-spec": "^v7.0.0", 41 | "purescript-strings": "^v6.0.0", 42 | "purescript-transformers": "^v6.0.0", 43 | "purescript-tuples": "^v7.0.0", 44 | "purescript-type-equality": "^v4.0.1", 45 | "purescript-typelevel-prelude": "^v7.0.0", 46 | "purescript-unsafe-coerce": "^v6.0.0" 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /docs/CNAME: -------------------------------------------------------------------------------- 1 | droplet.asafe.dev 2 | -------------------------------------------------------------------------------- /docs/Gemfile: -------------------------------------------------------------------------------- 1 | source "https://rubygems.org" 2 | 3 | # Hello! This is where you manage which Jekyll version is used to run. 4 | # When you want to use a different version, change it below, save the 5 | # file and run `bundle install`. Run Jekyll with `bundle exec`, like so: 6 | # 7 | # bundle exec jekyll serve 8 | # 9 | # This will help ensure the proper Jekyll version is running. 10 | # Happy Jekylling! 11 | gem "jekyll", "~> 3.8.5" 12 | 13 | # This is the default theme for new Jekyll sites. You may change this to anything you like. 14 | gem "minima", "~> 2.0" 15 | 16 | # If you want to use GitHub Pages, remove the "gem "jekyll"" above and 17 | # uncomment the line below. To upgrade, run `bundle update github-pages`. 18 | # gem "github-pages", group: :jekyll_plugins 19 | 20 | # If you have any plugins, put them here! 21 | group :jekyll_plugins do 22 | gem "jekyll-feed", "~> 0.6" 23 | end 24 | 25 | # Windows does not include zoneinfo files, so bundle the tzinfo-data gem 26 | gem "tzinfo-data", platforms: [:mingw, :mswin, :x64_mingw, :jruby] 27 | 28 | # Performance-booster for watching directories on Windows 29 | gem "wdm", "~> 0.1.0" if Gem.win_platform? 30 | 31 | -------------------------------------------------------------------------------- /docs/Gemfile.lock: -------------------------------------------------------------------------------- 1 | GEM 2 | remote: https://rubygems.org/ 3 | specs: 4 | addressable (2.8.0) 5 | public_suffix (>= 2.0.2, < 5.0) 6 | colorator (1.1.0) 7 | concurrent-ruby (1.1.8) 8 | em-websocket (0.5.2) 9 | eventmachine (>= 0.12.9) 10 | http_parser.rb (~> 0.6.0) 11 | eventmachine (1.2.7) 12 | ffi (1.15.0) 13 | forwardable-extended (2.6.0) 14 | http_parser.rb (0.6.0) 15 | i18n (0.9.5) 16 | concurrent-ruby (~> 1.0) 17 | jekyll (3.8.7) 18 | addressable (~> 2.4) 19 | colorator (~> 1.0) 20 | em-websocket (~> 0.5) 21 | i18n (~> 0.7) 22 | jekyll-sass-converter (~> 1.0) 23 | jekyll-watch (~> 2.0) 24 | kramdown (~> 1.14) 25 | liquid (~> 4.0) 26 | mercenary (~> 0.3.3) 27 | pathutil (~> 0.9) 28 | rouge (>= 1.7, < 4) 29 | safe_yaml (~> 1.0) 30 | jekyll-feed (0.15.1) 31 | jekyll (>= 3.7, < 5.0) 32 | jekyll-sass-converter (1.5.2) 33 | sass (~> 3.4) 34 | jekyll-seo-tag (2.7.1) 35 | jekyll (>= 3.8, < 5.0) 36 | jekyll-watch (2.2.1) 37 | listen (~> 3.0) 38 | kramdown (1.17.0) 39 | liquid (4.0.3) 40 | listen (3.5.1) 41 | rb-fsevent (~> 0.10, >= 0.10.3) 42 | rb-inotify (~> 0.9, >= 0.9.10) 43 | mercenary (0.3.6) 44 | minima (2.5.1) 45 | jekyll (>= 3.5, < 5.0) 46 | jekyll-feed (~> 0.9) 47 | jekyll-seo-tag (~> 2.1) 48 | pathutil (0.16.2) 49 | forwardable-extended (~> 2.6) 50 | public_suffix (4.0.6) 51 | rb-fsevent (0.11.0) 52 | rb-inotify (0.10.1) 53 | ffi (~> 1.0) 54 | rouge (3.26.0) 55 | safe_yaml (1.0.5) 56 | sass (3.7.4) 57 | sass-listen (~> 4.0.0) 58 | sass-listen (4.0.0) 59 | rb-fsevent (~> 0.9, >= 0.9.4) 60 | rb-inotify (~> 0.9, >= 0.9.7) 61 | 62 | PLATFORMS 63 | ruby 64 | 65 | DEPENDENCIES 66 | jekyll (~> 3.8.5) 67 | jekyll-feed (~> 0.6) 68 | minima (~> 2.0) 69 | tzinfo-data 70 | 71 | BUNDLED WITH 72 | 2.1.4 73 | -------------------------------------------------------------------------------- /docs/_config.yml: -------------------------------------------------------------------------------- 1 | # Welcome to Jekyll! 2 | # 3 | # This config file is meant for settings that affect your whole blog, values 4 | # which you are expected to set up once and rarely edit after that. If you find 5 | # yourself editing this file very often, consider using Jekyll's data files 6 | # feature for the data you need to update frequently. 7 | # 8 | # For technical reasons, this file is *NOT* reloaded automatically when you use 9 | # 'bundle exec jekyll serve'. If you change this file, please restart the server process. 10 | 11 | # Site settings 12 | # These are used to personalize your new site. If you look in the HTML files, 13 | # you will see them accessed via {{ site.title }}, {{ site.email }}, and so on. 14 | # You can create any custom variable you would like, and they will be accessible 15 | # in the templates via {{ site.myvariable }}. 16 | 17 | # Build settings 18 | markdown: kramdown 19 | highlighter: rouge 20 | 21 | # Exclude from processing. 22 | # The following items will not be processed, by default. Create a custom list 23 | # to override the default setting. 24 | # exclude: 25 | # - Gemfile 26 | # - Gemfile.lock 27 | # - node_modules 28 | # - vendor/bundle/ 29 | # - vendor/cache/ 30 | # - vendor/gems/ 31 | # - vendor/ruby/ 32 | -------------------------------------------------------------------------------- /docs/_layouts/default.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | Droplet - {{ page.title }} 7 | 8 | 9 | 10 |
11 |
12 |

droplet

13 | 19 |
20 | 24 |
25 |
26 |
27 | {{ content }} 28 |
29 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /docs/assets/css/site.css: -------------------------------------------------------------------------------- 1 | @import url('https://fonts.googleapis.com/css?family=Open+Sans'); 2 | @import url('https://fonts.googleapis.com/css?family=Catamaran:400,700'); 3 | html { 4 | height: 100%; 5 | box-sizing: border-box; 6 | background-color: #212120; 7 | color:rgb(238, 238, 238); 8 | } 9 | 10 | * { 11 | background: inherit 12 | } 13 | 14 | body { 15 | margin: 0; 16 | min-height: 100%; 17 | font-family: "Open sans", "sans serif"; 18 | font-size: 18px; 19 | line-height: 1.51857143; 20 | display: flex; 21 | } 22 | 23 | h1, h2, h3, h4 { 24 | -webkit-margin-before: 0.0em; 25 | -webkit-margin-after: 0.0em; 26 | font-weight: bold; 27 | color: #3575cc; 28 | font-family: "Catamaran"; 29 | } 30 | 31 | 32 | a { 33 | text-decoration: none; 34 | font-weight: bold; 35 | } 36 | 37 | a:visited { 38 | text-decoration: none 39 | } 40 | 41 | h1 { 42 | font-size: 2em; 43 | } 44 | 45 | h2 { 46 | font-size: 1.6em; 47 | } 48 | 49 | h3 { 50 | font-size: 1.3em; 51 | } 52 | 53 | ul { 54 | padding: 0; 55 | } 56 | 57 | ul li { 58 | list-style-type: none; 59 | padding-bottom: 14px; 60 | } 61 | 62 | .menu { 63 | padding: 40px; 64 | padding-right: 60px; 65 | display: flex; 66 | position: sticky; 67 | top: 10px; 68 | z-index: 1; 69 | flex-flow: column; 70 | } 71 | 72 | .content { 73 | padding: 60px; 74 | width: 1024px; 75 | } 76 | 77 | .content a { 78 | font-family: "Open sans", "sans serif"; 79 | } 80 | 81 | a.direction, .menu a:not(.project-name) { 82 | color: #212120; 83 | background-color: #3575cc; 84 | padding: 3px 5px; 85 | font-family: "Catamaran"; 86 | display: inline-block; 87 | border-radius: 2px; 88 | font-size: 1.1em; 89 | } 90 | 91 | .content a:not(.direction), .menu a.current, .menu a:hover { 92 | color: #3575cc; 93 | background-color: #212120; 94 | } 95 | 96 | .content ul li { 97 | list-style-type: circle; 98 | padding: 5px 99 | } 100 | 101 | .project-name { 102 | color: #3575cc; 103 | background-color: #212120; 104 | font-size: 1.3em; 105 | padding: 0; 106 | } 107 | 108 | .previous { 109 | display: inline-block; 110 | margin-right: 20px; 111 | margin-bottom: 20px; 112 | } 113 | 114 | .current { 115 | border-bottom: 3px solid #3575cc; 116 | } 117 | 118 | @media (max-width:600px) { 119 | .menu, .content { 120 | max-width: 100%; 121 | padding: 5px 10px; 122 | } 123 | body { 124 | display: block; 125 | } 126 | div { 127 | width: 100%; 128 | display: block; 129 | } 130 | 131 | p { 132 | display: block; 133 | word-wrap: break-word; 134 | max-width: 97vw; 135 | 136 | } 137 | 138 | } 139 | 140 | .highlight .c { 141 | color: #75715e 142 | } 143 | 144 | /* Comment */ 145 | 146 | .highlight .err { 147 | color: #960050; 148 | background-color: #1e0010 149 | } 150 | 151 | /* Error */ 152 | 153 | .highlight .k { 154 | color: #66d9ef 155 | } 156 | 157 | /* Keyword */ 158 | 159 | .highlight .l { 160 | color: #ae81ff 161 | } 162 | 163 | /* Literal */ 164 | 165 | .highlight .n { 166 | color: #f8f8f2 167 | } 168 | 169 | /* Name */ 170 | 171 | .highlight .o { 172 | color: #f92672 173 | } 174 | 175 | /* BinaryOperator */ 176 | 177 | .highlight .p { 178 | color: #f8f8f2 179 | } 180 | 181 | /* Punctuation */ 182 | 183 | .highlight .cm { 184 | color: #75715e 185 | } 186 | 187 | /* Comment.Multiline */ 188 | 189 | .highlight .cp { 190 | color: #75715e 191 | } 192 | 193 | /* Comment.Preproc */ 194 | 195 | .highlight .c1 { 196 | color: #75715e 197 | } 198 | 199 | /* Comment.Single */ 200 | 201 | .highlight .cs { 202 | color: #75715e 203 | } 204 | 205 | /* Comment.Special */ 206 | 207 | .highlight .ge { 208 | font-style: italic 209 | } 210 | 211 | /* Generic.Emph */ 212 | 213 | .highlight .gs { 214 | font-weight: bold 215 | } 216 | 217 | /* Generic.Strong */ 218 | 219 | .highlight .kc { 220 | color: #66d9ef 221 | } 222 | 223 | /* Keyword.Constant */ 224 | 225 | .highlight .kd { 226 | color: #66d9ef 227 | } 228 | 229 | /* Keyword.Declaration */ 230 | 231 | .highlight .kn { 232 | color: #f92672 233 | } 234 | 235 | /* Keyword.Namespace */ 236 | 237 | .highlight .kp { 238 | color: #66d9ef 239 | } 240 | 241 | /* Keyword.Pseudo */ 242 | 243 | .highlight .kr { 244 | color: #66d9ef 245 | } 246 | 247 | /* Keyword.Reserved */ 248 | 249 | .highlight .kt { 250 | color: #66d9ef 251 | } 252 | 253 | /* Keyword.Type */ 254 | 255 | .highlight .ld { 256 | color: #e6db74 257 | } 258 | 259 | /* Literal.Date */ 260 | 261 | .highlight .m { 262 | color: #ae81ff 263 | } 264 | 265 | /* Literal.Number */ 266 | 267 | .highlight .s { 268 | color: #e6db74 269 | } 270 | 271 | /* Literal.String */ 272 | 273 | .highlight .na { 274 | color: #a6e22e 275 | } 276 | 277 | /* Name.Attribute */ 278 | 279 | .highlight .nb { 280 | color: #f8f8f2 281 | } 282 | 283 | /* Name.Builtin */ 284 | 285 | .highlight .nc { 286 | color: #a6e22e 287 | } 288 | 289 | /* Name.Class */ 290 | 291 | .highlight .no { 292 | color: #66d9ef 293 | } 294 | 295 | /* Name.Constant */ 296 | 297 | .highlight .nd { 298 | color: #a6e22e 299 | } 300 | 301 | /* Name.Decorator */ 302 | 303 | .highlight .ni { 304 | color: #f8f8f2 305 | } 306 | 307 | /* Name.Entity */ 308 | 309 | .highlight .ne { 310 | color: #a6e22e 311 | } 312 | 313 | /* Name.Exception */ 314 | 315 | .highlight .nf { 316 | color: #a6e22e 317 | } 318 | 319 | /* Name.Function */ 320 | 321 | .highlight .nl { 322 | color: #f8f8f2 323 | } 324 | 325 | /* Name.Label */ 326 | 327 | .highlight .nn { 328 | color: #f8f8f2 329 | } 330 | 331 | /* Name.Namespace */ 332 | 333 | .highlight .nx { 334 | color: #a6e22e 335 | } 336 | 337 | /* Name.Other */ 338 | 339 | .highlight .py { 340 | color: #f8f8f2 341 | } 342 | 343 | /* Name.Property */ 344 | 345 | .highlight .nt { 346 | color: #f92672 347 | } 348 | 349 | /* Name.Tag */ 350 | 351 | .highlight .nv { 352 | color: #f8f8f2 353 | } 354 | 355 | /* Name.Variable */ 356 | 357 | .highlight .ow { 358 | color: #f92672 359 | } 360 | 361 | /* BinaryOperator.Word */ 362 | 363 | .highlight .w { 364 | color: #f8f8f2 365 | } 366 | 367 | /* Text.Whitespace */ 368 | 369 | .highlight .mf { 370 | color: #ae81ff 371 | } 372 | 373 | /* Literal.Number.Float */ 374 | 375 | .highlight .mh { 376 | color: #ae81ff 377 | } 378 | 379 | /* Literal.Number.Hex */ 380 | 381 | .highlight .mi { 382 | color: #ae81ff 383 | } 384 | 385 | /* Literal.Number.Integer */ 386 | 387 | .highlight .mo { 388 | color: #ae81ff 389 | } 390 | 391 | /* Literal.Number.Oct */ 392 | 393 | .highlight .sb { 394 | color: #e6db74 395 | } 396 | 397 | /* Literal.String.Backtick */ 398 | 399 | .highlight .sc { 400 | color: #e6db74 401 | } 402 | 403 | /* Literal.String.Char */ 404 | 405 | .highlight .sd { 406 | color: #e6db74 407 | } 408 | 409 | /* Literal.String.Doc */ 410 | 411 | .highlight .s2 { 412 | color: #e6db74 413 | } 414 | 415 | /* Literal.String.Double */ 416 | 417 | .highlight .se { 418 | color: #ae81ff 419 | } 420 | 421 | /* Literal.String.Escape */ 422 | 423 | .highlight .sh { 424 | color: #e6db74 425 | } 426 | 427 | /* Literal.String.Heredoc */ 428 | 429 | .highlight .si { 430 | color: #e6db74 431 | } 432 | 433 | /* Literal.String.Interpol */ 434 | 435 | .highlight .sx { 436 | color: #e6db74 437 | } 438 | 439 | /* Literal.String.Other */ 440 | 441 | .highlight .sr { 442 | color: #e6db74 443 | } 444 | 445 | /* Literal.String.Regex */ 446 | 447 | .highlight .s1 { 448 | color: #e6db74 449 | } 450 | 451 | /* Literal.String.Single */ 452 | 453 | .highlight .ss { 454 | color: #e6db74 455 | } 456 | 457 | /* Literal.String.Symbol */ 458 | 459 | .highlight .bp { 460 | color: #f8f8f2 461 | } 462 | 463 | /* Name.Builtin.Pseudo */ 464 | 465 | .highlight .vc { 466 | color: #f8f8f2 467 | } 468 | 469 | /* Name.Variable.Class */ 470 | 471 | .highlight .vg { 472 | color: #f8f8f2 473 | } 474 | 475 | /* Name.Variable.Global */ 476 | 477 | .highlight .vi { 478 | color: #f8f8f2 479 | } 480 | 481 | /* Name.Variable.Instance */ 482 | 483 | .highlight .il { 484 | color: #ae81ff 485 | } 486 | 487 | /* Literal.Number.Integer.Long */ 488 | 489 | .highlight .gh {} 490 | 491 | /* Generic Heading & Diff Header */ 492 | 493 | .highlight .gu { 494 | color: #75715e; 495 | } 496 | 497 | /* Generic.Subheading & Diff Unified/Comment? */ 498 | 499 | .highlight .gd { 500 | color: #f92672; 501 | } 502 | 503 | /* Generic.Deleted & Diff Deleted */ 504 | 505 | .highlight .gi { 506 | color: #a6e22e; 507 | } 508 | 509 | /* Generic.Inserted & Diff Inserted */ 510 | 511 | code.highlighter-rouge { 512 | border: 1px solid rgba(255, 255, 255, .1); 513 | padding: 0 .3em; 514 | border-radius: 3px; 515 | font-size: 1.1em; 516 | } 517 | 518 | pre code { 519 | overflow-x: auto; 520 | display: block; 521 | } -------------------------------------------------------------------------------- /docs/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easafe/purescript-droplet/1b5d86c10b765b615759f2ef021e730735038507/docs/favicon.ico -------------------------------------------------------------------------------- /docs/index.md: -------------------------------------------------------------------------------- 1 | --- 2 | layout: default 3 | title: Getting started 4 | --- 5 | 6 | ## Composable, type-safe eDSL and query mapper for PureScript targeting PostgreSQL 7 | 8 | Droplet is a bit different from other PureScript (or Haskell) SQL libraries. There is no monads, functions to yield columns, or a higher level API abstracting away from the generated SQL query. Instead, the eDSL is made out exclusively of combinators (nearly) identical to their SQL statement counterparts. Likewise, the output of a query is automatically inferred from its projection with almost no need for type annotations or boilerplate mapping type class instances. 9 | 10 | This guide first covers the syntax used by the eDSL, how to run queries using a query mapper, and finally migrations. The eDSL aims to make the keywords you already know (SELECT, WHERE, ORDER BY, JOIN, etc) composable. Likewise, the query mapper is independent from the eDSL -- it can be also used for unsafe queries too. Migrations are accomplished by API or CLI. 11 | 12 | Installation: 13 | 14 | ``` 15 | npm i big-integer pg @easafe/pebble 16 | 17 | spago install droplet 18 | ``` 19 | 20 | If you'd like to try the code examples, the following schema will be used throughout 21 | 22 | ```sql 23 | create table users ( 24 | id integer generated always as identity primary key, 25 | name text not null, 26 | birthday date null 27 | ); 28 | 29 | create table messages ( 30 | id integer generated always as identity primary key, 31 | sender integer not null, 32 | recipient integer not null, 33 | date timestamptz default now(), 34 | 35 | constraint sender_user foreign key (sender) references users(id), 36 | constraint recipient_user foreign key (recipient) references users(id) 37 | ); 38 | ``` 39 | 40 | 41 | Next: eDSL 42 | -------------------------------------------------------------------------------- /docs/mapper.md: -------------------------------------------------------------------------------- 1 | --- 2 | layout: default 3 | title: Query mapper 4 | --- 5 | 6 | ## Querying the database 7 | 8 | Essentially, the query mapper runs a given query and converts its output into records. The first step is to create a connection pool 9 | 10 | ```haskell 11 | newPool :: Configuration -> Effect Pool 12 | ``` 13 | 14 | and use one of either 15 | 16 | ```haskell 17 | withConnection :: forall a. Pool -> (Either PgError Connection -> Aff a) -> Aff a 18 | 19 | withTransaction :: forall a. Pool -> (Connection -> Aff a) -> Aff (Either PgError a) 20 | ``` 21 | 22 | to obtain a connection. The output of a query always matches the `projection` of a SELECT or RETURNING statement; otherwise, queries with no output (e.g., DELETE or UPDATE) yield `Unit`. The primary querying functions to access the database are 23 | 24 | ```haskell 25 | query :: 26 | forall q projection pro. 27 | ToQuery q projection => 28 | RowToList projection pro => 29 | FromResult pro (Record projection) => 30 | Connection -> 31 | q -> 32 | Aff (Either PgError (Array (Record projection))) 33 | 34 | execute :: forall q. ToQuery q () => Connection -> q -> Aff (Maybe PgError) 35 | 36 | single :: 37 | forall q projection pro. 38 | ToQuery q projection => 39 | RowToList projection pro => 40 | FromResult pro (Record projection) => 41 | Connection -> 42 | q -> 43 | Aff (Either PgError (Maybe (Record projection))) 44 | ``` 45 | 46 | `query` fetches an arbitrary number of results. `execute` is intended for queries without an output. `single` is for queries with exactly zero or one results. 47 | 48 | Because queries can be freely composed, a few checks can only be performed when using one of the querying functions above. This includes checking for out of scope column access, ill formed aggregations, invalid top levels, etc. 49 | 50 | For the mapping to work, all columns names in a projection must be unique -- same reason as why literals and functions must be aliased. Since names are always quoted by the query mapper, it is safe to use any casing in columns or aliases. This also means table aliases are not stripped. For example, running the query `SELECT u.id FROM users AS u` on Postgres renders columns as "id"; the Droplet equivalent `select (u ... id) # from (users # as u)` results in the record `{ "u.id" :: Int }`. 51 | 52 | ## Unsafe queries 53 | 54 | For each querying function, there is an unsafe counterpart that accepts raw SQL strings 55 | 56 | ```haskell 57 | unsafeQuery :: 58 | forall projection pro parameters pra. 59 | RowToList projection pro => 60 | RowToList parameters pra => 61 | ToParameters parameters pra => 62 | FromResult pro (Record projection) => 63 | Connection -> 64 | Maybe Plan -> 65 | String -> 66 | Record parameters -> 67 | Aff (Either PgError (Array (Record projection))) 68 | 69 | unsafeExecute :: 70 | forall parameters pra. 71 | RowToList parameters pra => 72 | ToParameters parameters pra => 73 | Connection -> 74 | Maybe Plan -> 75 | String -> 76 | Record parameters -> 77 | Aff (Maybe PgError) 78 | 79 | unsafeSingle :: 80 | forall parameters pra projection pro. 81 | RowToList parameters pra => 82 | ToParameters parameters pra => 83 | RowToList projection pro => 84 | FromResult pro (Record projection) => 85 | Connection -> 86 | Maybe Plan -> 87 | String -> 88 | Record parameters -> 89 | Aff (Either PgError (Maybe (Record projection))) 90 | ``` 91 | 92 | A type annotation will likely be required to determine the output records. The `Maybe Plan` parameter is for prepared statements. To add parameters to your query, use the notation `@name` and include a matching key in the `Record parameters` argument. For example 93 | 94 | ```haskell 95 | selectUnsafe :: Aff (Either PgError (Array {id :: Int})) 96 | selectUnsafe = withConnection pool $ \c -> do 97 | ... 98 | unsafeQuery connection Nothing "SELECT name FROM users WHERE id = @id" { id : 34 } 99 | 100 | selectUnsafe :: Aff (Maybe PgError) 101 | selectUnsafe = withConnection pool $ \c -> do 102 | ... 103 | unsafeExecute connection Nothing "INSERT INTO users (name) VALUES (@name)" { name : "mary" } 104 | ``` 105 | 106 | ## Type mapping 107 | 108 | Most common types (integers, strings, dates, etc.) work out of the box. In case the default behavior isn't desirable, or you need to map columns to custom types, the type classes `FromValue` and `ToValue` can perform conversions. `FromValue` translates `Foreign` SQL values to PureScript; `ToValue` parses PureScript values into `Foreign`. All parameters must also have `ToValue` instances. 109 | 110 | 111 | 112 | -------------------------------------------------------------------------------- /docs/migrations.md: -------------------------------------------------------------------------------- 1 | --- 2 | layout: default 3 | title: Migrations 4 | --- 5 | -------------------------------------------------------------------------------- /package-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-droplet", 3 | "lockfileVersion": 2, 4 | "requires": true, 5 | "packages": { 6 | "": { 7 | "name": "purescript-droplet", 8 | "dependencies": { 9 | "big-integer": "^1.6.48", 10 | "pg": "^8.6.0" 11 | } 12 | }, 13 | "node_modules/big-integer": { 14 | "version": "1.6.48", 15 | "resolved": "https://registry.npmjs.org/big-integer/-/big-integer-1.6.48.tgz", 16 | "integrity": "sha512-j51egjPa7/i+RdiRuJbPdJ2FIUYYPhvYLjzoYbcMMm62ooO6F94fETG4MTs46zPAF9Brs04OajboA/qTGuz78w==", 17 | "engines": { 18 | "node": ">=0.6" 19 | } 20 | }, 21 | "node_modules/buffer-writer": { 22 | "version": "2.0.0", 23 | "resolved": "https://registry.npmjs.org/buffer-writer/-/buffer-writer-2.0.0.tgz", 24 | "integrity": "sha512-a7ZpuTZU1TRtnwyCNW3I5dc0wWNC3VR9S++Ewyk2HHZdrO3CQJqSpd+95Us590V6AL7JqUAH2IwZ/398PmNFgw==", 25 | "engines": { 26 | "node": ">=4" 27 | } 28 | }, 29 | "node_modules/inherits": { 30 | "version": "2.0.4", 31 | "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.4.tgz", 32 | "integrity": "sha512-k/vGaX4/Yla3WzyMCvTQOXYeIHvqOKtnqBduzTHpzpQZzAskKMhZ2K+EnBiSM9zGSoIFeMpXKxa4dYeZIQqewQ==" 33 | }, 34 | "node_modules/packet-reader": { 35 | "version": "1.0.0", 36 | "resolved": "https://registry.npmjs.org/packet-reader/-/packet-reader-1.0.0.tgz", 37 | "integrity": "sha512-HAKu/fG3HpHFO0AA8WE8q2g+gBJaZ9MG7fcKk+IJPLTGAD6Psw4443l+9DGRbOIh3/aXr7Phy0TjilYivJo5XQ==" 38 | }, 39 | "node_modules/pg": { 40 | "version": "8.6.0", 41 | "resolved": "https://registry.npmjs.org/pg/-/pg-8.6.0.tgz", 42 | "integrity": "sha512-qNS9u61lqljTDFvmk/N66EeGq3n6Ujzj0FFyNMGQr6XuEv4tgNTXvJQTfJdcvGit5p5/DWPu+wj920hAJFI+QQ==", 43 | "dependencies": { 44 | "buffer-writer": "2.0.0", 45 | "packet-reader": "1.0.0", 46 | "pg-connection-string": "^2.5.0", 47 | "pg-pool": "^3.3.0", 48 | "pg-protocol": "^1.5.0", 49 | "pg-types": "^2.1.0", 50 | "pgpass": "1.x" 51 | }, 52 | "engines": { 53 | "node": ">= 8.0.0" 54 | }, 55 | "peerDependencies": { 56 | "pg-native": ">=2.0.0" 57 | }, 58 | "peerDependenciesMeta": { 59 | "pg-native": { 60 | "optional": true 61 | } 62 | } 63 | }, 64 | "node_modules/pg-connection-string": { 65 | "version": "2.5.0", 66 | "resolved": "https://registry.npmjs.org/pg-connection-string/-/pg-connection-string-2.5.0.tgz", 67 | "integrity": "sha512-r5o/V/ORTA6TmUnyWZR9nCj1klXCO2CEKNRlVuJptZe85QuhFayC7WeMic7ndayT5IRIR0S0xFxFi2ousartlQ==" 68 | }, 69 | "node_modules/pg-int8": { 70 | "version": "1.0.1", 71 | "resolved": "https://registry.npmjs.org/pg-int8/-/pg-int8-1.0.1.tgz", 72 | "integrity": "sha512-WCtabS6t3c8SkpDBUlb1kjOs7l66xsGdKpIPZsg4wR+B3+u9UAum2odSsF9tnvxg80h4ZxLWMy4pRjOsFIqQpw==", 73 | "engines": { 74 | "node": ">=4.0.0" 75 | } 76 | }, 77 | "node_modules/pg-pool": { 78 | "version": "3.3.0", 79 | "resolved": "https://registry.npmjs.org/pg-pool/-/pg-pool-3.3.0.tgz", 80 | "integrity": "sha512-0O5huCql8/D6PIRFAlmccjphLYWC+JIzvUhSzXSpGaf+tjTZc4nn+Lr7mLXBbFJfvwbP0ywDv73EiaBsxn7zdg==", 81 | "peerDependencies": { 82 | "pg": ">=8.0" 83 | } 84 | }, 85 | "node_modules/pg-protocol": { 86 | "version": "1.5.0", 87 | "resolved": "https://registry.npmjs.org/pg-protocol/-/pg-protocol-1.5.0.tgz", 88 | "integrity": "sha512-muRttij7H8TqRNu/DxrAJQITO4Ac7RmX3Klyr/9mJEOBeIpgnF8f9jAfRz5d3XwQZl5qBjF9gLsUtMPJE0vezQ==" 89 | }, 90 | "node_modules/pg-types": { 91 | "version": "2.2.0", 92 | "resolved": "https://registry.npmjs.org/pg-types/-/pg-types-2.2.0.tgz", 93 | "integrity": "sha512-qTAAlrEsl8s4OiEQY69wDvcMIdQN6wdz5ojQiOy6YRMuynxenON0O5oCpJI6lshc6scgAY8qvJ2On/p+CXY0GA==", 94 | "dependencies": { 95 | "pg-int8": "1.0.1", 96 | "postgres-array": "~2.0.0", 97 | "postgres-bytea": "~1.0.0", 98 | "postgres-date": "~1.0.4", 99 | "postgres-interval": "^1.1.0" 100 | }, 101 | "engines": { 102 | "node": ">=4" 103 | } 104 | }, 105 | "node_modules/pgpass": { 106 | "version": "1.0.4", 107 | "resolved": "https://registry.npmjs.org/pgpass/-/pgpass-1.0.4.tgz", 108 | "integrity": "sha512-YmuA56alyBq7M59vxVBfPJrGSozru8QAdoNlWuW3cz8l+UX3cWge0vTvjKhsSHSJpo3Bom8/Mm6hf0TR5GY0+w==", 109 | "dependencies": { 110 | "split2": "^3.1.1" 111 | } 112 | }, 113 | "node_modules/postgres-array": { 114 | "version": "2.0.0", 115 | "resolved": "https://registry.npmjs.org/postgres-array/-/postgres-array-2.0.0.tgz", 116 | "integrity": "sha512-VpZrUqU5A69eQyW2c5CA1jtLecCsN2U/bD6VilrFDWq5+5UIEVO7nazS3TEcHf1zuPYO/sqGvUvW62g86RXZuA==", 117 | "engines": { 118 | "node": ">=4" 119 | } 120 | }, 121 | "node_modules/postgres-bytea": { 122 | "version": "1.0.0", 123 | "resolved": "https://registry.npmjs.org/postgres-bytea/-/postgres-bytea-1.0.0.tgz", 124 | "integrity": "sha1-AntTPAqokOJtFy1Hz5zOzFIazTU=", 125 | "engines": { 126 | "node": ">=0.10.0" 127 | } 128 | }, 129 | "node_modules/postgres-date": { 130 | "version": "1.0.7", 131 | "resolved": "https://registry.npmjs.org/postgres-date/-/postgres-date-1.0.7.tgz", 132 | "integrity": "sha512-suDmjLVQg78nMK2UZ454hAG+OAW+HQPZ6n++TNDUX+L0+uUlLywnoxJKDou51Zm+zTCjrCl0Nq6J9C5hP9vK/Q==", 133 | "engines": { 134 | "node": ">=0.10.0" 135 | } 136 | }, 137 | "node_modules/postgres-interval": { 138 | "version": "1.2.0", 139 | "resolved": "https://registry.npmjs.org/postgres-interval/-/postgres-interval-1.2.0.tgz", 140 | "integrity": "sha512-9ZhXKM/rw350N1ovuWHbGxnGh/SNJ4cnxHiM0rxE4VN41wsg8P8zWn9hv/buK00RP4WvlOyr/RBDiptyxVbkZQ==", 141 | "dependencies": { 142 | "xtend": "^4.0.0" 143 | }, 144 | "engines": { 145 | "node": ">=0.10.0" 146 | } 147 | }, 148 | "node_modules/safe-buffer": { 149 | "version": "5.1.2", 150 | "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.1.2.tgz", 151 | "integrity": "sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g==" 152 | }, 153 | "node_modules/split2": { 154 | "version": "3.2.2", 155 | "resolved": "https://registry.npmjs.org/split2/-/split2-3.2.2.tgz", 156 | "integrity": "sha512-9NThjpgZnifTkJpzTZ7Eue85S49QwpNhZTq6GRJwObb6jnLFNGB7Qm73V5HewTROPyxD0C29xqmaI68bQtV+hg==", 157 | "dependencies": { 158 | "readable-stream": "^3.0.0" 159 | } 160 | }, 161 | "node_modules/split2/node_modules/readable-stream": { 162 | "version": "3.6.0", 163 | "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.0.tgz", 164 | "integrity": "sha512-BViHy7LKeTz4oNnkcLJ+lVSL6vpiFeX6/d3oSH8zCW7UxP2onchk+vTGB143xuFjHS3deTgkKoXXymXqymiIdA==", 165 | "dependencies": { 166 | "inherits": "^2.0.3", 167 | "string_decoder": "^1.1.1", 168 | "util-deprecate": "^1.0.1" 169 | }, 170 | "engines": { 171 | "node": ">= 6" 172 | } 173 | }, 174 | "node_modules/string_decoder": { 175 | "version": "1.1.1", 176 | "resolved": "https://registry.npmjs.org/string_decoder/-/string_decoder-1.1.1.tgz", 177 | "integrity": "sha512-n/ShnvDi6FHbbVfviro+WojiFzv+s8MPMHBczVePfUpDJLwoLT0ht1l4YwBCbi8pJAveEEdnkHyPyTP/mzRfwg==", 178 | "dependencies": { 179 | "safe-buffer": "~5.1.0" 180 | } 181 | }, 182 | "node_modules/util-deprecate": { 183 | "version": "1.0.2", 184 | "resolved": "https://registry.npmjs.org/util-deprecate/-/util-deprecate-1.0.2.tgz", 185 | "integrity": "sha1-RQ1Nyfpw3nMnYvvS1KKJgUGaDM8=" 186 | }, 187 | "node_modules/xtend": { 188 | "version": "4.0.2", 189 | "resolved": "https://registry.npmjs.org/xtend/-/xtend-4.0.2.tgz", 190 | "integrity": "sha512-LKYU1iAXJXUgAXn9URjiu+MWhyUXHsvfp7mcuYm9dSUKK0/CjtrUwFAxD82/mCWbtLsGjFIad0wIsod4zrTAEQ==", 191 | "engines": { 192 | "node": ">=0.4" 193 | } 194 | } 195 | }, 196 | "dependencies": { 197 | "big-integer": { 198 | "version": "1.6.48", 199 | "resolved": "https://registry.npmjs.org/big-integer/-/big-integer-1.6.48.tgz", 200 | "integrity": "sha512-j51egjPa7/i+RdiRuJbPdJ2FIUYYPhvYLjzoYbcMMm62ooO6F94fETG4MTs46zPAF9Brs04OajboA/qTGuz78w==" 201 | }, 202 | "buffer-writer": { 203 | "version": "2.0.0", 204 | "resolved": "https://registry.npmjs.org/buffer-writer/-/buffer-writer-2.0.0.tgz", 205 | "integrity": "sha512-a7ZpuTZU1TRtnwyCNW3I5dc0wWNC3VR9S++Ewyk2HHZdrO3CQJqSpd+95Us590V6AL7JqUAH2IwZ/398PmNFgw==" 206 | }, 207 | "inherits": { 208 | "version": "2.0.4", 209 | "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.4.tgz", 210 | "integrity": "sha512-k/vGaX4/Yla3WzyMCvTQOXYeIHvqOKtnqBduzTHpzpQZzAskKMhZ2K+EnBiSM9zGSoIFeMpXKxa4dYeZIQqewQ==" 211 | }, 212 | "packet-reader": { 213 | "version": "1.0.0", 214 | "resolved": "https://registry.npmjs.org/packet-reader/-/packet-reader-1.0.0.tgz", 215 | "integrity": "sha512-HAKu/fG3HpHFO0AA8WE8q2g+gBJaZ9MG7fcKk+IJPLTGAD6Psw4443l+9DGRbOIh3/aXr7Phy0TjilYivJo5XQ==" 216 | }, 217 | "pg": { 218 | "version": "8.6.0", 219 | "resolved": "https://registry.npmjs.org/pg/-/pg-8.6.0.tgz", 220 | "integrity": "sha512-qNS9u61lqljTDFvmk/N66EeGq3n6Ujzj0FFyNMGQr6XuEv4tgNTXvJQTfJdcvGit5p5/DWPu+wj920hAJFI+QQ==", 221 | "requires": { 222 | "buffer-writer": "2.0.0", 223 | "packet-reader": "1.0.0", 224 | "pg-connection-string": "^2.5.0", 225 | "pg-pool": "^3.3.0", 226 | "pg-protocol": "^1.5.0", 227 | "pg-types": "^2.1.0", 228 | "pgpass": "1.x" 229 | } 230 | }, 231 | "pg-connection-string": { 232 | "version": "2.5.0", 233 | "resolved": "https://registry.npmjs.org/pg-connection-string/-/pg-connection-string-2.5.0.tgz", 234 | "integrity": "sha512-r5o/V/ORTA6TmUnyWZR9nCj1klXCO2CEKNRlVuJptZe85QuhFayC7WeMic7ndayT5IRIR0S0xFxFi2ousartlQ==" 235 | }, 236 | "pg-int8": { 237 | "version": "1.0.1", 238 | "resolved": "https://registry.npmjs.org/pg-int8/-/pg-int8-1.0.1.tgz", 239 | "integrity": "sha512-WCtabS6t3c8SkpDBUlb1kjOs7l66xsGdKpIPZsg4wR+B3+u9UAum2odSsF9tnvxg80h4ZxLWMy4pRjOsFIqQpw==" 240 | }, 241 | "pg-pool": { 242 | "version": "3.3.0", 243 | "resolved": "https://registry.npmjs.org/pg-pool/-/pg-pool-3.3.0.tgz", 244 | "integrity": "sha512-0O5huCql8/D6PIRFAlmccjphLYWC+JIzvUhSzXSpGaf+tjTZc4nn+Lr7mLXBbFJfvwbP0ywDv73EiaBsxn7zdg==", 245 | "requires": {} 246 | }, 247 | "pg-protocol": { 248 | "version": "1.5.0", 249 | "resolved": "https://registry.npmjs.org/pg-protocol/-/pg-protocol-1.5.0.tgz", 250 | "integrity": "sha512-muRttij7H8TqRNu/DxrAJQITO4Ac7RmX3Klyr/9mJEOBeIpgnF8f9jAfRz5d3XwQZl5qBjF9gLsUtMPJE0vezQ==" 251 | }, 252 | "pg-types": { 253 | "version": "2.2.0", 254 | "resolved": "https://registry.npmjs.org/pg-types/-/pg-types-2.2.0.tgz", 255 | "integrity": "sha512-qTAAlrEsl8s4OiEQY69wDvcMIdQN6wdz5ojQiOy6YRMuynxenON0O5oCpJI6lshc6scgAY8qvJ2On/p+CXY0GA==", 256 | "requires": { 257 | "pg-int8": "1.0.1", 258 | "postgres-array": "~2.0.0", 259 | "postgres-bytea": "~1.0.0", 260 | "postgres-date": "~1.0.4", 261 | "postgres-interval": "^1.1.0" 262 | } 263 | }, 264 | "pgpass": { 265 | "version": "1.0.4", 266 | "resolved": "https://registry.npmjs.org/pgpass/-/pgpass-1.0.4.tgz", 267 | "integrity": "sha512-YmuA56alyBq7M59vxVBfPJrGSozru8QAdoNlWuW3cz8l+UX3cWge0vTvjKhsSHSJpo3Bom8/Mm6hf0TR5GY0+w==", 268 | "requires": { 269 | "split2": "^3.1.1" 270 | } 271 | }, 272 | "postgres-array": { 273 | "version": "2.0.0", 274 | "resolved": "https://registry.npmjs.org/postgres-array/-/postgres-array-2.0.0.tgz", 275 | "integrity": "sha512-VpZrUqU5A69eQyW2c5CA1jtLecCsN2U/bD6VilrFDWq5+5UIEVO7nazS3TEcHf1zuPYO/sqGvUvW62g86RXZuA==" 276 | }, 277 | "postgres-bytea": { 278 | "version": "1.0.0", 279 | "resolved": "https://registry.npmjs.org/postgres-bytea/-/postgres-bytea-1.0.0.tgz", 280 | "integrity": "sha1-AntTPAqokOJtFy1Hz5zOzFIazTU=" 281 | }, 282 | "postgres-date": { 283 | "version": "1.0.7", 284 | "resolved": "https://registry.npmjs.org/postgres-date/-/postgres-date-1.0.7.tgz", 285 | "integrity": "sha512-suDmjLVQg78nMK2UZ454hAG+OAW+HQPZ6n++TNDUX+L0+uUlLywnoxJKDou51Zm+zTCjrCl0Nq6J9C5hP9vK/Q==" 286 | }, 287 | "postgres-interval": { 288 | "version": "1.2.0", 289 | "resolved": "https://registry.npmjs.org/postgres-interval/-/postgres-interval-1.2.0.tgz", 290 | "integrity": "sha512-9ZhXKM/rw350N1ovuWHbGxnGh/SNJ4cnxHiM0rxE4VN41wsg8P8zWn9hv/buK00RP4WvlOyr/RBDiptyxVbkZQ==", 291 | "requires": { 292 | "xtend": "^4.0.0" 293 | } 294 | }, 295 | "safe-buffer": { 296 | "version": "5.1.2", 297 | "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.1.2.tgz", 298 | "integrity": "sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g==" 299 | }, 300 | "split2": { 301 | "version": "3.2.2", 302 | "resolved": "https://registry.npmjs.org/split2/-/split2-3.2.2.tgz", 303 | "integrity": "sha512-9NThjpgZnifTkJpzTZ7Eue85S49QwpNhZTq6GRJwObb6jnLFNGB7Qm73V5HewTROPyxD0C29xqmaI68bQtV+hg==", 304 | "requires": { 305 | "readable-stream": "^3.0.0" 306 | }, 307 | "dependencies": { 308 | "readable-stream": { 309 | "version": "3.6.0", 310 | "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.0.tgz", 311 | "integrity": "sha512-BViHy7LKeTz4oNnkcLJ+lVSL6vpiFeX6/d3oSH8zCW7UxP2onchk+vTGB143xuFjHS3deTgkKoXXymXqymiIdA==", 312 | "requires": { 313 | "inherits": "^2.0.3", 314 | "string_decoder": "^1.1.1", 315 | "util-deprecate": "^1.0.1" 316 | } 317 | } 318 | } 319 | }, 320 | "string_decoder": { 321 | "version": "1.1.1", 322 | "resolved": "https://registry.npmjs.org/string_decoder/-/string_decoder-1.1.1.tgz", 323 | "integrity": "sha512-n/ShnvDi6FHbbVfviro+WojiFzv+s8MPMHBczVePfUpDJLwoLT0ht1l4YwBCbi8pJAveEEdnkHyPyTP/mzRfwg==", 324 | "requires": { 325 | "safe-buffer": "~5.1.0" 326 | } 327 | }, 328 | "util-deprecate": { 329 | "version": "1.0.2", 330 | "resolved": "https://registry.npmjs.org/util-deprecate/-/util-deprecate-1.0.2.tgz", 331 | "integrity": "sha1-RQ1Nyfpw3nMnYvvS1KKJgUGaDM8=" 332 | }, 333 | "xtend": { 334 | "version": "4.0.2", 335 | "resolved": "https://registry.npmjs.org/xtend/-/xtend-4.0.2.tgz", 336 | "integrity": "sha512-LKYU1iAXJXUgAXn9URjiu+MWhyUXHsvfp7mcuYm9dSUKK0/CjtrUwFAxD82/mCWbtLsGjFIad0wIsod4zrTAEQ==" 337 | } 338 | } 339 | } 340 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-droplet", 3 | "dependencies": { 4 | "big-integer": "^1.6.48", 5 | "pg": "^8.7.1" 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | {- 2 | Welcome to your new Dhall package-set! 3 | 4 | Below are instructions for how to edit this file for most use 5 | cases, so that you don't need to know Dhall to use it. 6 | 7 | ## Warning: Don't Move This Top-Level Comment! 8 | 9 | Due to how `dhall format` currently works, this comment's 10 | instructions cannot appear near corresponding sections below 11 | because `dhall format` will delete the comment. However, 12 | it will not delete a top-level comment like this one. 13 | 14 | ## Use Cases 15 | 16 | Most will want to do one or both of these options: 17 | 1. Override/Patch a package's dependency 18 | 2. Add a package not already in the default package set 19 | 20 | This file will continue to work whether you use one or both options. 21 | Instructions for each option are explained below. 22 | 23 | ### Overriding/Patching a package 24 | 25 | Purpose: 26 | - Change a package's dependency to a newer/older release than the 27 | default package set's release 28 | - Use your own modified version of some dependency that may 29 | include new API, changed API, removed API by 30 | using your custom git repo of the library rather than 31 | the package set's repo 32 | 33 | Syntax: 34 | where `entityName` is one of the following: 35 | - dependencies 36 | - repo 37 | - version 38 | ------------------------------- 39 | let upstream = -- 40 | in upstream 41 | with packageName.entityName = "new value" 42 | ------------------------------- 43 | 44 | Example: 45 | ------------------------------- 46 | let upstream = -- 47 | in upstream 48 | with halogen.version = "master" 49 | with halogen.repo = "https://example.com/path/to/git/repo.git" 50 | 51 | with halogen-vdom.version = "v4.0.0" 52 | ------------------------------- 53 | 54 | ### Additions 55 | 56 | Purpose: 57 | - Add packages that aren't already included in the default package set 58 | 59 | Syntax: 60 | where `` is: 61 | - a tag (i.e. "v4.0.0") 62 | - a branch (i.e. "master") 63 | - commit hash (i.e. "701f3e44aafb1a6459281714858fadf2c4c2a977") 64 | ------------------------------- 65 | let upstream = -- 66 | in upstream 67 | with new-package-"name" = 68 | { dependencies = 69 | [ "dependency1" 70 | , "dependency2" 71 | ] 72 | , repo = 73 | "https://example.com/path/to/git/repo.git" 74 | , version = 75 | "" 76 | } 77 | ------------------------------- 78 | 79 | Example: 80 | ------------------------------- 81 | let upstream = -- 82 | in upstream 83 | with benchotron = 84 | { dependencies = 85 | [ "arrays" 86 | , "exists" 87 | , "profunctor" 88 | , "strings" 89 | , "quickcheck" 90 | , "lcg" 91 | , "transformers" 92 | , "foldable-traversable" 93 | , "exceptions" 94 | , "node-fs" 95 | , "node-buffer" 96 | , "node-readline" 97 | , "datetime" 98 | , "now" 99 | ] 100 | , repo = 101 | "https://github.com/hdgarrood/purescript-benchotron.git" 102 | , version = 103 | "v7.0.0" 104 | } 105 | ------------------------------- 106 | -} 107 | let upstream = 108 | https://github.com/purescript/package-sets/releases/download/psc-0.15.0-20220504/packages.dhall 109 | sha256:fd37736ecaa24491c907af6a6422156417f21fbf25763de19f65bd641e8340d3 110 | 111 | in upstream 112 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | {- 2 | Welcome to a Spago project! 3 | You can edit this file as you like. 4 | -} 5 | { name = "droplet" 6 | , license = "MIT" 7 | , repository = "https://github.com/easafe/purescript-droplet" 8 | , dependencies = 9 | [ "aff" 10 | , "arrays" 11 | , "bifunctors" 12 | , "bigints" 13 | , "datetime" 14 | , "debug" 15 | , "effect" 16 | , "either" 17 | , "enums" 18 | , "exceptions" 19 | , "foldable-traversable" 20 | , "foreign" 21 | , "foreign-object" 22 | , "integers" 23 | , "maybe" 24 | , "newtype" 25 | , "nonempty" 26 | , "nullable" 27 | , "ordered-collections" 28 | , "partial" 29 | , "prelude" 30 | , "profunctor" 31 | , "record" 32 | , "spec" 33 | , "strings" 34 | , "transformers" 35 | , "tuples" 36 | , "type-equality" 37 | , "typelevel-prelude" 38 | , "unsafe-coerce" 39 | ] 40 | , packages = ./packages.dhall 41 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 42 | } 43 | -------------------------------------------------------------------------------- /src/Droplet/Driver.purs: -------------------------------------------------------------------------------- 1 | -- | Functions for database access 2 | module Droplet.Driver (module Exported) where 3 | 4 | import Droplet.Language.Internal.Translate (Query) as Exported 5 | 6 | import Droplet.Driver.Internal.Query (class FromResult, Connection, PGErrorDetail, PgError(..), connect, execute, query, single, toResult, withConnection, withTransaction) as Exported 7 | 8 | import Droplet.Driver.Internal.Pool (Configuration, Database, Pool, defaultConfiguration, newPool) as Exported -------------------------------------------------------------------------------- /src/Droplet/Driver/Internal/Migration.purs: -------------------------------------------------------------------------------- 1 | module Droplet.Driver.Internal.Migration where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either(..)) 6 | import Data.Maybe (Maybe(..)) 7 | import Data.Set (Set) 8 | import Data.Set as DS 9 | import Droplet.Driver.Internal.Query (Connection(..)) 10 | import Droplet.Driver.Internal.Query as DDIQ 11 | import Droplet.Language (class ToParameters) 12 | import Effect.Aff (Aff) 13 | import Effect.Aff as EA 14 | import Prim.RowList (class RowToList) 15 | 16 | markAsRun ∷ forall r. Connection → { identifier :: String | r } → Aff Unit 17 | markAsRun connection migration = 18 | execute connection "INSERT INTO __droplet_migrations__ (identifier) VALUES (@identifier)" {identifier: migration.identifier} 19 | 20 | createMigrationTable ∷ Connection → Aff Unit 21 | createMigrationTable connection = execute connection "CREATE TABLE IF NOT EXISTS __droplet_migrations__ (identifier TEXT NOT NULL PRIMARY KEY, run_at TIMESTAMPTZ NOT NULL DEFAULT NOW())" {} 22 | 23 | execute :: forall parameters list. RowToList parameters list => ToParameters parameters list => Connection -> String -> Record parameters -> Aff Unit 24 | execute connection sql parameters = do 25 | output <- DDIQ.unsafeExecute connection Nothing sql parameters 26 | case output of 27 | Just err -> throw err 28 | Nothing -> pure unit 29 | 30 | fetchAlreadyRun ∷ Connection → Aff (Set String) 31 | fetchAlreadyRun connection = do 32 | output ← DDIQ.unsafeQuery connection Nothing "SELECT identifier FROM __droplet_migrations__" {} 33 | case output of 34 | Right (rows :: Array { identifier :: String }) -> pure <<< DS.fromFoldable $ map _.identifier rows 35 | Left err → throw err 36 | 37 | throw err = EA.throwError <<< EA.error $ show err 38 | -------------------------------------------------------------------------------- /src/Droplet/Driver/Internal/Pool.js: -------------------------------------------------------------------------------- 1 | 'use strict'; 2 | 3 | import pg from 'pg'; 4 | 5 | export function newPool_(config) { 6 | return function() { 7 | return new pg.Pool(config); 8 | }; 9 | } -------------------------------------------------------------------------------- /src/Droplet/Driver/Internal/Pool.purs: -------------------------------------------------------------------------------- 1 | module Droplet.Driver.Internal.Pool (Configuration, Database, Pool, defaultConfiguration, newPool) where 2 | 3 | import Data.Maybe (Maybe(..)) 4 | import Data.Nullable (Nullable, toNullable) 5 | import Effect (Effect) 6 | 7 | -- | PostgreSQL connection pool. 8 | foreign import data Pool ∷ Type 9 | 10 | type Database = String 11 | 12 | -- | Configuration which we actually pass to FFI. 13 | type Configuration' = 14 | { user ∷ Nullable String 15 | , password ∷ Nullable String 16 | , host ∷ Nullable String 17 | , port ∷ Nullable Int 18 | , database ∷ String 19 | , max ∷ Nullable Int 20 | , idleTimeoutMillis ∷ Nullable Int 21 | } 22 | 23 | -- | PostgreSQL connection pool configuration. 24 | type Configuration = 25 | { database ∷ Database 26 | , host ∷ Maybe String 27 | , idleTimeoutMillis ∷ Maybe Int 28 | , max ∷ Maybe Int 29 | , password ∷ Maybe String 30 | , port ∷ Maybe Int 31 | , user ∷ Maybe String 32 | } 33 | 34 | foreign import newPool_ ∷ Configuration' → Effect Pool 35 | 36 | defaultConfiguration ∷ Database → Configuration 37 | defaultConfiguration database = 38 | { database 39 | , host: Nothing 40 | , idleTimeoutMillis: Nothing 41 | , max: Nothing 42 | , password: Nothing 43 | , port: Nothing 44 | , user: Nothing 45 | } 46 | 47 | -- | Create a new connection pool. 48 | newPool ∷ Configuration → Effect Pool 49 | newPool cfg = newPool_ 50 | { user: toNullable cfg.user 51 | , password: toNullable cfg.password 52 | , host: toNullable cfg.host 53 | , port: toNullable cfg.port 54 | , database: cfg.database 55 | , max: toNullable cfg.max 56 | , idleTimeoutMillis: toNullable cfg.idleTimeoutMillis 57 | } 58 | 59 | -------------------------------------------------------------------------------- /src/Droplet/Driver/Internal/Query.js: -------------------------------------------------------------------------------- 1 | 'use strict'; 2 | 3 | import pg from 'pg'; 4 | 5 | function id(x) { return x; } 6 | 7 | pg.types.setTypeParser(1082 /* DATE_OID */, id); 8 | pg.types.setTypeParser(1114 /* TIMESTAMP_OID */, id); 9 | pg.types.setTypeParser(1184 /* TIMESTAMPTZ_OID */, id); 10 | 11 | export function connect_(config) { 12 | return function (pool) { 13 | return function (onError, onSuccess) { 14 | var p = pool.connect().then(function (client) { 15 | onSuccess(config.right({ 16 | client: client, 17 | done: function () { 18 | return client.release(); 19 | } 20 | })); 21 | }).catch(function (err) { 22 | var pgError = config.nullableLeft(err); 23 | if (pgError) { 24 | onSuccess(pgError); 25 | } else { 26 | onError(err); 27 | } 28 | }); 29 | 30 | return function (cancelError, cancelerError, cancelerSuccess) { 31 | p.cancel(); 32 | cancelerSuccess(); 33 | }; 34 | }; 35 | }; 36 | } 37 | 38 | export function rawQuery_(config) { 39 | return function (dbHandle) { 40 | return function (rq) { 41 | return function (onError, onSuccess) { 42 | var q = dbHandle.query({ 43 | name: rq.name, 44 | text: rq.text, 45 | values: rq.values 46 | }).then(function (result) { 47 | onSuccess(config.right(result.rows)); 48 | }).catch(function (err) { 49 | var pgError = config.nullableLeft(err); 50 | if (pgError) { 51 | onSuccess(pgError); 52 | } else { 53 | onError(err); 54 | } 55 | }); 56 | 57 | return function (_, __, cancelerSuccess) { 58 | q.cancel(); 59 | cancelerSuccess(); 60 | }; 61 | }; 62 | }; 63 | }; 64 | } 65 | 66 | export function sqlState_(error) { 67 | return error.code || null; 68 | } 69 | 70 | export function errorDetail_(error) { 71 | return { 72 | error: error, 73 | severity: error.severity || '', 74 | code: error.code || '', 75 | message: error.message || '', 76 | detail: error.detail || '', 77 | hint: error.hint || '', 78 | position: error.position || '', 79 | internalPosition: error.internalPosition || '', 80 | internalQuery: error.internalQuery || '', 81 | where_: error.where || '', 82 | schema: error.schema || '', 83 | table: error.table || '', 84 | column: error.column || '', 85 | dataType: error.dataType || '', 86 | constraint: error.constraint || '', 87 | file: error.file || '', 88 | line: error.line || '', 89 | routine: error.routine || '' 90 | }; 91 | } 92 | -------------------------------------------------------------------------------- /src/Droplet/Driver/Internal/Query.purs: -------------------------------------------------------------------------------- 1 | module Droplet.Driver.Internal.Query (class FromResult, Connection(..), Client, PGErrorDetail, PgError(..), connect, execute, query, single, toResult, unsafeExecute, unsafeQuery, unsafeSingle, withConnection, withTransaction) where 2 | 3 | import Prelude 4 | 5 | import Data.Bifunctor as DB 6 | import Data.Either (Either(..)) 7 | import Data.Generic.Rep (class Generic) 8 | import Data.Maybe (Maybe(..), maybe) 9 | import Data.Newtype (class Newtype) 10 | import Data.Nullable (Nullable, null, toMaybe, toNullable) 11 | import Data.Nullable as DN 12 | import Data.Profunctor (lcmap) 13 | import Data.Reflectable (class Reflectable) 14 | import Data.Reflectable as DR 15 | import Data.Show.Generic as DSG 16 | import Data.String (Pattern(..)) 17 | import Data.String as DST 18 | import Data.Symbol (class IsSymbol) 19 | import Data.Traversable as DT 20 | import Droplet.Driver.Internal.Pool (Pool) 21 | import Droplet.Language.Internal.Definition (class FromValue, class ToParameters) 22 | import Droplet.Language.Internal.Definition as DIED 23 | import Droplet.Language.Internal.Syntax (Plan(..)) 24 | import Droplet.Language.Internal.Translate (class ToQuery, Query(..)) 25 | import Droplet.Language.Internal.Translate as DIMQ 26 | import Effect (Effect) 27 | import Effect.Aff (Aff, bracket) 28 | import Effect.Aff as EA 29 | import Effect.Aff.Compat (EffectFnAff) 30 | import Effect.Aff.Compat as EAC 31 | import Effect.Class (liftEffect) 32 | import Effect.Exception (Error) 33 | import Foreign (Foreign) 34 | import Foreign.Object (Object) 35 | import Foreign.Object as FO 36 | import Prim.Row (class Cons, class Lacks) 37 | import Prim.RowList (class RowToList, RowList) 38 | import Prim.RowList as RL 39 | import Record (delete) as Record 40 | import Record as R 41 | import Type.Proxy (Proxy(..)) 42 | import Unsafe.Coerce as UC 43 | 44 | type ConnectResult = 45 | { client ∷ Client 46 | , done ∷ Effect Unit 47 | } 48 | 49 | data PgError 50 | = ClientError Error String 51 | | ConversionError String 52 | | InternalError PGErrorDetail 53 | | OperationalError PGErrorDetail 54 | | ProgrammingError PGErrorDetail 55 | | IntegrityError PGErrorDetail 56 | | DataError PGErrorDetail 57 | | NotSupportedError PGErrorDetail 58 | | QueryCanceledError PGErrorDetail 59 | | TransactionRollbackError PGErrorDetail 60 | | TooManyRows 61 | 62 | type PGErrorDetail = 63 | { severity ∷ String 64 | , code ∷ String 65 | , message ∷ String 66 | , detail ∷ String 67 | , error ∷ Error 68 | , hint ∷ String 69 | , position ∷ String 70 | , internalPosition ∷ String 71 | , internalQuery ∷ String 72 | , where_ ∷ String 73 | , schema ∷ String 74 | , table ∷ String 75 | , column ∷ String 76 | , dataType ∷ String 77 | , constraint ∷ String 78 | , file ∷ String 79 | , line ∷ String 80 | , routine ∷ String 81 | } 82 | 83 | newtype Connection = Connection (Either Pool Client) 84 | 85 | -- | APIs of the `Pool.query` and `Client.query` are the same. 86 | -- | We can dse this polymorphism to simplify ffi. 87 | foreign import data UntaggedConnection ∷ Type 88 | 89 | -- | PostgreSQL connection. 90 | foreign import data Client ∷ Type 91 | 92 | type RawQuery = 93 | { name ∷ Nullable String 94 | , text ∷ String 95 | , values ∷ Array Foreign 96 | } 97 | 98 | -- | Those instances are required for testing. 99 | instance eqPGError ∷ Eq PgError where 100 | eq = case _, _ of 101 | ClientError _ s1, ClientError _ s2 → s1 == s2 102 | ConversionError s1, ConversionError s2 → s1 == s2 103 | InternalError err1, InternalError err2 → eqErr err1 err2 104 | OperationalError err1, OperationalError err2 → eqErr err1 err2 105 | ProgrammingError err1, ProgrammingError err2 → eqErr err1 err2 106 | IntegrityError err1, IntegrityError err2 → eqErr err1 err2 107 | DataError err1, DataError err2 → eqErr err1 err2 108 | NotSupportedError err1, NotSupportedError err2 → eqErr err1 err2 109 | QueryCanceledError err1, QueryCanceledError err2 → eqErr err1 err2 110 | TransactionRollbackError err1, TransactionRollbackError err2 → eqErr err1 err2 111 | _, _ → false 112 | where 113 | eqErr err1 err2 = 114 | let _error = Proxy ∷ Proxy "error" in eq (Record.delete _error err1) (Record.delete _error err2) 115 | 116 | derive instance Generic PgError _ 117 | derive instance Newtype Connection _ 118 | instance Show PgError where 119 | show = DSG.genericShow 120 | 121 | class FromResult (projection ∷ RowList Type) result | projection → result where 122 | toResult ∷ Proxy projection → Object Foreign → Either String result 123 | 124 | instance nilFromResult ∷ FromResult RL.Nil (Record ()) where 125 | toResult _ _ = Right {} 126 | 127 | instance consFromResult ∷ 128 | ( FromValue t 129 | , FromResult rest (Record restProjection) 130 | , IsSymbol name 131 | , Reflectable name String 132 | , Lacks name restProjection 133 | , Cons name t restProjection projection 134 | ) ⇒ 135 | FromResult (RL.Cons name t rest) (Record projection) where 136 | toResult _ raw = case FO.lookup field raw of 137 | Nothing → Left $ "Could not find column matching field: " <> field 138 | Just value → case DIED.fromValue value of 139 | Left error → Left $ "While parsing field " <> field <> ": " <> error 140 | Right converted → map (R.insert name converted) $ toResult (Proxy ∷ Proxy rest) raw 141 | where 142 | name = Proxy ∷ Proxy name 143 | field = DR.reflectType name 144 | 145 | foreign import connect_ ∷ 146 | ∀ a. 147 | { nullableLeft ∷ Error → Nullable (Either PgError ConnectResult) 148 | , right ∷ a → Either PgError ConnectResult 149 | } → 150 | Pool → 151 | EffectFnAff (Either PgError ConnectResult) 152 | 153 | foreign import rawQuery_ ∷ 154 | { nullableLeft ∷ Error → Nullable (Either PgError (Array (Object Foreign))) 155 | , right ∷ Array (Object Foreign) → Either PgError (Array (Object Foreign)) 156 | } → 157 | UntaggedConnection → 158 | RawQuery → 159 | EffectFnAff (Either PgError (Array (Object Foreign))) 160 | 161 | foreign import sqlState_ ∷ Error → Nullable String 162 | foreign import errorDetail_ ∷ Error → PGErrorDetail 163 | 164 | -------------------------------CONNECTING---------------------------------------------- 165 | 166 | -- | Run an action with a connection. The connection is released to the pool 167 | -- | when the action returns. 168 | withClient ∷ ∀ a. Pool → (Either PgError Client → Aff a) → Aff a 169 | withClient p k = bracket (connect p) cleanup run 170 | where 171 | cleanup = case _ of 172 | Left _ → pure unit 173 | Right { done } → liftEffect done 174 | 175 | run = case _ of 176 | Left err → k $ Left err 177 | Right { client } → k $ Right client 178 | 179 | connect ∷ Pool → Aff (Either PgError ConnectResult) 180 | connect = EAC.fromEffectFnAff <<< connect_ rightLeft 181 | 182 | -- | Runs queries with a connection 183 | withConnection ∷ ∀ a. Pool → (Either PgError Connection → Aff a) → Aff a 184 | withConnection p k = withClient p (lcmap (map fromClient) k) 185 | 186 | -- | Runs queries within a transaction 187 | withTransaction ∷ ∀ a. Pool → (Connection → Aff a) → Aff (Either PgError a) 188 | withTransaction pool action = withClient pool case _ of 189 | Right client → withClientTransaction client (action $ fromClient client) 190 | Left err → pure $ Left err 191 | 192 | withClientTransaction ∷ ∀ a. Client → Aff a → Aff (Either PgError a) 193 | withClientTransaction client action = 194 | begin >>= case _ of 195 | Nothing → do 196 | a ← action `EA.catchError` \jsErr → do 197 | void $ rollback 198 | EA.throwError jsErr 199 | commit >>= case _ of 200 | Nothing → pure $ Right a 201 | Just pgError → pure $ Left pgError 202 | Just pgError → pure $ Left pgError 203 | where 204 | connection = fromClient client 205 | begin = unsafeExecute connection Nothing "BEGIN TRANSACTION" {} 206 | commit = unsafeExecute connection Nothing "COMMIT TRANSACTION" {} 207 | rollback = unsafeExecute connection Nothing "ROLLBACK TRANSACTION" {} 208 | 209 | -------------------------------QUERYING---------------------------------- 210 | 211 | -- | Returns an array of `projection` records 212 | query ∷ 213 | ∀ q projection pro. 214 | ToQuery q projection ⇒ 215 | RowToList projection pro ⇒ 216 | FromResult pro (Record projection) ⇒ 217 | Connection → 218 | q → 219 | Aff (Either PgError (Array (Record projection))) 220 | query connection q = do 221 | raw ← rawResults 222 | case raw of 223 | Left error → pure $ Left error 224 | Right r → pure $ DT.traverse (DB.lmap ConversionError <<< toResult (Proxy ∷ Proxy pro)) r 225 | where 226 | Query plan sql parameters = DIMQ.buildQuery q 227 | 228 | rawResults ∷ Aff (Either PgError (Array (Object Foreign))) 229 | rawResults = EAC.fromEffectFnAff $ rawQuery_ rightLeft (toUntaggedHandler connection) 230 | { name: case plan of 231 | Nothing → null 232 | Just (Plan name) → DN.notNull name 233 | , text: sql 234 | , values: parameters 235 | } 236 | 237 | -- | Returns an array of `projection` records from a SQL string 238 | unsafeQuery ∷ 239 | ∀ projection pro parameters pra. 240 | RowToList projection pro ⇒ 241 | RowToList parameters pra ⇒ 242 | ToParameters parameters pra ⇒ 243 | FromResult pro (Record projection) ⇒ 244 | Connection → 245 | Maybe Plan → 246 | String → 247 | Record parameters → 248 | Aff (Either PgError (Array (Record projection))) 249 | unsafeQuery connection plan q parameters = query connection $ DIMQ.unsafeBuildQuery plan q parameters 250 | 251 | -- | Runs a query without results 252 | execute ∷ ∀ q. ToQuery q () ⇒ Connection → q → Aff (Maybe PgError) 253 | execute connection q = do 254 | results ← query connection q 255 | pure $ case results of 256 | Left err → Just err 257 | _ → Nothing 258 | 259 | -- | Runs a query without results from a SQL string 260 | unsafeExecute ∷ 261 | ∀ parameters pra. 262 | RowToList parameters pra ⇒ 263 | ToParameters parameters pra ⇒ 264 | Connection → 265 | Maybe Plan → 266 | String → 267 | Record parameters → 268 | Aff (Maybe PgError) 269 | unsafeExecute connection plan q parameters = do 270 | results ← query connection (DIMQ.unsafeBuildQuery plan q parameters ∷ Query ()) 271 | pure $ case results of 272 | Left err → Just err 273 | _ → Nothing 274 | 275 | -- | Runs a query that returns zero or one results 276 | single ∷ 277 | ∀ q projection pro. 278 | ToQuery q projection ⇒ 279 | RowToList projection pro ⇒ 280 | FromResult pro (Record projection) ⇒ 281 | Connection → 282 | q → 283 | Aff (Either PgError (Maybe (Record projection))) 284 | single connection q = do 285 | results ← query connection q 286 | pure $ case results of 287 | Left err → Left err 288 | Right [] → Right Nothing 289 | Right [ r ] → Right $ Just r 290 | _ → Left TooManyRows 291 | 292 | -- | Runs a query that returns zero or one results from a SQL string 293 | unsafeSingle ∷ 294 | ∀ parameters pra projection pro. 295 | RowToList parameters pra ⇒ 296 | ToParameters parameters pra ⇒ 297 | RowToList projection pro ⇒ 298 | FromResult pro (Record projection) ⇒ 299 | Connection → 300 | Maybe Plan → 301 | String → 302 | Record parameters → 303 | Aff (Either PgError (Maybe (Record projection))) 304 | unsafeSingle connection plan q parameters = single connection $ DIMQ.unsafeBuildQuery plan q parameters 305 | 306 | toUntaggedHandler ∷ Connection → UntaggedConnection 307 | toUntaggedHandler (Connection c) = case c of 308 | Left pool → UC.unsafeCoerce pool 309 | Right client → UC.unsafeCoerce client 310 | 311 | fromClient ∷ Client → Connection 312 | fromClient client = Connection (Right client) 313 | 314 | rightLeft ∷ 315 | ∀ r s t. 316 | { nullableLeft ∷ Error → Nullable (Either PgError r) 317 | , right ∷ t → Either s t 318 | } 319 | rightLeft = 320 | { nullableLeft: toNullable <<< map Left <<< convertError 321 | , right: Right 322 | } 323 | 324 | convertError ∷ Error → Maybe PgError 325 | convertError err = case toMaybe $ sqlState_ err of 326 | Nothing → Nothing 327 | Just sqlState → Just $ convert sqlState $ errorDetail_ err 328 | where 329 | convert ∷ String → PGErrorDetail → PgError 330 | convert s = 331 | if prefix "0A" s then 332 | NotSupportedError 333 | else if prefix "20" s || prefix "21" s then 334 | ProgrammingError 335 | else if prefix "22" s then 336 | DataError 337 | else if prefix "23" s then 338 | IntegrityError 339 | else if prefix "24" s || prefix "25" s then 340 | InternalError 341 | else if prefix "26" s || prefix "27" s || prefix "28" s then 342 | OperationalError 343 | else if prefix "2B" s || prefix "2D" s || prefix "2F" s then 344 | InternalError 345 | else if prefix "34" s then 346 | OperationalError 347 | else if prefix "38" s || prefix "39" s || prefix "3B" s then 348 | InternalError 349 | else if prefix "3D" s || prefix "3F" s then 350 | ProgrammingError 351 | else if prefix "40" s then 352 | TransactionRollbackError 353 | else if prefix "42" s || prefix "44" s then 354 | ProgrammingError 355 | else if s == "57014" then 356 | QueryCanceledError 357 | else if prefix "5" s then 358 | OperationalError 359 | else if prefix "F" s then 360 | InternalError 361 | else if prefix "H" s then 362 | OperationalError 363 | else if prefix "P" s then 364 | InternalError 365 | else if prefix "X" s then 366 | InternalError 367 | else 368 | const $ ClientError err s 369 | 370 | prefix ∷ String → String → Boolean 371 | prefix p = maybe false (_ == 0) <<< DST.indexOf (Pattern p) 372 | -------------------------------------------------------------------------------- /src/Droplet/Driver/Migration.purs: -------------------------------------------------------------------------------- 1 | module Droplet.Driver.Migration (Migration, migrate) where 2 | 3 | import Prelude 4 | 5 | import Data.Array as DA 6 | import Data.Either (Either(..)) 7 | import Data.Foldable as DF 8 | import Data.Maybe (Maybe(..)) 9 | import Data.Set (Set) 10 | import Data.Set as DS 11 | import Debug (spy) 12 | import Droplet.Driver.Internal.Migration as DDIM 13 | import Droplet.Driver.Internal.Pool (Pool) 14 | import Droplet.Driver.Internal.Query (Connection) 15 | import Droplet.Driver.Internal.Query as DDIQ 16 | import Droplet.Language (class ToParameters) 17 | import Effect.Aff (Aff) 18 | import Effect.Aff as EA 19 | import Prim.RowList (class RowToList) 20 | 21 | -- | Type for individual migrations 22 | -- | 23 | -- | - `up` performs a migration 24 | -- | - `down` reverts a migration 25 | -- | - `identifier` must be unique 26 | type Migration = 27 | { up ∷ Connection → Aff Unit 28 | , down ∷ Connection → Aff Unit 29 | , identifier ∷ String 30 | } 31 | 32 | -- | Runs migrations 33 | -- | 34 | -- | All migrations run in a single transaction. Migrations that have already been run are skipped 35 | migrate ∷ Pool → Array Migration → Aff Unit 36 | migrate pool migrations = do 37 | output <- DDIQ.withTransaction pool $ \connection -> do 38 | DDIM.createMigrationTable connection 39 | identifiers <- DDIM.fetchAlreadyRun connection 40 | DF.traverse_ (runMigration connection) $ skipAlreadyRun identifiers migrations 41 | case output of 42 | Left err → DDIM.throw err 43 | Right _ → pure unit 44 | 45 | runMigration ∷ Connection → Migration → Aff Unit 46 | runMigration connection migration = do 47 | migration.up connection 48 | DDIM.markAsRun connection migration 49 | 50 | skipAlreadyRun ∷ Set String → Array Migration → Array Migration 51 | skipAlreadyRun identifiers = DA.filter skip 52 | where skip migration = not $ DS.member migration.identifier identifiers 53 | -------------------------------------------------------------------------------- /src/Droplet/Driver/Unsafe.purs: -------------------------------------------------------------------------------- 1 | -- | Unsafe query functions 2 | module Droplet.Driver.Unsafe (module Exported) where 3 | 4 | import Droplet.Driver.Internal.Query (unsafeExecute, unsafeQuery, unsafeSingle) as Exported 5 | -------------------------------------------------------------------------------- /src/Droplet/Language.purs: -------------------------------------------------------------------------------- 1 | -- | Query language 2 | module Droplet.Language (spyQuery, module Exported) where 3 | 4 | import Data.Maybe (Maybe) 5 | import Droplet.Language.Internal.Condition 6 | ( and 7 | , equals 8 | , isNull 9 | , isNotNull 10 | , notEquals 11 | , greaterThan 12 | , lesserThan 13 | , greaterEqualsThan 14 | , lesserEqualsThan 15 | , or 16 | , not 17 | , in_ 18 | , Op 19 | , Not 20 | , In 21 | , Exists 22 | , (.&&.) 23 | , (.<>.) 24 | , (.=.) 25 | , (.>.) 26 | , (.<.) 27 | , (.>=.) 28 | , (.<=.) 29 | , (.||.) 30 | ) as Exported 31 | import Droplet.Language.Internal.Definition 32 | ( class FromValue 33 | , class ToParameters 34 | , class ToValue 35 | , class ToType 36 | , Identity 37 | , Column(..) 38 | , ForeignKey 39 | , Default(..) 40 | , Composite 41 | , PrimaryKey 42 | , Constraint 43 | , Unique 44 | , E 45 | , Path 46 | , Star(..) 47 | , Table(..) 48 | , fromValue 49 | , star 50 | , toType 51 | , toValue 52 | , (...) 53 | ) as Exported 54 | import Droplet.Language.Internal.Function 55 | ( count 56 | , coalesce 57 | , string_agg 58 | , array_agg 59 | , function 60 | , function' 61 | , Aggregate 62 | , FunctionSignature 63 | , FunctionSignature' 64 | , random 65 | ) as Exported 66 | import Droplet.Language.Internal.Translate (class ToQuery, Query(..)) 67 | 68 | import Droplet.Language.Internal.Translate as DLIQ 69 | import Droplet.Language.Internal.Syntax 70 | ( As 71 | , Inner 72 | , Outer 73 | , Delete 74 | , From 75 | , Insert 76 | , Into 77 | , OrderBy 78 | , Plan 79 | , Prepare 80 | , Alter 81 | , Select 82 | , Drop 83 | , Set 84 | , Update 85 | , Join 86 | , Offset 87 | , Returning 88 | , T 89 | , Limit 90 | , Create 91 | , Values 92 | , On 93 | , Distinct 94 | , Where 95 | , DefaultValues 96 | , Union 97 | , as 98 | , delete 99 | , from 100 | , defaultValues 101 | , insert 102 | , drop 103 | , create 104 | , into 105 | , alter 106 | , table 107 | , orderBy 108 | , join 109 | , leftJoin 110 | , groupBy 111 | , offset 112 | , union 113 | , unionAll 114 | , distinct 115 | , exists 116 | , prepare 117 | , select 118 | , set 119 | , asc 120 | , add 121 | , on 122 | , desc 123 | , update 124 | , limit 125 | , values 126 | , wher 127 | , returning 128 | ) as Exported 129 | import Droplet.Language.Internal.Syntax (Plan) 130 | import Foreign (Foreign) 131 | 132 | -- | Debug generated query 133 | spyQuery ∷ 134 | ∀ q projection. 135 | ToQuery q projection ⇒ 136 | q → 137 | { parameters ∷ Array Foreign 138 | , plan ∷ Maybe Plan 139 | , query ∷ String 140 | } 141 | spyQuery q = case DLIQ.buildQuery q of 142 | Query plan sql parameters → { plan, query: sql, parameters } -------------------------------------------------------------------------------- /src/Droplet/Language/Internal/Condition.purs: -------------------------------------------------------------------------------- 1 | -- | Logical operators for filtering records 2 | -- | 3 | -- | Do not import this module directly, it will break your code and make it not type safe. Use the sanitized `Droplet.Language` instead 4 | module Droplet.Language.Internal.Condition (class ToCondition, class ValidComparision, OuterScope, In, class Comparison, Op(..), IsNotNull(..), isNotNull, IsNull(..), isNull, in_, and, Exists(..), Not(..), not, BinaryOperator(..), equals, notEquals, greaterThan, lesserThan, greaterEqualsThan, lesserEqualsThan, or, (.&&.), (.<>.), (.=.), (.||.), (.<.), (.>.), (.<=.), (.>=.)) where 5 | 6 | import Prelude 7 | 8 | import Data.Array.NonEmpty (NonEmptyArray) 9 | import Data.Maybe (Maybe(..)) 10 | import Droplet.Language.Internal.Definition (class IsNullable, class ToValue, class UnwrapDefinition, class UnwrapNullable, Path) 11 | import Prim.Row (class Cons) 12 | import Prim.TypeError (class Fail, Text) 13 | import Type.Proxy (Proxy) 14 | 15 | data BinaryOperator 16 | = Equals 17 | | NotEquals 18 | | GreaterThan 19 | | LesserThan 20 | | GreaterEqualsThan 21 | | LesserEqualsThan 22 | | And 23 | | Or 24 | 25 | data In = In -- only for non empty arrays 26 | 27 | data Exists = Exists 28 | 29 | data Not = Not 30 | 31 | data IsNotNull = IsNotNull 32 | 33 | data IsNull = IsNull 34 | 35 | derive instance Eq BinaryOperator 36 | 37 | -- | Wrapper for comparisons 38 | data Op b c = Op (Maybe BinaryOperator) b c 39 | 40 | data OuterScope 41 | 42 | -- | SQL logical expressions 43 | class ToCondition (c ∷ Type) (fields ∷ Row Type) (alias ∷ Symbol) 44 | 45 | -- | AND/OR 46 | instance (ToCondition (Op a b) fields alias, ToCondition (Op c d) fields alias) ⇒ ToCondition (Op (Op a b) (Op c d)) fields alias 47 | 48 | -- | EXISTS 49 | else instance ToCondition (Op Exists b) fields alias 50 | 51 | -- | IS NULL 52 | else instance (Cons name t d fields, IsNullable t) ⇒ ToCondition (Op IsNull (Proxy name)) fields alias 53 | 54 | else instance (Cons name t d fields, IsNullable t) ⇒ ToCondition (Op IsNull (Path alias name)) fields alias 55 | 56 | else instance ToCondition (Op IsNull (Path table name)) fields alias 57 | 58 | -- | IS NOT NULL 59 | else instance (Cons name t d fields, IsNullable t) ⇒ ToCondition (Op IsNotNull (Proxy name)) fields alias 60 | 61 | else instance (Cons name t d fields, IsNullable t) ⇒ ToCondition (Op IsNotNull (Path alias name)) fields alias 62 | 63 | else instance ToCondition (Op IsNotNull (Path table name)) fields alias 64 | 65 | -- | NOT 66 | else instance ToCondition a fields alias ⇒ ToCondition (Op Not a) fields alias 67 | 68 | -- | IN values 69 | else instance ToCondition (Op a b) fields alias ⇒ ToCondition (Op In (Op a (NonEmptyArray b))) fields alias 70 | 71 | -- | Comparisons 72 | else instance 73 | ( Comparison a fields alias t 74 | , Comparison b fields alias u 75 | , ValidComparision t u 76 | ) ⇒ 77 | ToCondition (Op a b) fields alias 78 | 79 | -- | Whether expression can be compared 80 | class Comparison (c ∷ Type) (fields ∷ Row Type) (alias ∷ Symbol) (t ∷ Type) | c → fields t 81 | 82 | instance 83 | ( Cons name t d fields 84 | , UnwrapDefinition t u 85 | , UnwrapNullable u v 86 | ) ⇒ 87 | Comparison (Proxy name) fields alias v 88 | 89 | else instance 90 | ( Cons name t d fields 91 | , UnwrapDefinition t u 92 | , UnwrapNullable u v 93 | ) ⇒ 94 | Comparison (Path alias name) fields alias v 95 | 96 | else instance Comparison (Path table name) fields alias OuterScope 97 | 98 | else instance Fail (Text "Comparisons must not be wrapped in Maybe") ⇒ Comparison (Maybe t) fields alias t 99 | 100 | else instance ToValue t ⇒ Comparison t fields alias t 101 | 102 | -- | Whether given types can be compared 103 | class ValidComparision (t ∷ Type) (u ∷ Type) 104 | 105 | instance ValidComparision t OuterScope 106 | 107 | else instance ValidComparision OuterScope t 108 | 109 | else instance ValidComparision t t 110 | 111 | equals ∷ ∀ field other. field → other → Op field other 112 | equals field other = Op (Just Equals) field other 113 | 114 | notEquals ∷ ∀ compared field. field → compared → Op field compared 115 | notEquals field compared = Op (Just NotEquals) field compared 116 | 117 | greaterThan ∷ ∀ compared field. field → compared → Op field compared 118 | greaterThan field compared = Op (Just GreaterThan) field compared 119 | 120 | lesserThan ∷ ∀ compared field. field → compared → Op field compared 121 | lesserThan field compared = Op (Just LesserThan) field compared 122 | 123 | greaterEqualsThan ∷ ∀ compared field. field → compared → Op field compared 124 | greaterEqualsThan field compared = Op (Just GreaterEqualsThan) field compared 125 | 126 | lesserEqualsThan ∷ ∀ compared field. field → compared → Op field compared 127 | lesserEqualsThan field compared = Op (Just LesserEqualsThan) field compared 128 | 129 | and ∷ ∀ a b c d. Op a b → Op c d → Op (Op a b) (Op c d) 130 | and first second = Op (Just And) first second 131 | 132 | or ∷ ∀ a b c d. Op a b → Op c d → Op (Op a b) (Op c d) 133 | or first second = Op (Just Or) first second 134 | 135 | in_ ∷ ∀ compared field. field → compared → Op In (Op field compared) 136 | in_ field compared = Op Nothing In (Op Nothing field compared) 137 | 138 | not ∷ ∀ compared field. Op field compared → Op Not (Op field compared) 139 | not a = Op Nothing Not a 140 | 141 | isNull ∷ ∀ field. field → Op IsNull field 142 | isNull field = Op Nothing IsNull field 143 | 144 | isNotNull ∷ ∀ field. field → Op IsNotNull field 145 | isNotNull field = Op Nothing IsNotNull field 146 | 147 | infix 4 notEquals as .<>. 148 | infix 4 equals as .=. 149 | infix 4 greaterThan as .>. 150 | infix 4 lesserThan as .<. 151 | infix 4 greaterEqualsThan as .>=. 152 | infix 4 lesserEqualsThan as .<=. 153 | infixl 3 and as .&&. 154 | infixl 2 or as .||. 155 | -------------------------------------------------------------------------------- /src/Droplet/Language/Internal/Definition.js: -------------------------------------------------------------------------------- 1 | export function readInt(value) { 2 | var n = parseInt(value, 10); 3 | 4 | if (typeof n === 'number' && 5 | n === n && 6 | n !== Infinity && 7 | value !== -Infinity && 8 | Math.floor(n) === n && 9 | Math.abs(n) <= Number.MAX_SAFE_INTEGER) 10 | return n; 11 | } 12 | 13 | export function showForeigner(f) { 14 | return f +''; 15 | } -------------------------------------------------------------------------------- /src/Droplet/Language/Internal/Definition.purs: -------------------------------------------------------------------------------- 1 | -- | Definition of SQL columns types as well conversions from and to columns 2 | -- | 3 | -- | Do not import this module directly, it will break your code and make it not type safe. Use the sanitized `Droplet.Language` instead 4 | module Droplet.Language.Internal.Definition 5 | ( Empty 6 | , Identity 7 | , Default(..) 8 | , Star(..) 9 | , Table(..) 10 | , E(..) 11 | , Dot 12 | , Composite 13 | , Path 14 | , ForeignKey 15 | , Joined 16 | , PrimaryKey 17 | , Constraint 18 | , Unique 19 | , Column(..) 20 | , C 21 | , class ToType 22 | , class IsNullable 23 | , class UnwrapNullable 24 | , class FromValue 25 | , class ToParameters 26 | , class ToValue 27 | , class UnwrapDefinition 28 | , class AppendPath 29 | , star 30 | , toType 31 | , toParameters 32 | , fromValue 33 | , toValue 34 | , path 35 | , (...) 36 | ) where 37 | 38 | import Prelude 39 | import Prim hiding (Constraint) 40 | 41 | import Control.Monad.Except as CME 42 | import Data.Array ((:)) 43 | import Data.Bifunctor as DB 44 | import Data.BigInt (BigInt) 45 | import Data.BigInt as DBT 46 | import Data.Date (Date) 47 | import Data.Date as DD 48 | import Data.DateTime (DateTime(..), Time(..)) 49 | import Data.Either (Either(..)) 50 | import Data.Either as DE 51 | import Data.Either as DET 52 | import Data.Enum as DEN 53 | import Data.Int as DI 54 | import Data.Maybe (Maybe(..)) 55 | import Data.Nullable (Nullable) 56 | import Data.Nullable as DN 57 | import Data.Reflectable (class Reflectable) 58 | import Data.Reflectable as DR 59 | import Data.String (Pattern(..)) 60 | import Data.String as DST 61 | import Data.Symbol (class IsSymbol) 62 | import Data.Traversable as DT 63 | import Data.Tuple (Tuple) 64 | import Data.Tuple.Nested ((/\)) 65 | import Droplet.Language.Internal.Token (bigIntegerType, booleanType, dateTimeType, dateType, dotSymbol, integerType, numberType, stringType) 66 | import Foreign (Foreign) 67 | import Foreign as F 68 | import Prim.Row (class Cons) 69 | import Prim.RowList (RowList, Cons, Nil) 70 | import Prim.Symbol (class Append) 71 | import Record as R 72 | import Type.Proxy (Proxy(..)) 73 | 74 | foreign import readInt ∷ Foreign → Nullable Int 75 | foreign import showForeigner ∷ Foreign → String 76 | 77 | -- | Marks the query end 78 | data E = E 79 | 80 | data C :: forall k. k -> Type -> Type 81 | data C n t 82 | 83 | type Empty = "" 84 | 85 | type Dot = "." 86 | 87 | data Composite (name :: Symbol) 88 | 89 | -- | A trick to mark left joined columns as nullable 90 | data Joined (t ∷ Type) 91 | 92 | data Star = Star 93 | 94 | star ∷ Star 95 | star = Star 96 | 97 | -- | GENERATED ALWAYS AS IDENTITY constraint 98 | data Identity 99 | 100 | data Default = Default 101 | 102 | data PrimaryKey 103 | 104 | data Unique 105 | 106 | data ForeignKey (field :: Symbol) (table :: Type) 107 | 108 | data Constraint ∷ ∀ n. n → Type → Type 109 | data Constraint name t 110 | 111 | data Column (t :: Type) (constraint :: Type) = Column 112 | 113 | data Table (name ∷ Symbol) (fields ∷ Row Type) = Table 114 | 115 | -- | Qualified columns (e.g, table.column) 116 | data Path (alias ∷ Symbol) (field ∷ Symbol) = Path 117 | 118 | path ∷ ∀ alias field path pathField. Append alias Dot path ⇒ Append path field pathField ⇒ Proxy alias → Proxy field → Path alias field 119 | path _ _ = Path 120 | 121 | infix 7 path as ... 122 | 123 | -- | Converts a PureScript value into Postgres 124 | class ToValue v where 125 | toValue ∷ v → Foreign 126 | 127 | instance ToValue Int where 128 | toValue = F.unsafeToForeign 129 | 130 | instance ToValue String where 131 | toValue = F.unsafeToForeign 132 | 133 | instance ToValue Default where 134 | toValue _ = F.unsafeToForeign $ DN.null 135 | 136 | instance ToValue Boolean where 137 | toValue = F.unsafeToForeign 138 | 139 | instance ToValue Number where 140 | toValue = F.unsafeToForeign 141 | 142 | instance ToValue a ⇒ ToValue (Maybe a) where 143 | toValue = case _ of 144 | Nothing → F.unsafeToForeign DN.null 145 | Just a → toValue a 146 | 147 | instance ToValue BigInt where 148 | toValue = F.unsafeToForeign <<< DBT.toString 149 | 150 | instance ToValue Date where 151 | toValue = F.unsafeToForeign <<< formatDate 152 | 153 | instance ToValue a ⇒ ToValue (Array a) where 154 | toValue = F.unsafeToForeign <<< map toValue 155 | 156 | instance ToValue DateTime where 157 | toValue (DateTime date (Time h m s ms)) = F.unsafeToForeign $ formatDate date <> "t" <> time <> "+0000" 158 | where 159 | time = show (DEN.fromEnum h) <> ":" <> show (DEN.fromEnum m) <> ":" <> show (DEN.fromEnum s) <> dotSymbol <> show (DEN.fromEnum ms) 160 | 161 | formatDate ∷ Date → String 162 | formatDate date = show y <> "-" <> show m <> "-" <> show d 163 | where 164 | y = DEN.fromEnum $ DD.year date 165 | m = DEN.fromEnum $ DD.month date 166 | d = DEN.fromEnum $ DD.day date 167 | 168 | -- | Converts a Postgres value into PureScript 169 | class FromValue t where 170 | fromValue ∷ Foreign → Either String t 171 | 172 | --sometimes node pg returns a string for integers 173 | -- this might arise out a invalid type definition on the users part; 174 | -- the number is actually a big int; 175 | -- something funky 176 | --in the first two cases, readInt returns null, as well in the latter if the string can't be parsed as an integer 177 | instance FromValue Int where 178 | fromValue i = case DN.toMaybe $ readInt i of 179 | Nothing → Left $ "Could not parse value as integer: " <> showForeigner i 180 | Just int → Right int 181 | 182 | instance FromValue String where 183 | fromValue = DB.lmap show <<< CME.runExcept <<< F.readString 184 | 185 | instance FromValue Boolean where 186 | fromValue = DB.lmap show <<< CME.runExcept <<< F.readBoolean 187 | 188 | instance FromValue Number where 189 | fromValue = DB.lmap show <<< CME.runExcept <<< F.readNumber 190 | 191 | --tricky, since pg might return empty string for select some_side_effect_function() 192 | instance FromValue Unit where 193 | fromValue _ = Right unit 194 | 195 | instance FromValue v ⇒ FromValue (Array v) where 196 | fromValue = DT.traverse fromValue <=< DB.lmap show <<< CME.runExcept <<< F.readArray 197 | 198 | instance FromValue BigInt where 199 | fromValue v = do 200 | i ← DB.lmap show <<< CME.runExcept $ F.readString v 201 | DET.note ("Could not parse big int from " <> i) $ DBT.fromString i 202 | 203 | instance FromValue v ⇒ FromValue (Maybe v) where 204 | fromValue v 205 | | F.isNull v = pure Nothing 206 | | otherwise = Just <$> fromValue v 207 | 208 | instance FromValue Date where 209 | fromValue v = do 210 | s ← DB.lmap show <<< CME.runExcept $ F.readString v 211 | parseDate s $ "ISO 8601 date parsing failed for value: " <> s 212 | 213 | instance FromValue DateTime where 214 | fromValue v = do 215 | s ← DB.lmap show <<< CME.runExcept $ F.readString v 216 | let errorMessage = "ISO 8601 date time parsing failed for value: " <> s 217 | case DST.split (Pattern " ") s of 218 | [ datePart, timePart ] → do 219 | date ← parseDate datePart errorMessage 220 | time ← parseTime timePart errorMessage 221 | Right $ DateTime date time 222 | _ → Left errorMessage 223 | 224 | parseDate ∷ String → String → Either String Date 225 | parseDate input errorMessage = 226 | case DST.split (Pattern "-") input of 227 | [ y, m, d ] → do 228 | let result = DD.canonicalDate <$> (DEN.toEnum =<< DI.fromString y) <*> (DEN.toEnum =<< DI.fromString m) <*> (DEN.toEnum =<< DI.fromString d) 229 | DE.note errorMessage result 230 | _ → Left errorMessage 231 | 232 | parseTime ∷ String → String → Either String Time 233 | parseTime input errorMessage = 234 | case DST.split (Pattern ":") input of 235 | [ h, m, s ] → do 236 | let result = Time <$> (DEN.toEnum =<< DI.fromString h) <*> (DEN.toEnum =<< DI.fromString m) <*> (DEN.toEnum =<< DI.fromString (DST.take 2 s)) <*> (DEN.toEnum 0) 237 | DE.note errorMessage result 238 | _ → Left errorMessage 239 | 240 | -- | Convenience to remove type wrappers 241 | class UnwrapDefinition (w ∷ Type) (t ∷ Type) | w → t 242 | 243 | instance UnwrapDefinition (Column t c) t 244 | 245 | else instance UnwrapDefinition t u ⇒ UnwrapDefinition (Joined t) u 246 | 247 | else instance UnwrapDefinition t t 248 | 249 | -- | Convenience to remove nullable wrappers 250 | class UnwrapNullable (w ∷ Type) (t ∷ Type) | w → t 251 | 252 | instance UnwrapNullable (Maybe t) t 253 | 254 | else instance UnwrapNullable t t 255 | 256 | class IsNullable (t ∷ Type) 257 | 258 | instance IsNullable (Column (Maybe t) c) 259 | 260 | instance IsNullable (Maybe t) 261 | 262 | instance IsNullable (Joined t) 263 | 264 | class ToParameters record (list ∷ RowList Type) where 265 | toParameters ∷ Proxy list → Record record → Array (Tuple String Foreign) 266 | 267 | instance ToParameters record Nil where 268 | toParameters _ _ = [] 269 | 270 | instance 271 | ( IsSymbol name 272 | , Reflectable name String 273 | , ToValue t 274 | , Cons name t e record 275 | , ToParameters record rest 276 | ) ⇒ 277 | ToParameters record (Cons name t rest) where 278 | toParameters _ record = (DR.reflectType name /\ toValue (R.get name record)) : toParameters (Proxy ∷ Proxy rest) record 279 | where 280 | name = Proxy ∷ Proxy name 281 | 282 | -- | Simplify append qualifying column names 283 | class AppendPath (alias ∷ Symbol) (name ∷ Symbol) (fullPath ∷ Symbol) | alias name → fullPath 284 | 285 | instance (Append alias Dot path, Append path name fullPath) ⇒ AppendPath alias name fullPath 286 | 287 | -- | How a value should be generated for DEFAULT and other constraints 288 | -- | 289 | -- | Required only if using migrations; other cases are handled by `ToValue` 290 | class ToConstraintValue (t ∷ Type) where 291 | toConstraintValue ∷ Proxy t → Foreign 292 | 293 | 294 | -- | String representation of field types 295 | class ToType (t ∷ Type) where 296 | toType ∷ Proxy t → String 297 | 298 | instance ToType Int where 299 | toType _ = integerType 300 | 301 | instance ToType BigInt where 302 | toType _ = bigIntegerType 303 | 304 | instance ToType Date where 305 | toType _ = dateType 306 | 307 | instance ToType DateTime where 308 | toType _ = dateTimeType 309 | 310 | instance ToType String where 311 | toType _ = stringType 312 | 313 | instance ToType Number where 314 | toType _ = numberType 315 | 316 | instance ToType Boolean where 317 | toType _ = booleanType 318 | 319 | instance ToType t ⇒ ToType (Maybe t) where 320 | toType _ = toType (Proxy ∷ _ t) -------------------------------------------------------------------------------- /src/Droplet/Language/Internal/Function.purs: -------------------------------------------------------------------------------- 1 | module Droplet.Language.Internal.Function 2 | ( class TextColumn 3 | , count 4 | , class ToCount 5 | , random 6 | , Aggregate(..) 7 | , function' 8 | , string_agg 9 | , class ToStringAgg 10 | , class ToArrayAgg 11 | , class ToCoalesce 12 | , PgFunction(..) 13 | , array_agg 14 | , class MatchArgument 15 | , function 16 | , class MatchArgumentList 17 | , FunctionSignature 18 | , FunctionSignature' 19 | , coalesce 20 | ) where 21 | 22 | import Prelude 23 | 24 | import Data.BigInt (BigInt) 25 | import Data.Maybe (Maybe) 26 | import Data.Tuple.Nested (type (/\)) 27 | import Droplet.Language.Internal.Definition (class AppendPath, class ToValue, class UnwrapDefinition, class UnwrapNullable, E, Path, Star) 28 | import Prim.Row (class Cons) 29 | import Type.Equality (class TypeEquals) 30 | import Type.Proxy (Proxy) 31 | 32 | -- fields parameter is needed to match later with ToProjection 33 | -- | Built-in aggregate functions 34 | data Aggregate input rest (fields ∷ Row Type) (output ∷ Type) 35 | = Count input 36 | | StringAgg input rest 37 | | ArrayAgg input 38 | 39 | -- | Declares a functions 40 | data PgFunction (input ∷ Type) args (fields ∷ Row Type) (output ∷ Type) = PgFunction String args 41 | 42 | type FunctionSignature input output = ∀ args fields. MatchArgumentList input args fields ⇒ args → PgFunction input args fields output 43 | 44 | type FunctionSignature' output = ∀ fields. PgFunction Void Unit fields output 45 | 46 | class ToCount (f ∷ Type) (fields ∷ Row Type) | f → fields 47 | 48 | instance Cons name t e fields ⇒ ToCount (Proxy name) fields 49 | 50 | instance Cons name t e fields ⇒ ToCount (Path alias name) fields 51 | 52 | instance ToCount Star fields 53 | 54 | class ToStringAgg (f ∷ Type) (rest ∷ Type) (fields ∷ Row Type) | f → fields 55 | 56 | instance (Cons name t e fields, TextColumn t) ⇒ ToStringAgg (Proxy name) String fields 57 | 58 | instance (Cons name t e fields, TextColumn t) ⇒ ToStringAgg (Path alias name) String fields 59 | 60 | -- | Extra class for clearer error messages 61 | class TextColumn (t ∷ Type) 62 | 63 | instance TextColumn String 64 | 65 | instance TextColumn (Maybe String) 66 | 67 | class ToArrayAgg (f ∷ Type) (fields ∷ Row Type) (t ∷ Type) | f → fields t 68 | 69 | instance (Cons name t e fields, UnwrapDefinition t u) ⇒ ToArrayAgg (Proxy name) fields u 70 | 71 | instance 72 | ( AppendPath alias name fullPath 73 | , Cons fullPath t e fields 74 | , UnwrapDefinition t u 75 | ) ⇒ 76 | ToArrayAgg (Path alias name) fields u 77 | 78 | -- | Function arguments must match input type 79 | class MatchArgumentList (input ∷ Type) (args ∷ Type) (fields ∷ Row Type) 80 | 81 | instance (MatchArgumentList inp ar fields, MatchArgumentList ut gs fields) ⇒ MatchArgumentList (inp /\ ut) (ar /\ gs) fields 82 | 83 | else instance (MatchArgument i fields t, MatchArgument a fields t) ⇒ MatchArgumentList i a fields 84 | 85 | -- | coalesce arguments must be of same type 86 | class ToCoalesce (a ∷ Type) (fields ∷ Row Type) (t ∷ Type) | a → t 87 | 88 | instance (ToCoalesce inp fields t, ToCoalesce ut fields t) ⇒ ToCoalesce (inp /\ ut) fields t 89 | 90 | else instance MatchArgument i fields t ⇒ ToCoalesce i fields t 91 | 92 | class MatchArgument (a ∷ Type) (fields ∷ Row Type) (t ∷ Type) | a → t 93 | 94 | instance 95 | ( Cons name t d fields 96 | , UnwrapDefinition t u 97 | , UnwrapNullable u v 98 | ) ⇒ 99 | MatchArgument (Proxy name) fields v 100 | 101 | else instance 102 | ( AppendPath alias name fullPath 103 | , Cons fullPath t d fields 104 | , UnwrapDefinition t u 105 | , UnwrapNullable u v 106 | ) ⇒ 107 | MatchArgument (Path alias name) fields v 108 | 109 | else instance (UnwrapNullable o t, TypeEquals fd fields) ⇒ MatchArgument (PgFunction i a fd o) fields t 110 | 111 | else instance (ToValue a, UnwrapNullable a t) ⇒ MatchArgument a fields t 112 | 113 | count ∷ ∀ f fields. ToCount f fields ⇒ f → Aggregate f E fields BigInt 114 | count = Count 115 | 116 | --Maybe String because null 117 | string_agg ∷ ∀ f rest fields. ToStringAgg f rest fields ⇒ f → rest → Aggregate f rest fields (Maybe String) 118 | string_agg f rest = StringAgg f rest 119 | 120 | --Maybe t because null 121 | array_agg ∷ ∀ f t fields. ToArrayAgg f fields t ⇒ f → Aggregate f E fields (Maybe (Array t)) 122 | array_agg f = ArrayAgg f 123 | 124 | random ∷ FunctionSignature' Number 125 | random = function' "random" 126 | 127 | coalesce ∷ ∀ input output fields. ToCoalesce input fields output ⇒ input → PgFunction input input fields (Maybe output) 128 | coalesce = PgFunction "coalesce" 129 | 130 | -- | Represents a function that takes arguments 131 | function ∷ ∀ input output. String → FunctionSignature input output 132 | function name args = PgFunction name args 133 | 134 | -- | Represents a function that takes no arguments 135 | function' ∷ ∀ output. String → FunctionSignature' output 136 | function' name = PgFunction name unit -------------------------------------------------------------------------------- /src/Droplet/Language/Internal/Token.purs: -------------------------------------------------------------------------------- 1 | -- | SQL Keywords and tokens 2 | module Droplet.Language.Internal.Token where 3 | 4 | --magic strings 5 | selectKeyword ∷ String 6 | selectKeyword = "SELECT " 7 | 8 | distinctKeyword ∷ String 9 | distinctKeyword = "DISTINCT " 10 | 11 | isNullKeyword ∷ String 12 | isNullKeyword = " IS NULL" 13 | 14 | isNotNullKeyword ∷ String 15 | isNotNullKeyword = " IS NOT NULL" 16 | 17 | unionKeyword ∷ String 18 | unionKeyword = " UNION " 19 | 20 | allKeyword ∷ String 21 | allKeyword = "ALL " 22 | 23 | fromKeyword ∷ String 24 | fromKeyword = " FROM " 25 | 26 | constraintKeyword ∷ String 27 | constraintKeyword = "CONSTRAINT " 28 | 29 | identityKeyword ∷ String 30 | identityKeyword = " GENERATED ALWAYS AS IDENTITY" 31 | 32 | uniqueKeyword ∷ String 33 | uniqueKeyword = " UNIQUE" 34 | 35 | whereKeyword ∷ String 36 | whereKeyword = " WHERE " 37 | 38 | referencesKeyword ∷ String 39 | referencesKeyword = " REFERENCES " 40 | 41 | andKeyword ∷ String 42 | andKeyword = " AND " 43 | 44 | orKeyword ∷ String 45 | orKeyword = " OR " 46 | 47 | asKeyword ∷ String 48 | asKeyword = " AS " 49 | 50 | innerKeyword ∷ String 51 | innerKeyword = " INNER " 52 | 53 | primaryKeyKeyword ∷ String 54 | primaryKeyKeyword = " PRIMARY KEY" 55 | 56 | foreignKeyKeyword ∷ String 57 | foreignKeyKeyword = " FOREIGN KEY" 58 | 59 | defaultKeyword ∷ String 60 | defaultKeyword = "DEFAULT" 61 | 62 | joinKeyword ∷ String 63 | joinKeyword = "JOIN " 64 | 65 | onKeyword ∷ String 66 | onKeyword = " ON " 67 | 68 | groupByKeyword ∷ String 69 | groupByKeyword = " GROUP BY " 70 | 71 | existsKeyword ∷ String 72 | existsKeyword = "EXISTS " 73 | 74 | inKeyword ∷ String 75 | inKeyword = " IN " 76 | 77 | notKeyword ∷ String 78 | notKeyword = "NOT " 79 | 80 | leftKeyword ∷ String 81 | leftKeyword = " LEFT " 82 | 83 | starSymbol ∷ String 84 | starSymbol = "*" 85 | 86 | comma ∷ String 87 | comma = ", " 88 | 89 | openBracket ∷ String 90 | openBracket = "(" 91 | 92 | closeBracket ∷ String 93 | closeBracket = ")" 94 | 95 | equalsSymbol ∷ String 96 | equalsSymbol = " = " 97 | 98 | notEqualsSymbol ∷ String 99 | notEqualsSymbol = " <> " 100 | 101 | lesserThanSymbol ∷ String 102 | lesserThanSymbol = " < " 103 | 104 | greaterThanSymbol ∷ String 105 | greaterThanSymbol = " > " 106 | 107 | lesserEqualsThanSymbol ∷ String 108 | lesserEqualsThanSymbol = " <= " 109 | 110 | greaterEqualsThanSymbol ∷ String 111 | greaterEqualsThanSymbol = " >= " 112 | 113 | parameterSymbol ∷ String 114 | parameterSymbol = "$" 115 | 116 | insertKeyword ∷ String 117 | insertKeyword = "INSERT INTO " 118 | 119 | valuesKeyword ∷ String 120 | valuesKeyword = " VALUES" 121 | 122 | updateKeyword ∷ String 123 | updateKeyword = "UPDATE " 124 | 125 | setKeyword ∷ String 126 | setKeyword = " SET " 127 | 128 | deleteKeyword ∷ String 129 | deleteKeyword = "DELETE" 130 | 131 | atSymbol ∷ String 132 | atSymbol = "@" 133 | 134 | returningKeyword ∷ String 135 | returningKeyword = " RETURNING " 136 | 137 | descKeyword ∷ String 138 | descKeyword = " DESC" 139 | 140 | ascKeyword ∷ String 141 | ascKeyword = " ASC" 142 | 143 | orderKeyword ∷ String 144 | orderKeyword = " ORDER " 145 | 146 | byKeyword ∷ String 147 | byKeyword = "BY " 148 | 149 | countFunctionName ∷ String 150 | countFunctionName = "count" 151 | 152 | limitKeyword ∷ String 153 | limitKeyword = " LIMIT " 154 | 155 | offsetKeyword ∷ String 156 | offsetKeyword = " OFFSET " 157 | 158 | semicolon ∷ String 159 | semicolon = ";" 160 | 161 | dotSymbol ∷ String 162 | dotSymbol = "." 163 | 164 | string_aggFunctionName ∷ String 165 | string_aggFunctionName = "string_agg" 166 | 167 | array_aggFunctionName ∷ String 168 | array_aggFunctionName = "array_agg" 169 | 170 | simpleQuoteSymbol ∷ String 171 | simpleQuoteSymbol = "'" 172 | 173 | integerType ∷ String 174 | integerType = "INTEGER" 175 | 176 | bigIntegerType ∷ String 177 | bigIntegerType = "BIGINT" 178 | 179 | dateType ∷ String 180 | dateType = "DATE" 181 | 182 | tableKeyword ∷ String 183 | tableKeyword = "TABLE " 184 | 185 | notNullKeyword ∷ String 186 | notNullKeyword = " NOT NULL" 187 | 188 | dateTimeType ∷ String 189 | dateTimeType = "TIMESTAMPTZ" 190 | 191 | stringType ∷ String 192 | stringType = "TEXT" 193 | 194 | booleanType ∷ String 195 | booleanType = "BOOL" 196 | 197 | addKeyword ∷ String 198 | addKeyword = "ADD " 199 | 200 | alterKeyword ∷ String 201 | alterKeyword = "ALTER " 202 | 203 | dropKeyword ∷ String 204 | dropKeyword = "DROP " 205 | 206 | numberType ∷ String 207 | numberType = "DOUBLE PRECISION" 208 | 209 | createKeyword ∷ String 210 | createKeyword = "CREATE " 211 | 212 | newline ∷ String 213 | newline = "\n" 214 | 215 | space ∷ String 216 | space = " " 217 | 218 | quoteSymbol ∷ String 219 | quoteSymbol = """"""" 220 | -------------------------------------------------------------------------------- /test/Alter.purs: -------------------------------------------------------------------------------- 1 | module Test.Alter where 2 | 3 | import Droplet.Language 4 | import Prelude hiding (add) 5 | import Prim hiding (Constraint) 6 | import Test.Types 7 | 8 | import Data.BigInt (BigInt) 9 | import Data.Date (Date) 10 | import Data.DateTime (DateTime) 11 | import Data.Maybe (Maybe) 12 | import Data.Tuple.Nested (type (/\)) 13 | import Droplet.Driver as DD 14 | import Droplet.Language.Internal.Translate as DLIQ 15 | import Effect.Class (liftEffect) 16 | import Test.Model (connectionInfo) 17 | import Test.Model as TM 18 | import Test.Spec (Spec) 19 | import Test.Spec as TS 20 | import Type.Proxy (Proxy(..)) 21 | 22 | tests ∷ Spec Unit 23 | tests = TS.describe "alter" do 24 | TS.describe "table" do 25 | TS.describe "add" do 26 | TS.it "no constraint" do 27 | let test = Table ∷ Table "test" (id ∷ Int) 28 | pool ← liftEffect $ DD.newPool connectionInfo 29 | void $ DD.withTransaction pool $ \c → DD.execute c $ create # table test 30 | 31 | let q = alter # table test # add name (Proxy :: _ String) 32 | TM.notParameterized """ALTER TABLE "test" ADD "name" TEXT NOT NULL""" $ DLIQ.buildQuery q 33 | void $ TM.resultOnly q 34 | TS.describe "constraint" do 35 | TS.it "simple" do 36 | let test = Table ∷ Table "test" (id ∷ Int) 37 | pool ← liftEffect $ DD.newPool connectionInfo 38 | void $ DD.withTransaction pool $ \c → DD.execute c $ create # table test 39 | 40 | let q = alter # table test # add name (Column :: Column String Unique) 41 | TM.notParameterized """ALTER TABLE "test" ADD "name" TEXT NOT NULL UNIQUE""" $ DLIQ.buildQuery q 42 | void $ TM.resultOnly q 43 | TS.it "named" do 44 | let test = Table ∷ Table "test" (id ∷ Int) 45 | pool ← liftEffect $ DD.newPool connectionInfo 46 | void $ DD.withTransaction pool $ \c → DD.execute c $ create # table test 47 | 48 | let q = alter # table test # add name (Column :: Column String (Constraint "named" Unique)) 49 | TM.notParameterized """ALTER TABLE "test" ADD "name" TEXT NOT NULL CONSTRAINT "named" UNIQUE""" $ DLIQ.buildQuery q 50 | void $ TM.resultOnly q -------------------------------------------------------------------------------- /test/As.purs: -------------------------------------------------------------------------------- 1 | module Test.As where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types (b, id, messages, n, name, t, u, users) 6 | 7 | import Data.Maybe (Maybe(..)) 8 | import Droplet.Language.Internal.Translate as DLIQ 9 | import Test.Model as TM 10 | 11 | import Test.Spec (Spec) 12 | import Test.Spec as TS 13 | import Type.Proxy (Proxy(..)) 14 | 15 | tests ∷ Spec Unit 16 | tests = 17 | TS.describe "as" do 18 | TS.describe "named field" do 19 | TS.it "casing" do 20 | let q = select (id # as (Proxy ∷ Proxy "AbCd")) # from users 21 | TM.notParameterized """SELECT "id" AS "AbCd" FROM "users"""" $ DLIQ.buildQuery q 22 | TM.result q [ { "AbCd": 1 }, { "AbCd": 2 } ] 23 | TS.describe "named table" do 24 | TS.it "field" do 25 | let q = select id # from (users # as u) 26 | TM.notParameterized """SELECT "id" FROM "users" AS "u"""" $ DLIQ.buildQuery q 27 | TM.result q [ { id: 1 }, { id: 2 } ] 28 | TS.it "named aliased field" do 29 | let q = select (u ... id # as id) # from (users # as u) 30 | TM.notParameterized """SELECT "u"."id" AS "id" FROM "users" AS "u"""" $ DLIQ.buildQuery q 31 | TM.result q [ { id: 1 }, { id: 2 } ] 32 | TS.describe "named queries" do 33 | TS.it "subquery column" do 34 | let q = select (select id # from users # wher (name .=. "mary") # orderBy id # limit (Proxy :: _ 1) # as b) # from users # wher (id .=. 1 .||. id .=. 2) 35 | TM.parameterized """SELECT (SELECT "id" FROM "users" WHERE "name" = $1 ORDER BY "id" LIMIT 1) AS "b" FROM "users" WHERE ("id" = $2 OR "id" = $3)""" $ DLIQ.buildQuery q 36 | TM.result q [ { b: Just 2 }, { b: Just 2 } ] 37 | TS.it "scalar" do 38 | let q = select (4 # as n) # from (select (4 # as n) # from users # wher (id .=. id) # as u) 39 | TM.notParameterized """SELECT 4 AS "n" FROM (SELECT 4 AS "n" FROM "users" WHERE "id" = "id") AS "u"""" $ DLIQ.buildQuery q 40 | TM.result q [ { n: 4 }, { n: 4 } ] 41 | TS.it "field" do 42 | let q = select id # from (select id # from messages # wher (id .=. id) # as t) 43 | TM.notParameterized """SELECT "id" FROM (SELECT "id" FROM "messages" WHERE "id" = "id") AS "t"""" $ DLIQ.buildQuery q 44 | TM.result q [ { id: 1 }, { id: 2 } ] -------------------------------------------------------------------------------- /test/Create.purs: -------------------------------------------------------------------------------- 1 | module Test.Create where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | 7 | import Data.BigInt (BigInt) 8 | import Prim hiding (Constraint) 9 | import Data.Date (Date) 10 | import Data.DateTime (DateTime) 11 | import Data.Maybe (Maybe) 12 | import Data.Tuple.Nested (type (/\)) 13 | import Droplet.Language.Internal.Translate as DLIQ 14 | import Test.Model as TM 15 | import Test.Spec (Spec) 16 | import Test.Spec as TS 17 | 18 | tests ∷ Spec Unit 19 | tests = 20 | TS.describe "create" do 21 | pure unit 22 | TS.describe "table" do 23 | TS.it "plain types" do 24 | let q = create # table (Table ∷ Table "test" (id ∷ Int, name ∷ String, set ∷ Boolean, n ∷ Number, bigId ∷ BigInt, date ∷ Date, dateTime ∷ DateTime)) 25 | TM.notParameterized """CREATE TABLE "test" ("bigId" BIGINT NOT NULL, "date" DATE NOT NULL, "dateTime" TIMESTAMPTZ NOT NULL, "id" INTEGER NOT NULL, "n" DOUBLE PRECISION NOT NULL, "name" TEXT NOT NULL, "set" BOOL NOT NULL)""" $ DLIQ.buildQuery q 26 | void $ TM.resultOnly q 27 | TS.it "maybe type" do 28 | let q = create # table (Table ∷ Table "test" (id ∷ Maybe Int, name ∷ String)) 29 | TM.notParameterized """CREATE TABLE "test" ("id" INTEGER, "name" TEXT NOT NULL)""" $ DLIQ.buildQuery q 30 | void $ TM.resultOnly q 31 | TS.describe "constraints" do 32 | TS.it "single" do 33 | let q = create # table (Table ∷ Table "test" (id ∷ Maybe Int, name ∷ String, c ∷ Column Int Identity)) 34 | TM.notParameterized """CREATE TABLE "test" ("c" INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY, "id" INTEGER, "name" TEXT NOT NULL)""" $ DLIQ.buildQuery q 35 | void $ TM.resultOnly q 36 | TS.it "named" do 37 | let q = create # table (Table ∷ Table "test" (id ∷ Maybe Int, name ∷ String, c ∷ Column Int (Constraint "pk" Identity))) 38 | TM.notParameterized """CREATE TABLE "test" ("c" INTEGER NOT NULL CONSTRAINT "pk" GENERATED ALWAYS AS IDENTITY, "id" INTEGER, "name" TEXT NOT NULL)""" $ DLIQ.buildQuery q 39 | void $ TM.resultOnly q 40 | TS.it "many" do 41 | let q = create # table (Table ∷ Table "test" (id ∷ Maybe Int, d ∷ Column String (PrimaryKey /\ Unique), name ∷ String, c ∷ Column Int Identity)) 42 | TM.notParameterized """CREATE TABLE "test" ("c" INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY, "d" TEXT NOT NULL PRIMARY KEY UNIQUE, "id" INTEGER, "name" TEXT NOT NULL)""" $ DLIQ.buildQuery q 43 | void $ TM.resultOnly q 44 | TS.it "foreign key" do 45 | let q = create # table (Table ∷ Table "test" (id ∷ Maybe Int, fk ∷ Column Int (ForeignKey "id" UsersTable))) 46 | TM.notParameterized """CREATE TABLE "test" ("fk" INTEGER NOT NULL REFERENCES "users"("id"), "id" INTEGER)""" $ DLIQ.buildQuery q 47 | void $ TM.resultOnly q 48 | TS.describe "composite" do 49 | TS.it "primary key" do 50 | let q = create # table (Table ∷ Table "test" (c ∷ Column Int (Constraint (Composite "pk") PrimaryKey), d ∷ Column Int (Constraint (Composite "pk") PrimaryKey))) 51 | TM.notParameterized """CREATE TABLE "test" ("c" INTEGER NOT NULL, "d" INTEGER NOT NULL, CONSTRAINT "pk" PRIMARY KEY("c", "d"))""" $ DLIQ.buildQuery q 52 | void $ TM.resultOnly q 53 | TS.it "foreign key" do 54 | let q = create # table (Table ∷ Table "test" (id ∷ Maybe Int, fk1 ∷ Column Int (Constraint (Composite "fk") (ForeignKey "id" DoublePrimaryKeyTable)), fk2 ∷ Column Int (Constraint (Composite "fk") (ForeignKey "second_id" DoublePrimaryKeyTable)))) 55 | TM.notParameterized """CREATE TABLE "test" ("fk1" INTEGER NOT NULL, "fk2" INTEGER NOT NULL, "id" INTEGER, CONSTRAINT "fk" FOREIGN KEY("fk1", "fk2") REFERENCES "double_primary_key"("id", "second_id"))""" $ DLIQ.buildQuery q 56 | -------------------------------------------------------------------------------- /test/Delete.purs: -------------------------------------------------------------------------------- 1 | module Test.Delete where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | 7 | import Droplet.Language.Internal.Translate as DLIQ 8 | import Test.Model as TM 9 | 10 | import Test.Spec (Spec) 11 | import Test.Spec as TS 12 | 13 | 14 | tests ∷ Spec Unit 15 | tests = do 16 | TS.describe "delete" do 17 | TS.it "all" do 18 | let q = delete # from users 19 | TM.notParameterized """DELETE FROM "users"""" $ DLIQ.buildQuery q 20 | TM.result' q [] 21 | TS.it "where" do 22 | let q = delete # from users # wher (id .=. 3) 23 | TM.parameterized """DELETE FROM "users" WHERE "id" = $1""" $ DLIQ.buildQuery q 24 | TM.result' q [] 25 | -------------------------------------------------------------------------------- /test/Distinct.purs: -------------------------------------------------------------------------------- 1 | module Test.Distinct where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | import Data.Tuple.Nested ((/\)) 7 | import Droplet.Language.Internal.Translate as DLIQ 8 | import Test.Model as TM 9 | 10 | import Test.Spec (Spec) 11 | import Test.Spec as TS 12 | 13 | 14 | tests ∷ Spec Unit 15 | tests = 16 | TS.describe "distinct" do 17 | TS.it "field" do 18 | let q = select (distinct id) # from messages 19 | TM.notParameterized """SELECT DISTINCT "id" FROM "messages"""" $ DLIQ.buildQuery q 20 | TM.result' q [] 21 | TS.it "fields" do 22 | let q = select (distinct (id /\ name)) # from users 23 | TM.notParameterized """SELECT DISTINCT "id", "name" FROM "users"""" $ DLIQ.buildQuery q 24 | TM.result q [ { id: 1, name: "josh" }, { id: 2, name: "mary" } ] 25 | TS.it "qualified fields" do 26 | let q = select (distinct (u ... id /\ u ... name)) # from (users # as u) 27 | TM.notParameterized """SELECT DISTINCT "u"."id" "u.id", "u"."name" "u.name" FROM "users" AS "u"""" $ DLIQ.buildQuery q 28 | TM.result q [ { "u.id": 1, "u.name": "josh" }, { "u.id": 2, "u.name": "mary" } ] 29 | -------------------------------------------------------------------------------- /test/Drop.purs: -------------------------------------------------------------------------------- 1 | module Test.Drop where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Prim hiding (Constraint) 6 | import Test.Types 7 | 8 | import Data.Maybe (Maybe(..)) 9 | import Droplet.Driver as DD 10 | import Droplet.Driver.Unsafe as DDU 11 | import Droplet.Language.Internal.Translate as DLIQ 12 | import Effect.Class (liftEffect) 13 | import Test.Model (connectionInfo) 14 | import Test.Model as TM 15 | import Test.Spec (Spec) 16 | import Test.Spec as TS 17 | 18 | tests ∷ Spec Unit 19 | tests = 20 | TS.describe "drop" do 21 | TS.it "table" do 22 | pool ← liftEffect $ DD.newPool connectionInfo 23 | void $ DD.withTransaction pool $ \c → DDU.unsafeExecute c Nothing "CREATE TABLE test (id INTEGER)" {} 24 | let q = drop # table (Table :: Table "test" (id :: Int)) 25 | TM.notParameterized """DROP TABLE "test"""" $ DLIQ.buildQuery q 26 | void $ TM.resultOnly q -------------------------------------------------------------------------------- /test/From.purs: -------------------------------------------------------------------------------- 1 | module Test.From where 2 | 3 | import Droplet.Language 4 | import Prelude hiding (join) 5 | import Test.Types 6 | 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Tuple.Nested ((/\)) 9 | import Droplet.Language.Internal.Translate as DLIQ 10 | import Test.Model as TM 11 | 12 | import Test.Spec (Spec) 13 | import Test.Spec as TS 14 | import Type.Proxy (Proxy(..)) 15 | 16 | 17 | tests ∷ Spec Unit 18 | tests = do 19 | TS.describe "from" do 20 | TS.it "star" do 21 | let q = select star # from messages 22 | TM.notParameterized """SELECT * FROM "messages"""" $ DLIQ.buildQuery q 23 | void $ TM.resultOnly q 24 | TS.it "null fields" do 25 | let q = select (created /\ _by) # from tags 26 | TM.notParameterized """SELECT "created", "by" FROM "tags"""" $ DLIQ.buildQuery q 27 | TM.result q [ { created: Nothing, by: Just 1 } ] 28 | TS.describe "named table" do 29 | TS.it "path" do 30 | let q = select (u ... id) # from (users # as u) 31 | TM.notParameterized """SELECT "u"."id" "u.id" FROM "users" AS "u"""" $ DLIQ.buildQuery q 32 | TM.result q [ { "u.id": 1 }, { "u.id": 2 } ] 33 | TS.it "aliased path" do 34 | let q = select (u ... id # as id) # from (users # as u) 35 | TM.notParameterized """SELECT "u"."id" AS "id" FROM "users" AS "u"""" $ DLIQ.buildQuery q 36 | TM.result q [ { id: 1 }, { id: 2 } ] 37 | TS.describe "named queries" do 38 | TS.it "star" do 39 | let q = select star # from (select (4 # as n) # from messages # as n) 40 | TM.notParameterized """SELECT * FROM (SELECT 4 AS "n" FROM "messages") AS "n"""" $ DLIQ.buildQuery q 41 | TM.result q [ { n: 4 }, { n: 4 } ] 42 | TS.it "star qualified qualified field" do 43 | let q = select star # from (select (bigB ... birthday) # from (users # as bigB) # as t) 44 | TM.notParameterized """SELECT * FROM (SELECT "B"."birthday" "B.birthday" FROM "users" AS "B") AS "t"""" $ DLIQ.buildQuery q 45 | TM.result q [ { "B.birthday": TM.makeDate 1990 1 1 }, { "B.birthday": TM.makeDate 1900 11 11 } ] 46 | TS.it "star bracket" do 47 | let q = select star # from (select (select id # from users # orderBy id # limit (Proxy :: _ 1)) # from users # as n) 48 | TM.notParameterized """SELECT * FROM (SELECT (SELECT "id" FROM "users" ORDER BY "id" LIMIT 1) FROM "users") AS "n"""" $ DLIQ.buildQuery q 49 | TM.result q [ { id: Just 1 }, { id: Just 1 } ] 50 | TS.it "field" do 51 | let q = select birthday # from (select birthday # from users # as t) 52 | TM.notParameterized """SELECT "birthday" FROM (SELECT "birthday" FROM "users") AS "t"""" $ DLIQ.buildQuery q 53 | TM.result q [ { birthday: TM.makeDate 1990 1 1 }, { birthday: TM.makeDate 1900 11 11 } ] 54 | TS.it "qualified field" do 55 | let q = select (t ... birthday) # from (select birthday # from users # as t) 56 | TM.notParameterized """SELECT "t"."birthday" "t.birthday" FROM (SELECT "birthday" FROM "users") AS "t"""" $ DLIQ.buildQuery q 57 | TM.result q [ { "t.birthday": TM.makeDate 1990 1 1 }, { "t.birthday": TM.makeDate 1900 11 11 } ] 58 | TS.it "qualified qualified field" do 59 | let q = select (t ... (Proxy ∷ Proxy "B.birthday")) # from (select (bigB ... birthday) # from (users # as bigB) # as t) 60 | TM.notParameterized """SELECT "t"."B.birthday" "t.B.birthday" FROM (SELECT "B"."birthday" "B.birthday" FROM "users" AS "B") AS "t"""" $ DLIQ.buildQuery q 61 | TM.result q [ { "t.B.birthday": TM.makeDate 1990 1 1 }, { "t.B.birthday": TM.makeDate 1900 11 11 } ] 62 | TS.it "renamed field" do 63 | let q = select t # from (select (birthday # as t) # from users # as t) 64 | TM.notParameterized """SELECT "t" FROM (SELECT "birthday" AS "t" FROM "users") AS "t"""" $ DLIQ.buildQuery q 65 | TM.result q [ { t: TM.makeDate 1990 1 1 }, { t: TM.makeDate 1900 11 11 } ] 66 | TS.it "join" do 67 | let q = select star # from (select (u ... name /\ t ... id) # from (join (users # as u) (messages # as t) # on (u ... id .=. t ... id)) # as b) 68 | TM.notParameterized """SELECT * FROM (SELECT "u"."name" "u.name", "t"."id" "t.id" FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id") AS "b"""" $ DLIQ.buildQuery q 69 | TM.result q [ { "t.id": 1, "u.name": "josh" }, { "t.id": 2, "u.name": "mary" } ] 70 | -------------------------------------------------------------------------------- /test/Function.purs: -------------------------------------------------------------------------------- 1 | module Test.Function where 2 | 3 | import Prelude hiding (join) 4 | 5 | import Data.BigInt as DB 6 | import Data.Maybe (Maybe(..)) 7 | import Data.Tuple.Nested ((/\)) 8 | import Droplet.Language 9 | import Droplet.Language.Internal.Translate as DLIQ 10 | import Test.Model as TM 11 | import Test.Types 12 | 13 | import Test.Spec (Spec) 14 | import Test.Spec as TS 15 | 16 | tests ∷ Spec Unit 17 | tests = TS.describe "functions" do 18 | TS.describe "user defined functions" do 19 | TS.it "value" do 20 | let q = select (date_part_age ("year" /\ (TM.makeDateTime 1900 2 2)) # as u) # from users 21 | TM.parameterized """SELECT date_part_age($1, $2) AS "u" FROM "users"""" $ DLIQ.buildQuery q 22 | void $ TM.resultOnly q 23 | TS.it "field" do 24 | let q = select (date_part_age ("month" /\ date) # as u) # from messages 25 | TM.parameterized """SELECT date_part_age($1, "date") AS "u" FROM "messages"""" $ DLIQ.buildQuery q 26 | void $ TM.resultOnly q 27 | TS.describe "coalesce" do 28 | TS.it "scalar" do 29 | let q = select (coalesce (3 /\ 4) # as u) # from users 30 | TM.parameterized """SELECT coalesce($1, $2) AS "u" FROM "users"""" $ DLIQ.buildQuery q 31 | TM.result q [ { u: Just 3 }, { u: Just 3 } ] 32 | TS.it "field" do 33 | let q = select (coalesce (_by /\ _by) # as u) # from tags 34 | TM.notParameterized """SELECT coalesce("by", "by") AS "u" FROM "tags"""" $ DLIQ.buildQuery q 35 | TM.result q [ { u: Just 1 } ] 36 | TS.it "path" do 37 | let q = select (coalesce (u ... id /\ u ... id) # as u) # from (users # as u) 38 | TM.notParameterized """SELECT coalesce("u"."id", "u"."id") AS "u" FROM "users" AS "u"""" $ DLIQ.buildQuery q 39 | TM.result q [ { u: Just 1 }, { u: Just 2 } ] 40 | TS.it "mixed" do 41 | let q = select (coalesce (id /\ u ... id /\ 4) # as u) # from (users # as u) 42 | TM.parameterized """SELECT coalesce("id", "u"."id", $1) AS "u" FROM "users" AS "u"""" $ DLIQ.buildQuery q 43 | TM.result q [ { u: Just 1 }, { u: Just 2 } ] 44 | TS.it "function as argument" do 45 | let q = select (date_part_age ("year" /\ coalesce (date /\ utc_now)) # as u) # from messages 46 | TM.parameterized """SELECT date_part_age($1, coalesce("date", utc_now())) AS "u" FROM "messages"""" $ DLIQ.buildQuery q 47 | void $ TM.resultOnly q 48 | TS.describe "count" do 49 | TS.it "star" do 50 | let q = select (count star # as u) # from users 51 | TM.notParameterized """SELECT count(*) AS "u" FROM "users"""" $ DLIQ.buildQuery q 52 | TM.result q [ { u: DB.fromInt 2 } ] 53 | TS.it "field" do 54 | let q = select (count id # as u) # from users 55 | TM.notParameterized """SELECT count("id") AS "u" FROM "users"""" $ DLIQ.buildQuery q 56 | TM.result q [ { u: DB.fromInt 2 } ] 57 | TS.it "path" do 58 | let q = select (count (u ... id) # as u) # from (users # as u) 59 | TM.notParameterized """SELECT count("u"."id") AS "u" FROM "users" AS "u"""" $ DLIQ.buildQuery q 60 | TM.result q [ { u: DB.fromInt 2 } ] 61 | TS.it "function without parameters" do 62 | let q = select ((random # as u) /\ id) # from users 63 | TM.notParameterized """SELECT random() AS "u", "id" FROM "users"""" $ DLIQ.buildQuery q 64 | void $ TM.resultOnly q 65 | TS.describe "string_agg" do 66 | TS.it "field" do 67 | let q = select (string_agg name ", " # as u) # from users 68 | TM.parameterized """SELECT string_agg("name", $1) AS "u" FROM "users"""" $ DLIQ.buildQuery q 69 | TM.result q [ { u: Just "josh, mary" } ] 70 | TS.it "path" do 71 | let q = select (string_agg (u ... name) ", " # as u) # from (users # as u) 72 | TM.parameterized """SELECT string_agg("u"."name", $1) AS "u" FROM "users" AS "u"""" $ DLIQ.buildQuery q 73 | TM.result q [ { u: Just "josh, mary" } ] 74 | TS.describe "order by" do 75 | TS.it "field" do 76 | let q = select (string_agg name (", " # orderBy id) # as u) # from users 77 | TM.parameterized """SELECT string_agg("name", $1 ORDER BY "id") AS "u" FROM "users"""" $ DLIQ.buildQuery q 78 | TM.result q [ { u: Just "josh, mary" } ] 79 | TS.it "path" do 80 | let q = select (string_agg (u ... name) (", " # orderBy (u ... id)) # as u) # from (users # as u) 81 | TM.parameterized """SELECT string_agg("u"."name", $1 ORDER BY "u"."id") AS "u" FROM "users" AS "u"""" $ DLIQ.buildQuery q 82 | TM.result q [ { u: Just "josh, mary" } ] 83 | TS.describe "int_agg" do 84 | TS.it "field" do 85 | let q = select (array_agg name # as u) # from users 86 | TM.notParameterized """SELECT array_agg("name") AS "u" FROM "users"""" $ DLIQ.buildQuery q 87 | TM.result q [ { u: Just [ "josh", "mary" ] } ] 88 | TS.it "path" do 89 | let q = select (array_agg (u ... id) # as u) # from (users # as u) 90 | TM.notParameterized """SELECT array_agg("u"."id") AS "u" FROM "users" AS "u"""" $ DLIQ.buildQuery q 91 | TM.result q [ { u: Just [1, 2] } ] 92 | TS.it "joined source" do 93 | let q = select (array_agg (u ... id) # as u) # from (join (users # as u) (messages # as t) # on (u ... id .=. t ... id)) 94 | TM.notParameterized """SELECT array_agg("u"."id") AS "u" FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 95 | TM.result q [ { u: Just [1, 2] } ] 96 | TS.describe "order by" do 97 | TS.it "field" do 98 | let q = select (array_agg (id # orderBy id) # as u) # from users 99 | TM.notParameterized """SELECT array_agg("id" ORDER BY "id") AS "u" FROM "users"""" $ DLIQ.buildQuery q 100 | TM.result q [ { u: Just [1, 2]} ] 101 | TS.it "path" do 102 | let q = select (array_agg (u ... name # orderBy (u ... id)) # as u) # from (users # as u) 103 | TM.notParameterized """SELECT array_agg("u"."name" ORDER BY "u"."id") AS "u" FROM "users" AS "u"""" $ DLIQ.buildQuery q 104 | TM.result q [ { u: Just ["josh", "mary"] } ] 105 | -------------------------------------------------------------------------------- /test/GroupBy.purs: -------------------------------------------------------------------------------- 1 | module Test.GroupBy where 2 | 3 | import Droplet.Language (as, count, from, groupBy, orderBy, select, (...)) 4 | import Prelude 5 | import Test.Types (b, id, name, u, users) 6 | 7 | import Data.BigInt as BG 8 | import Data.Tuple.Nested ((/\)) 9 | import Droplet.Language.Internal.Translate as DLIQ 10 | import Test.Model as TM 11 | 12 | import Test.Spec (Spec) 13 | import Test.Spec as TS 14 | 15 | 16 | tests ∷ Spec Unit 17 | tests = 18 | TS.describe "group by" do 19 | TS.it "single field" do 20 | let q = select id # from users # groupBy id # orderBy id 21 | TM.notParameterized """SELECT "id" FROM "users" GROUP BY "id" ORDER BY "id"""" $ DLIQ.buildQuery q 22 | TM.result q [ { id: 1 }, { id: 2 } ] 23 | TS.it "many fields" do 24 | let q = select ((count id # as b) /\ name) # from users # groupBy (id /\ name) # orderBy id 25 | TM.notParameterized """SELECT count("id") AS "b", "name" FROM "users" GROUP BY "id", "name" ORDER BY "id"""" $ DLIQ.buildQuery q 26 | TM.result q [ { b: BG.fromInt 1, name: "josh" }, { b: BG.fromInt 1, name: "mary" } ] 27 | TS.describe "path" do 28 | TS.it "single field" do 29 | let q = select id # from (select id # from users # as u) # groupBy (u ... id) # orderBy id 30 | TM.notParameterized """SELECT "id" FROM (SELECT "id" FROM "users") AS "u" GROUP BY "u"."id" ORDER BY "id"""" $ DLIQ.buildQuery q 31 | TM.result q [ { id: 1 }, { id: 2 } ] 32 | TS.it "many fields" do 33 | let q = select (id /\ u ... name) # from (users # as u) # groupBy (u ... name /\ id) # orderBy id 34 | TM.notParameterized """SELECT "id", "u"."name" "u.name" FROM "users" AS "u" GROUP BY "u"."name", "id" ORDER BY "id"""" $ DLIQ.buildQuery q 35 | TM.result q [ { id: 1, "u.name": "josh" }, { id: 2, "u.name": "mary" } ] 36 | -------------------------------------------------------------------------------- /test/Insert.purs: -------------------------------------------------------------------------------- 1 | module Test.Insert where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | 7 | import Data.Tuple.Nested ((/\)) 8 | import Droplet.Language.Internal.Translate as DLIQ 9 | import Test.Model as TM 10 | 11 | import Test.Spec (Spec) 12 | import Test.Spec as TS 13 | 14 | 15 | tests ∷ Spec Unit 16 | tests = do 17 | TS.describe "insert" do 18 | TS.describe "values" do 19 | TS.it "all fields" do 20 | let q = insert # into users (name /\ surname /\ birthday /\ joined) # values ("mary" /\ "m." /\ TM.makeDate 2000 9 9 /\ TM.makeDate 2009 9 9) 21 | TM.parameterized """INSERT INTO "users"("name", "surname", "birthday", "joined") VALUES ($1, $2, $3, $4)""" $ DLIQ.buildQuery q 22 | TM.result' q [] 23 | TS.it "some fields" do 24 | let q = insert # into tags name # values "my tag" 25 | TM.parameterized """INSERT INTO "tags"("name") VALUES ($1)""" $ DLIQ.buildQuery q 26 | TM.result' q [] 27 | TS.describe "default values" do 28 | TS.it "single" do 29 | let q = insert # into users (name /\ surname /\ joined) # values ("josh" /\ "a" /\ Default) 30 | TM.parameterized """INSERT INTO "users"("name", "surname", "joined") VALUES ($1, $2, DEFAULT)""" $ DLIQ.buildQuery q 31 | TM.result' q [] 32 | TS.it "all" do 33 | let q = insert # into doublePrimaryKey defaultValues 34 | TM.notParameterized """INSERT INTO "double_primary_key" DEFAULT VALUES""" $ DLIQ.buildQuery q 35 | TM.result' q [] 36 | -- need some different design for this 37 | -- TS.it "many" do 38 | -- let q = insert # into users (name /\ surname /\ joined) # values ["josh" /\ "a" /\ TM.makeDate 2000 3 4, "josh" /\ "a" /\ Default] 39 | -- TM.parameterized """INSERT INTO "users"("name", "surname", "joined") VALUES ($1, $2, $3), ($4, $5, DEFAULT)""" $ DLIQ.buildQuery q 40 | -- TM.result' q [] 41 | TS.describe "multiple" do 42 | TS.it "all fields" do 43 | let 44 | q = insert # into users (name /\ surname /\ birthday /\ joined) # values 45 | [ "mary" /\ "m." /\ TM.makeDate 2000 9 9 /\ TM.makeDate 2009 9 9 46 | , "john" /\ "j." /\ TM.makeDate 2000 9 9 /\ TM.makeDate 2009 9 9 47 | ] 48 | TM.parameterized """INSERT INTO "users"("name", "surname", "birthday", "joined") VALUES ($1, $2, $3, $4), ($5, $6, $7, $8)""" $ DLIQ.buildQuery q 49 | TM.result' q [] 50 | TS.it "some fields" do 51 | let q = insert # into tags name # values [ "my tag", "my other tag" ] 52 | TM.parameterized """INSERT INTO "tags"("name") VALUES ($1), ($2)""" $ DLIQ.buildQuery q 53 | TM.result' q [] -------------------------------------------------------------------------------- /test/Join.purs: -------------------------------------------------------------------------------- 1 | module Test.Join where 2 | 3 | import Data.Maybe (Maybe(..)) 4 | import Data.Tuple.Nested ((/\)) 5 | import Droplet.Language (as, from, join, leftJoin, limit, on, orderBy, select, wher, (.&&.), (...), (.=.)) 6 | import Droplet.Language.Internal.Translate as DLIQ 7 | import Prelude 8 | import Test.Model as TM 9 | import Test.Spec (Spec) 10 | import Type.Proxy(Proxy(..)) 11 | import Test.Spec as TS 12 | import Test.Types (b, id, messages, n, name, sender, sent, t, tags, u, users) 13 | 14 | tests ∷ Spec Unit 15 | tests = do 16 | TS.describe "join" do 17 | TS.describe "inner" do 18 | TS.it "path column" do 19 | let q = select (u ... id /\ sender) # from ((users # as u) `join` (messages # as t) # on (u ... id .=. t ... id)) 20 | TM.notParameterized """SELECT "u"."id" "u.id", "sender" FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 21 | TM.result q [ { "u.id": 1, sender: 1 }, { "u.id": 2, sender: 2 } ] 22 | TS.it "unique columns" do 23 | let q = select (sent /\ name) # from ((users # as u) `join` (messages # as t) # on (u ... id .=. t ... id)) 24 | TM.notParameterized """SELECT "sent", "name" FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 25 | TM.result q [ { sent: true, name: "josh" }, { sent: true, name: "mary" } ] 26 | TS.it "aliased columns" do 27 | let q = select (u ... id # as id) # from ((users # as u) `join` (messages # as t) # on (u ... id .=. t ... id)) 28 | TM.notParameterized """SELECT "u"."id" AS "id" FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 29 | TM.result q [ { id: 1 }, { id: 2 } ] 30 | TS.it "subquery with path column" do 31 | let q = select (select (u ... id) # from users # orderBy id # limit (Proxy :: _ 1)) # from ((users # as u) `join` (messages # as t) # on (u ... id .=. t ... id)) 32 | TM.notParameterized """SELECT (SELECT "u"."id" "u.id" FROM "users" ORDER BY "id" LIMIT 1) FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 33 | TM.result q [ { "u.id": Just 1 }, { "u.id": Just 2 } ] 34 | TS.it "subquery with where path column" do 35 | let q = select (select id # from users # wher (id .=. u ... id) # orderBy id # limit (Proxy :: _ 1)) # from ((users # as u) `join` (messages # as t) # on (u ... id .=. t ... id)) 36 | TM.notParameterized """SELECT (SELECT "id" FROM "users" WHERE "id" = "u"."id" ORDER BY "id" LIMIT 1) FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 37 | TM.result q [ { id: Just 1 }, { id: Just 2 } ] 38 | TS.it "aliased subquery with where path column" do 39 | let q = select (select id # from (users # as b) # wher (b ... id .=. u ... id) # orderBy id # limit (Proxy :: _ 1)) # from ((users # as u) `join` (messages # as t) # on (u ... id .=. t ... id)) 40 | TM.notParameterized """SELECT (SELECT "id" FROM "users" AS "b" WHERE "b"."id" = "u"."id" ORDER BY "id" LIMIT 1) FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 41 | TM.result q [ { id: Just 1 }, { id: Just 2 } ] 42 | TS.it "three joins" do 43 | let q = select (u ... id /\ t ... id /\ b ... id) # from (((users # as u) `join` (messages # as t) # on (u ... id .=. t ... id)) `join` (tags # as b) # on (b ... id .=. u ... id)) 44 | TM.notParameterized """SELECT "u"."id" "u.id", "t"."id" "t.id", "b"."id" "b.id" FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id" INNER JOIN "tags" AS "b" ON "b"."id" = "u"."id"""" $ DLIQ.buildQuery q 45 | TM.result q [ { "b.id": 1, "t.id": 1, "u.id": 1 } ] 46 | TS.it "four joins" do 47 | let q = select (u ... id /\ t ... id /\ b ... id /\ n ... id) # from ((((users # as u) `join` (messages # as t) # on (u ... id .=. t ... id)) `join` (tags # as b) # on (b ... id .=. u ... id)) `join` (users # as n) # on (n ... id .=. t ... id .&&. n ... id .=. u ... id)) 48 | TM.notParameterized """SELECT "u"."id" "u.id", "t"."id" "t.id", "b"."id" "b.id", "n"."id" "n.id" FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "u"."id" = "t"."id" INNER JOIN "tags" AS "b" ON "b"."id" = "u"."id" INNER JOIN "users" AS "n" ON ("n"."id" = "t"."id" AND "n"."id" = "u"."id")""" $ DLIQ.buildQuery q 49 | TM.result q [ { "b.id": 1, "t.id": 1, "u.id": 1, "n.id": 1 } ] 50 | TS.it "subselect outer reference" do 51 | let q = select (select name # from (join (users # as n) (messages # as b) # on (b ... id .=. n ... id .&&. b ... id .=. u ... id)) # orderBy name # limit (Proxy :: _ 1)) # from (users # as u) 52 | TM.notParameterized """SELECT (SELECT "name" FROM "users" AS "n" INNER JOIN "messages" AS "b" ON ("b"."id" = "n"."id" AND "b"."id" = "u"."id") ORDER BY "name" LIMIT 1) FROM "users" AS "u"""" $ DLIQ.buildQuery q 53 | TM.result q [ { name: Just "josh" }, { name: Just "mary" } ] 54 | 55 | TS.describe "(left) outer" do 56 | TS.it "path column" do 57 | let q = select (u ... id /\ sender) # from ((users # as u) `leftJoin` (messages # as t) # on (u ... id .=. t ... id)) 58 | TM.notParameterized """SELECT "u"."id" "u.id", "sender" FROM "users" AS "u" LEFT JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 59 | TM.result q [ { "u.id": 1, sender: Just 1 }, { "u.id": 2, sender: Just 2 } ] 60 | TS.it "unique columns" do 61 | let q = select (sent /\ name) # from ((users # as u) `leftJoin` (messages # as t) # on (u ... id .=. t ... id)) 62 | TM.notParameterized """SELECT "sent", "name" FROM "users" AS "u" LEFT JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 63 | TM.result q [ { sent: Just true, name: "josh" }, { sent: Just true, name: "mary" } ] 64 | TS.it "aliased columns" do 65 | let q = select (u ... id # as id) # from ((users # as u) `leftJoin` (messages # as t) # on (u ... id .=. t ... id)) 66 | TM.notParameterized """SELECT "u"."id" AS "id" FROM "users" AS "u" LEFT JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 67 | TM.result q [ { id: 1 }, { id: 2 } ] 68 | TS.it "subquery with path column" do 69 | let q = select (select (u ... id) # from users # orderBy id # limit (Proxy :: _ 1)) # from ((users # as u) `leftJoin` (messages # as t) # on (u ... id .=. t ... id)) 70 | TM.notParameterized """SELECT (SELECT "u"."id" "u.id" FROM "users" ORDER BY "id" LIMIT 1) FROM "users" AS "u" LEFT JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 71 | TM.result q [ { "u.id": Just 1 }, { "u.id": Just 2 } ] 72 | TS.it "subquery with where path column" do 73 | let q = select (select id # from users # wher (id .=. u ... id) # orderBy id # limit (Proxy :: _ 1)) # from ((users # as u) `leftJoin` (messages # as t) # on (u ... id .=. t ... id)) 74 | TM.notParameterized """SELECT (SELECT "id" FROM "users" WHERE "id" = "u"."id" ORDER BY "id" LIMIT 1) FROM "users" AS "u" LEFT JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 75 | TM.result q [ { id: Just 1 }, { id: Just 2 } ] 76 | TS.it "aliased subquery with where path column" do 77 | let q = select (select id # from (users # as b) # wher (b ... id .=. u ... id) # orderBy id # limit (Proxy :: _ 1)) # from ((users # as u) `leftJoin` (messages # as t) # on (u ... id .=. t ... id)) 78 | TM.notParameterized """SELECT (SELECT "id" FROM "users" AS "b" WHERE "b"."id" = "u"."id" ORDER BY "id" LIMIT 1) FROM "users" AS "u" LEFT JOIN "messages" AS "t" ON "u"."id" = "t"."id"""" $ DLIQ.buildQuery q 79 | TM.result q [ { id: Just 1 }, { id: Just 2 } ] 80 | TS.it "three leftjoins" do 81 | let q = select (u ... id /\ t ... id /\ b ... id) # from (((users # as u) `leftJoin` (messages # as t) # on (u ... id .=. t ... id)) `leftJoin` (tags # as b) # on (b ... id .=. u ... id)) 82 | TM.notParameterized """SELECT "u"."id" "u.id", "t"."id" "t.id", "b"."id" "b.id" FROM "users" AS "u" LEFT JOIN "messages" AS "t" ON "u"."id" = "t"."id" LEFT JOIN "tags" AS "b" ON "b"."id" = "u"."id"""" $ DLIQ.buildQuery q 83 | TM.result q [ { "b.id": Just 1, "t.id": Just 1, "u.id": 1 }, { "b.id": Nothing, "t.id": Just 2, "u.id": 2 } ] 84 | TS.it "four leftjoins" do 85 | let q = select (u ... id /\ t ... id /\ b ... id /\ n ... id) # from ((((users # as u) `leftJoin` (messages # as t) # on (u ... id .=. t ... id)) `leftJoin` (tags # as b) # on (b ... id .=. u ... id)) `leftJoin` (users # as n) # on (n ... id .=. t ... id .&&. n ... id .=. u ... id)) 86 | TM.notParameterized """SELECT "u"."id" "u.id", "t"."id" "t.id", "b"."id" "b.id", "n"."id" "n.id" FROM "users" AS "u" LEFT JOIN "messages" AS "t" ON "u"."id" = "t"."id" LEFT JOIN "tags" AS "b" ON "b"."id" = "u"."id" LEFT JOIN "users" AS "n" ON ("n"."id" = "t"."id" AND "n"."id" = "u"."id")""" $ DLIQ.buildQuery q 87 | TM.result q [ { "b.id": Just 1, "t.id": Just 1, "u.id": 1, "n.id": Just 1 }, { "b.id": Nothing, "t.id": Just 2, "u.id": 2, "n.id": Just 2 } ] 88 | TS.it "subselect outer reference" do 89 | let q = select (select name # from (leftJoin (users # as n) (messages # as b) # on (b ... id .=. n ... id .&&. b ... id .=. u ... id)) # orderBy name # limit (Proxy :: _ 1)) # from (users # as u) 90 | TM.notParameterized """SELECT (SELECT "name" FROM "users" AS "n" LEFT JOIN "messages" AS "b" ON ("b"."id" = "n"."id" AND "b"."id" = "u"."id") ORDER BY "name" LIMIT 1) FROM "users" AS "u"""" $ DLIQ.buildQuery q 91 | TM.result q [ { name: Just "josh" }, { name: Just "josh" } ] 92 | -------------------------------------------------------------------------------- /test/Limit.purs: -------------------------------------------------------------------------------- 1 | module Test.Limit where 2 | 3 | import Droplet.Language (as, from, limit, offset, orderBy, select, wher, (.<>.)) 4 | import Prelude 5 | import Test.Types (id, n, name, users) 6 | 7 | import Data.Tuple.Nested ((/\)) 8 | import Droplet.Language.Internal.Translate as DLIQ 9 | import Test.Model as TM 10 | 11 | import Test.Spec (Spec) 12 | import Test.Spec as TS 13 | import Type.Proxy(Proxy(..)) 14 | 15 | tests ∷ Spec Unit 16 | tests = 17 | TS.describe "limit" do 18 | TS.it "from" do 19 | let q = select (4 # as n) # from users # orderBy n # limit (Proxy :: _ 4) 20 | TM.notParameterized """SELECT 4 AS "n" FROM "users" ORDER BY "n" LIMIT 4""" $ DLIQ.buildQuery q 21 | TM.result q [ { n: 4 }, { n: 4 } ] 22 | TS.it "where" do 23 | let q = select id # from users # wher (id .<>. 10) # orderBy (id /\ name) # limit (Proxy :: _ 2) 24 | TM.parameterized """SELECT "id" FROM "users" WHERE "id" <> $1 ORDER BY "id", "name" LIMIT 2""" $ DLIQ.buildQuery q 25 | TM.result q [ { id: 1 }, { id: 2 } ] 26 | TS.it "offset" do 27 | let q = select (4 # as n) # from users # orderBy n # offset 4 # limit (Proxy :: _ 5) 28 | TM.notParameterized """SELECT 4 AS "n" FROM "users" ORDER BY "n" OFFSET 4 LIMIT 5""" $ DLIQ.buildQuery q 29 | TM.result q [] 30 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Aff as EA 7 | import Test.As as TA 8 | import Test.Create as TC 9 | import Test.Delete as TD 10 | import Test.Distinct as TDS 11 | import Test.From as TF 12 | import Test.Function as TFC 13 | import Test.GroupBy as TG 14 | import Test.Insert as TI 15 | import Test.Join as TJ 16 | import Test.Limit as TL 17 | import Test.NakedSelect as TNS 18 | import Test.Migration as TMG 19 | import Test.Offset as TOF 20 | import Test.OrderBy as TO 21 | import Test.Returning as TR 22 | import Test.Spec.Runner as TSR 23 | import Test.Spec.Reporter.Console (consoleReporter) 24 | import Test.SubQuery as TSQ 25 | import Test.Transaction as TST 26 | import Test.Union as TUN 27 | import Test.Unsafe as TUS 28 | import Test.Update as TU 29 | import Test.Drop as TDR 30 | import Test.Alter as TAL 31 | import Test.Where as TW 32 | 33 | main ∷ Effect Unit 34 | main = EA.launchAff_ $ TSR.runSpec [consoleReporter] do 35 | TUS.tests 36 | TI.tests 37 | TU.tests 38 | TD.tests 39 | TR.tests 40 | TF.tests 41 | TDS.tests 42 | TJ.tests 43 | TAL.tests 44 | TW.tests 45 | TUN.tests 46 | TG.tests 47 | TA.tests 48 | TSQ.tests 49 | TMG.tests 50 | TOF.tests 51 | TDR.tests 52 | TO.tests 53 | TFC.tests 54 | TL.tests 55 | TNS.tests 56 | TST.tests 57 | TC.tests -------------------------------------------------------------------------------- /test/Migration.purs: -------------------------------------------------------------------------------- 1 | module Test.Migration where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | 7 | import Control.Monad.Error.Class as CMEC 8 | import Control.Monad.Error.Class as EA 9 | import Data.Maybe (Maybe(..)) 10 | import Droplet.Driver as DD 11 | import Droplet.Driver.Internal.Migration as DDIM 12 | import Droplet.Driver.Internal.Query as DDIQ 13 | import Droplet.Driver.Migration as DDM 14 | import Effect.Class (liftEffect) 15 | import Effect.Exception as EE 16 | import Test.Model (connectionInfo) 17 | import Test.Model as TM 18 | import Test.Spec (Spec) 19 | import Test.Spec as TS 20 | 21 | tests ∷ Spec Unit 22 | tests = TS.describe "migration" do 23 | TS.it "runs all migrations" do 24 | pool ← liftEffect $ DD.newPool connectionInfo 25 | DDM.migrate pool 26 | [ { up: \c → void <<< DD.execute c $ create # table migrated, down: const (pure unit), identifier: "aaa" } 27 | , { up: \c → void $ DDIQ.execute c $ insert # into migrated id # values 3, down: const (pure unit), identifier: "bbb" } 28 | ] 29 | let q = select id # from migrated 30 | TM.result q [ { id: 3 } ] 31 | TS.it "doesn't fail if table already exists" do 32 | pool ← liftEffect $ DD.newPool connectionInfo 33 | void $ DD.withTransaction pool $ \c → DDIM.createMigrationTable c 34 | DDM.migrate pool [] 35 | TS.it "skip migrations already run" do 36 | pool ← liftEffect $ DD.newPool connectionInfo 37 | -- mark step as run 38 | void $ DD.withTransaction pool $ \c → do 39 | DDIM.createMigrationTable c 40 | DDIM.markAsRun c { identifier: "bbb" } 41 | DDM.migrate pool 42 | [ { up: \c → void <<< DD.execute c $ create # table migrated, down: const (pure unit), identifier: "aaa" } 43 | , { up: \c → void $ DDIQ.execute c $ insert # into migrated id # values 3, down: const (pure unit), identifier: "bbb" } 44 | ] 45 | let q = select id # from migrated 46 | TM.result q [] 47 | TS.it "all or nothing" do 48 | pool ← liftEffect $ DD.newPool connectionInfo 49 | void $ DD.withTransaction pool $ \c → DD.execute c $ create # table migrated 50 | void $ CMEC.try $ DDM.migrate pool 51 | [ { up: \c → void $ DDIQ.execute c $ insert # into migrated id # values 3, down: const (pure unit), identifier: "bbb" } 52 | , { up: const (EA.throwError $ EE.error "error"), down: const (pure unit), identifier: "ccc" } 53 | ] 54 | let q = select id # from migrated 55 | TM.result q [] -------------------------------------------------------------------------------- /test/Model.purs: -------------------------------------------------------------------------------- 1 | module Test.Model where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | 7 | import Data.Date (Date) 8 | import Data.Date (canonicalDate) as DD 9 | import Data.DateTime (DateTime(..), Time(..)) 10 | import Data.Either (Either(..)) 11 | import Data.Enum (class BoundedEnum) 12 | import Data.Enum as DE 13 | import Data.Eq (class EqRecord) 14 | import Data.Maybe (Maybe(..)) 15 | import Data.Maybe as DM 16 | import Data.Show (class ShowRecordFields) 17 | import Data.Tuple.Nested ((/\)) 18 | import Droplet.Driver (class FromResult, Configuration, Connection, PgError) 19 | import Droplet.Driver (defaultConfiguration, newPool, query, withConnection) as DD 20 | import Droplet.Driver.Unsafe as DDU 21 | import Droplet.Language.Internal.Translate (class ToQuery, Query(..)) 22 | import Effect.Aff (Aff) 23 | import Effect.Class (liftEffect) 24 | import Partial.Unsafe as PU 25 | import Prim.Row (class Nub) 26 | import Prim.RowList (class RowToList) 27 | import Test.Spec (Spec) 28 | import Test.Spec as TS 29 | import Test.Spec.Assertions as TSA 30 | 31 | makeDate ∷ Int → Int → Int → Date 32 | makeDate y m d = DD.canonicalDate (unsafeToEnum y) (unsafeToEnum m) (unsafeToEnum d) 33 | 34 | makeDateTime ∷ Int → Int → Int → DateTime 35 | makeDateTime y m d = DateTime (makeDate y m d) $ Time (unsafeToEnum 0) (unsafeToEnum 0) (unsafeToEnum 0) (unsafeToEnum 0) 36 | 37 | unsafeToEnum ∷ ∀ a. BoundedEnum a ⇒ Int → a 38 | unsafeToEnum v = PU.unsafePartial (DM.fromJust $ DE.toEnum v) 39 | 40 | notParameterized s (Query _ q parameters) = case parameters of 41 | [] → TSA.shouldEqual s q 42 | _ → TSA.fail $ "Expected no parameters for " <> s 43 | 44 | parameterized s (Query _ q parameters) = case parameters of 45 | [] → TSA.fail $ "Expected parameters for " <> s 46 | _ → TSA.shouldEqual s q 47 | 48 | -- | Compares query return to expected result 49 | -- | 50 | -- | Default records are inserted before running the query. Use result' if that's not the intended behavior 51 | result ∷ ∀ t51 t52 t53. Nub t52 t52 => ToQuery t51 t52 ⇒ RowToList t52 t53 ⇒ FromResult t53 (Record t52) ⇒ EqRecord t53 t52 ⇒ ShowRecordFields t53 t52 ⇒ t51 → Array (Record t52) → Aff Unit 52 | result q o = do 53 | pool ← liftEffect $ DD.newPool connectionInfo 54 | DD.withConnection pool case _ of 55 | Left error → TSA.fail $ "Error connecting" <> show error 56 | Right connection → do 57 | insertDefaultRecords 58 | r ← DD.query connection q 59 | truncateTables connection 60 | TSA.shouldEqual (Right o) r 61 | 62 | result' ∷ ∀ t51 t52 t53. Nub t52 t52 => ToQuery t51 t52 ⇒ RowToList t52 t53 ⇒ FromResult t53 (Record t52) ⇒ EqRecord t53 t52 ⇒ ShowRecordFields t53 t52 ⇒ t51 → Array (Record t52) → Aff Unit 63 | result' q o = do 64 | pool ← liftEffect $ DD.newPool connectionInfo 65 | DD.withConnection pool case _ of 66 | Left error → TSA.fail $ "Error connecting" <> show error 67 | Right connection → do 68 | r ← DD.query connection q 69 | truncateTables connection 70 | TSA.shouldEqual (Right o) r 71 | 72 | resultOnly ∷ ∀ t51 t52 t53. ToQuery t51 t52 ⇒ RowToList t52 t53 ⇒ FromResult t53 (Record t52) ⇒ EqRecord t53 t52 ⇒ ShowRecordFields t53 t52 ⇒ t51 → Aff (Array (Record t52)) 73 | resultOnly q = do 74 | pool ← liftEffect $ DD.newPool connectionInfo 75 | DD.withConnection pool case _ of 76 | Left error → do 77 | TSA.fail $ "Error connecting" <> show error 78 | pure [] 79 | Right connection → do 80 | insertDefaultRecords 81 | r ← DD.query connection q 82 | truncateTables connection 83 | case r of 84 | Right o → pure o 85 | Left e → do 86 | TSA.fail $ "Error running query: " <> show e 87 | pure [] 88 | 89 | unsafeResult ∷ ∀ re parameters par result. Nub result result => RowToList result re ⇒ RowToList parameters par ⇒ ToParameters parameters par ⇒ FromResult re (Record result) ⇒ EqRecord re result ⇒ ShowRecordFields re result ⇒ Maybe Plan → String → Record parameters → Array (Record result) → Aff Unit 90 | unsafeResult plan q parameters o = do 91 | pool ← liftEffect $ DD.newPool connectionInfo 92 | DD.withConnection pool case _ of 93 | Left error → TSA.fail $ "Error connecting" <> show error 94 | Right connection → do 95 | insertDefaultRecords 96 | r ← DDU.unsafeQuery connection plan q parameters 97 | truncateTables connection 98 | TSA.shouldEqual (Right o) r 99 | 100 | truncateTables ∷ Connection → Aff Unit 101 | truncateTables connection = void (DDU.unsafeQuery connection Nothing "select truncate_tables()" {} ∷ Aff (Either PgError (Array {}))) 102 | 103 | insertDefaultRecords ∷ Aff Unit 104 | insertDefaultRecords = do 105 | pool ← liftEffect $ DD.newPool connectionInfo 106 | DD.withConnection pool case _ of 107 | Left error → TSA.fail $ "Error connecting" <> show error 108 | Right connection → do 109 | void <<< DD.query connection $ insert # into users (name /\ surname /\ birthday) # values ("josh" /\ "j." /\ makeDate 1990 1 1) 110 | void <<< DD.query connection $ insert # into users (name /\ surname /\ birthday) # values ("mary" /\ "sue" /\ makeDate 1900 11 11) 111 | void <<< DD.query connection $ insert # into messages (sender /\ recipient /\ sent /\ date /\ secondDate) # values (1 /\ 2 /\ true /\ makeDateTime 2000 3 4 /\ makeDateTime 2000 3 4) 112 | void <<< DD.query connection $ insert # into messages (sender /\ recipient /\ sent /\ date /\ secondDate) # values (2 /\ 1 /\ true /\ makeDateTime 2000 3 4 /\ makeDateTime 2000 3 4) 113 | void <<< DD.query connection $ insert # into tags (name /\ _by) # values ("tagged" /\ Just 1) 114 | void <<< DD.query connection $ insert # into maybeKeys id # values 1 115 | void <<< DD.query connection $ insert # into uniqueValues (name /\ _by) # values ("named" /\ Just 1) 116 | void <<< DD.query connection $ insert # into defaultColumns (recipient /\ sender) # values (RecipientColumn 3 /\ SenderColumn 1) 117 | void <<< DD.query connection $ insert # into doublePrimaryKey defaultValues 118 | void <<< DD.query connection $ insert # into composite (secondId /\ name /\ sender /\ recipient) # values ( 1 /\ "adam" /\ 1 /\ 2) 119 | 120 | connectionInfo ∷ Configuration 121 | connectionInfo = (DD.defaultConfiguration "droplet") 122 | { user = Just "droplet" 123 | , host = Nothing 124 | , password = Just "droplet" 125 | , idleTimeoutMillis = Just 1000 126 | } -------------------------------------------------------------------------------- /test/NakedSelect.purs: -------------------------------------------------------------------------------- 1 | module Test.NakedSelect where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Tuple.Nested ((/\)) 9 | import Droplet.Language.Internal.Translate as DLIQ 10 | import Test.Model as TM 11 | import Type.Proxy(Proxy(..)) 12 | import Test.Spec (Spec) 13 | import Test.Spec as TS 14 | 15 | 16 | tests ∷ Spec Unit 17 | tests = 18 | TS.describe "naked select" do 19 | TS.it "scalar" do 20 | let q = select (3 # as n) 21 | TM.notParameterized """SELECT 3 AS "n"""" $ DLIQ.buildQuery q 22 | TM.result q [ { n: 3 } ] 23 | TS.describe "function" do 24 | TS.it "regular" do 25 | let q = select (date_part_age ("year" /\ TM.makeDateTime 2000 1 1) # as u) 26 | TM.parameterized """SELECT date_part_age($1, $2) AS "u"""" $ DLIQ.buildQuery q 27 | void $ TM.resultOnly q 28 | TS.it "side effect" do 29 | let q = select (fire_missiles (9 /\ 8) # as u) 30 | TM.parameterized """SELECT fire_missiles($1, $2) AS "u"""" $ DLIQ.buildQuery q 31 | TM.result q [ { u: unit } ] 32 | TS.it "side effect without parameters" do 33 | let q = select (random # as u) 34 | TM.notParameterized """SELECT random() AS "u"""" $ DLIQ.buildQuery q 35 | void $ TM.resultOnly q 36 | TS.it "subquery" do 37 | let q = select (select (34 # as n) # from users # wher (name .=. name) # orderBy id # limit (Proxy :: _ 1)) 38 | TM.notParameterized """SELECT (SELECT 34 AS "n" FROM "users" WHERE "name" = "name" ORDER BY "id" LIMIT 1)""" $ DLIQ.buildQuery q 39 | TM.result q [ { n: Just 34 } ] 40 | TS.it "aliases" do 41 | let q = select (select (u ... id) # from (users # as u) # orderBy id # limit (Proxy :: _ 1)) 42 | TM.notParameterized """SELECT (SELECT "u"."id" "u.id" FROM "users" AS "u" ORDER BY "id" LIMIT 1)""" $ DLIQ.buildQuery q 43 | TM.result q [ { "u.id": Just 1 } ] 44 | TS.it "named subquery" do 45 | let q = select (select (34 # as n) # from users # wher (name .=. name) # orderBy id # limit (Proxy :: _ 1) # as t) 46 | TM.notParameterized """SELECT (SELECT 34 AS "n" FROM "users" WHERE "name" = "name" ORDER BY "id" LIMIT 1) AS "t"""" $ DLIQ.buildQuery q 47 | TM.result q [ { t: Just 34 } ] 48 | TS.it "tuple" do 49 | let q = select ((3 # as b) /\ (select name # from users # orderBy name # limit (Proxy :: _ 1)) /\ (select (u ... name # as n) # from (users # as u) # orderBy (name # desc) # limit (Proxy :: _ 1))) 50 | TM.notParameterized """SELECT 3 AS "b", (SELECT "name" FROM "users" ORDER BY "name" LIMIT 1), (SELECT "u"."name" AS "n" FROM "users" AS "u" ORDER BY "name" DESC LIMIT 1)""" $ DLIQ.buildQuery q 51 | TM.result q [ { b: 3, name: Just "josh", n: Just "mary" } ] 52 | -------------------------------------------------------------------------------- /test/Offset.purs: -------------------------------------------------------------------------------- 1 | module Test.Offset where 2 | 3 | import Droplet.Language (as, from, limit, offset, orderBy, select, wher, (.<>.)) 4 | import Prelude 5 | import Test.Types (id, n, name, users) 6 | 7 | import Data.Tuple.Nested ((/\)) 8 | import Droplet.Language.Internal.Translate as DLIQ 9 | import Test.Model as TM 10 | 11 | import Test.Spec (Spec) 12 | import Test.Spec as TS 13 | import Type.Proxy(Proxy(..)) 14 | 15 | tests ∷ Spec Unit 16 | tests = 17 | TS.describe "offset" do 18 | TS.it "from" do 19 | let q = select (4 # as n) # from users # orderBy n # offset 1 20 | TM.notParameterized """SELECT 4 AS "n" FROM "users" ORDER BY "n" OFFSET 1""" $ DLIQ.buildQuery q 21 | TM.result q [ { n: 4 } ] 22 | TS.it "where" do 23 | let q = select id # from users # wher (id .<>. 10) # orderBy (id /\ name) # offset 2 24 | TM.parameterized """SELECT "id" FROM "users" WHERE "id" <> $1 ORDER BY "id", "name" OFFSET 2""" $ DLIQ.buildQuery q 25 | TM.result q [] 26 | TS.it "limit" do 27 | let q = select (4 # as n) # from users # orderBy n # limit (Proxy :: _ 5) # offset 4 28 | TM.notParameterized """SELECT 4 AS "n" FROM "users" ORDER BY "n" LIMIT 5 OFFSET 4""" $ DLIQ.buildQuery q 29 | TM.result q [] -------------------------------------------------------------------------------- /test/OrderBy.purs: -------------------------------------------------------------------------------- 1 | module Test.OrderBy where 2 | 3 | import Data.Tuple.Nested ((/\)) 4 | import Droplet.Language 5 | import Droplet.Language.Internal.Translate as DLIQ 6 | import Prelude hiding (join) 7 | import Test.Model as TM 8 | import Test.Types (date_part_age, id, date, messages, n, name, t, u, users) 9 | 10 | import Test.Spec (Spec) 11 | import Test.Spec as TS 12 | 13 | 14 | tests ∷ Spec Unit 15 | tests = 16 | TS.describe "order by" do 17 | TS.it "projection" do 18 | let q = select (4 # as n) # from users # orderBy n 19 | TM.notParameterized """SELECT 4 AS "n" FROM "users" ORDER BY "n"""" $ DLIQ.buildQuery q 20 | TM.result q [ { n: 4 }, { n: 4 } ] 21 | TS.it "field name" do 22 | let q = select id # from users # wher (id .<>. 10) # orderBy (id /\ name) 23 | TM.parameterized """SELECT "id" FROM "users" WHERE "id" <> $1 ORDER BY "id", "name"""" $ DLIQ.buildQuery q 24 | TM.result q [ { id: 1 }, { id: 2 } ] 25 | TS.it "asc" do 26 | let q = select (id # as n) # from users # wher (id .<>. 4) # orderBy (n /\ (name # asc)) 27 | TM.parameterized """SELECT "id" AS "n" FROM "users" WHERE "id" <> $1 ORDER BY "n", "name" ASC""" $ DLIQ.buildQuery q 28 | TM.result q [ { n: 1 }, { n: 2 } ] 29 | TS.it "desc" do 30 | let q = select id # from users # orderBy (id # desc) 31 | TM.notParameterized """SELECT "id" FROM "users" ORDER BY "id" DESC""" $ DLIQ.buildQuery q 32 | TM.result q [ { id: 2 }, { id: 1 } ] 33 | TS.it "distinct" do 34 | let q = select (distinct (id # as n)) # from users # orderBy n 35 | TM.notParameterized """SELECT DISTINCT "id" AS "n" FROM "users" ORDER BY "n"""" $ DLIQ.buildQuery q 36 | TM.result q [ { n: 1 }, { n: 2 } ] 37 | TS.describe "function" do 38 | TS.it "regular" do 39 | let q = select (4 # as n) # from users # orderBy (date_part_age ("year" /\ TM.makeDateTime 2000 1 1)) 40 | TM.parameterized """SELECT 4 AS "n" FROM "users" ORDER BY date_part_age($1, $2)""" $ DLIQ.buildQuery q 41 | TM.result q [ { n: 4 }, { n: 4 } ] 42 | TS.it "no parameters" do 43 | let q = select (4 # as n) # from users # orderBy random 44 | TM.notParameterized """SELECT 4 AS "n" FROM "users" ORDER BY random()""" $ DLIQ.buildQuery q 45 | void $ TM.resultOnly q 46 | TS.describe "path" do 47 | TS.it "field name" do 48 | let q = select id # from (users # as u) # orderBy (u ... id) 49 | TM.notParameterized """SELECT "id" FROM "users" AS "u" ORDER BY "u"."id"""" $ DLIQ.buildQuery q 50 | TM.result q [ { id: 1 }, { id: 2 } ] 51 | TS.it "asc" do 52 | let q = select id # from (select id # from users # as u) # orderBy (u ... id # asc) 53 | TM.notParameterized """SELECT "id" FROM (SELECT "id" FROM "users") AS "u" ORDER BY "u"."id" ASC""" $ DLIQ.buildQuery q 54 | TM.result q [ { id: 1 }, { id: 2 } ] 55 | TS.it "desc" do 56 | let q = select (3 # as id) # from (join (users # as u) (messages # as t) # on (t ... id .=. u ... id)) # orderBy (u ... id # desc) 57 | TM.notParameterized """SELECT 3 AS "id" FROM "users" AS "u" INNER JOIN "messages" AS "t" ON "t"."id" = "u"."id" ORDER BY "u"."id" DESC""" $ DLIQ.buildQuery q 58 | TM.result q [ { id: 3 }, { id: 3 } ] 59 | TS.it "function" do 60 | let q = select (4 # as n) # from (messages # as u) # orderBy (date_part_age ("year" /\ u ... date)) 61 | TM.parameterized """SELECT 4 AS "n" FROM "messages" AS "u" ORDER BY date_part_age($1, "u"."date")""" $ DLIQ.buildQuery q 62 | TM.result q [ { n: 4 }, { n: 4 } ] 63 | -------------------------------------------------------------------------------- /test/Returning.purs: -------------------------------------------------------------------------------- 1 | module Test.Returning where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | 7 | import Data.Tuple.Nested ((/\)) 8 | import Droplet.Language.Internal.Translate as DLIQ 9 | import Test.Model as TM 10 | 11 | import Test.Spec (Spec) 12 | import Test.Spec as TS 13 | 14 | 15 | tests ∷ Spec Unit 16 | tests = do 17 | TS.describe "returning" do 18 | TS.it "default values" do 19 | let q = insert # into doublePrimaryKey defaultValues # returning id 20 | TM.notParameterized """INSERT INTO "double_primary_key" DEFAULT VALUES RETURNING "id"""" $ DLIQ.buildQuery q 21 | TM.result' q [ { id: 1 } ] 22 | TS.it "single field" do 23 | let q = insert # into users (name /\ surname /\ birthday /\ joined) # values ("mary" /\ "m." /\ TM.makeDate 2000 9 9 /\ TM.makeDate 2009 9 9) # returning id 24 | TM.parameterized """INSERT INTO "users"("name", "surname", "birthday", "joined") VALUES ($1, $2, $3, $4) RETURNING "id"""" $ DLIQ.buildQuery q 25 | TM.result' q [ { id: 1 } ] 26 | TS.it "tuple" do 27 | let q = insert # into users (name /\ surname /\ birthday /\ joined) # values ("mary" /\ "m." /\ TM.makeDate 2000 9 9 /\ TM.makeDate 2009 9 9) # returning (id /\ name) 28 | TM.parameterized """INSERT INTO "users"("name", "surname", "birthday", "joined") VALUES ($1, $2, $3, $4) RETURNING "id", "name"""" $ DLIQ.buildQuery q 29 | TM.result' q [ { id: 1, name: "mary" } ] -------------------------------------------------------------------------------- /test/SubQuery.purs: -------------------------------------------------------------------------------- 1 | module Test.SubQuery where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | 7 | import Data.Maybe (Maybe(..)) 8 | import Droplet.Language.Internal.Translate as DLIQ 9 | import Test.Model as TM 10 | import Type.Proxy(Proxy(..)) 11 | import Test.Spec (Spec) 12 | import Test.Spec as TS 13 | 14 | 15 | tests ∷ Spec Unit 16 | tests = do 17 | TS.describe "subquery" do 18 | TS.it "null" do 19 | let q = select (select id # from users # wher (id .=. 9999) # orderBy id # limit (Proxy :: _ 1)) # from messages # orderBy id # limit (Proxy :: _ 1) 20 | TM.parameterized """SELECT (SELECT "id" FROM "users" WHERE "id" = $1 ORDER BY "id" LIMIT 1) FROM "messages" ORDER BY "id" LIMIT 1""" $ DLIQ.buildQuery q 21 | TM.result q [ { id: Nothing } ] 22 | TS.it "nested null" do 23 | let q = select (select created # from tags # orderBy id # limit (Proxy :: _ 1)) # from messages # orderBy id # limit (Proxy :: _ 1) 24 | TM.notParameterized """SELECT (SELECT "created" FROM "tags" ORDER BY "id" LIMIT 1) FROM "messages" ORDER BY "id" LIMIT 1""" $ DLIQ.buildQuery q 25 | --avoid (Maybe (Maybe t)) 26 | TM.result q [ { created: Nothing } ] 27 | TS.it "function" do 28 | let q = select (select (coalesce id # as id) # from users # orderBy id # limit (Proxy :: _ 1)) # from messages 29 | TM.notParameterized """SELECT (SELECT coalesce("id") AS "id" FROM "users" ORDER BY "id" LIMIT 1) FROM "messages"""" $ DLIQ.buildQuery q 30 | TM.result q [ { id: Just 1 }, { id: Just 1 } ] 31 | TS.describe "outer references" do 32 | TS.describe "projection from table" do 33 | TS.it "field" do 34 | let q = select (select (u ... id) # from users # orderBy id # limit (Proxy :: _ 1)) # from (users # as u) # orderBy id # limit (Proxy :: _ 1) 35 | TM.notParameterized """SELECT (SELECT "u"."id" "u.id" FROM "users" ORDER BY "id" LIMIT 1) FROM "users" AS "u" ORDER BY "id" LIMIT 1""" $ DLIQ.buildQuery q 36 | TM.result q [ { "u.id": Just 1 } ] 37 | TS.it "alias" do 38 | let q = select (select (u ... id # as n) # from users # orderBy id # limit (Proxy :: _ 1)) # from (users # as u) # orderBy id # limit (Proxy :: _ 1) 39 | TM.notParameterized """SELECT (SELECT "u"."id" AS "n" FROM "users" ORDER BY "id" LIMIT 1) FROM "users" AS "u" ORDER BY "id" LIMIT 1""" $ DLIQ.buildQuery q 40 | TM.result q [ { n: Just 1 } ] 41 | TS.it "same table different alias" do 42 | let q = select (select (n ... name) # from (users # as n) # orderBy id # limit (Proxy :: _ 1)) # from (users # as u) 43 | TM.notParameterized """SELECT (SELECT "n"."name" "n.name" FROM "users" AS "n" ORDER BY "id" LIMIT 1) FROM "users" AS "u"""" $ DLIQ.buildQuery q 44 | TM.result q [ { "n.name": Just "josh" }, { "n.name": Just "josh" } ] 45 | TS.it "same table alias" do 46 | let q = select (select (u ... sent) # from (messages # as u) # orderBy id # limit (Proxy :: _ 1)) # from (users # as u) 47 | TM.notParameterized """SELECT (SELECT "u"."sent" "u.sent" FROM "messages" AS "u" ORDER BY "id" LIMIT 1) FROM "users" AS "u"""" $ DLIQ.buildQuery q 48 | TM.result q [ { "u.sent": Just true }, { "u.sent": Just true } ] 49 | TS.describe "projection from named query" do 50 | TS.it "field" do 51 | let q = select (select (u ... id) # from users # orderBy id # limit (Proxy :: _ 1)) # from (select id # from users # as u) 52 | TM.notParameterized """SELECT (SELECT "u"."id" "u.id" FROM "users" ORDER BY "id" LIMIT 1) FROM (SELECT "id" FROM "users") AS "u"""" $ DLIQ.buildQuery q 53 | TM.result q [ { "u.id": Just 1 }, { "u.id": Just 2 } ] 54 | TS.it "alias" do 55 | let q = select (select (u ... id # as n) # from users # orderBy id # limit (Proxy :: _ 1)) # from (select id # from users # as u) 56 | TM.notParameterized """SELECT (SELECT "u"."id" AS "n" FROM "users" ORDER BY "id" LIMIT 1) FROM (SELECT "id" FROM "users") AS "u"""" $ DLIQ.buildQuery q 57 | TM.result q [ { n: Just 1 }, { n: Just 2 } ] -------------------------------------------------------------------------------- /test/Transaction.purs: -------------------------------------------------------------------------------- 1 | module Test.Transaction where 2 | 3 | import Droplet.Language 4 | import Prelude 5 | import Test.Types 6 | 7 | import Control.Monad.Error.Class as EA 8 | import Data.Either (Either(..)) 9 | import Data.Maybe (Maybe(..)) 10 | import Data.Tuple.Nested ((/\)) 11 | import Droplet.Driver as DD 12 | import Effect.Class (liftEffect) 13 | import Effect.Exception as EE 14 | import Test.Model (connectionInfo) 15 | import Test.Model as TM 16 | 17 | import Test.Spec (Spec) 18 | import Test.Spec as TS 19 | import Test.Spec.Assertions as TSA 20 | 21 | tests ∷ Spec Unit 22 | tests = do 23 | TS.describe "transactions" do 24 | TS.it "commited" do 25 | pool ← liftEffect $ DD.newPool connectionInfo 26 | void $ DD.withTransaction pool $ \connection → do 27 | TM.truncateTables connection 28 | 29 | let ins = insert # into users (name /\ surname /\ birthday) # values ("josh" /\ "j." /\ TM.makeDate 1990 1 1) 30 | errors ← DD.execute connection ins 31 | TSA.shouldEqual Nothing errors 32 | 33 | let sel = select id # from users 34 | result ← DD.single connection sel 35 | TSA.shouldEqual (Right (Just { id: 1 })) result 36 | 37 | let upd = update users # set ((name .=. "Mary") /\ (surname .=. "Sue")) # wher (id .=. 1) 38 | errors ← DD.execute connection upd 39 | TSA.shouldEqual Nothing errors 40 | 41 | let q = select (name /\ surname) # from users 42 | TM.result' q [ { name: "Mary", surname: "Sue" } ] 43 | TS.it "rolled back" do 44 | pool ← liftEffect $ DD.newPool connectionInfo 45 | flip EA.catchError (const (pure unit)) <<< void <<< DD.withTransaction pool $ \connection → do 46 | TM.truncateTables connection 47 | 48 | let ins = insert # into users (name /\ surname /\ birthday) # values ("josh" /\ "j." /\ TM.makeDate 1990 1 1) 49 | errors ← DD.execute connection ins 50 | TSA.shouldEqual Nothing errors 51 | 52 | void <<< EA.throwError $ EE.error "pretend it happened for some reason" 53 | 54 | let upd = update users # set ((name .=. "Mary") /\ (surname .=. "Sue")) # wher (id .=. 1) 55 | errors2 ← DD.execute connection upd 56 | TSA.shouldEqual Nothing errors2 57 | 58 | let q = select (name /\ surname) # from users 59 | TM.result' q [] 60 | -------------------------------------------------------------------------------- /test/Types.purs: -------------------------------------------------------------------------------- 1 | module Test.Types where 2 | 3 | import Prelude 4 | 5 | import Prim hiding (Constraint) 6 | import Data.Date (Date) 7 | import Data.DateTime (DateTime) 8 | import Data.Maybe (Maybe) 9 | import Data.Tuple.Nested (type (/\)) 10 | import Droplet.Language 11 | import Type.Proxy (Proxy(..)) 12 | 13 | type Users = 14 | ( id ∷ Column Int (PrimaryKey /\ Identity) 15 | , name ∷ String 16 | , surname ∷ String 17 | , birthday ∷ Column Date Default 18 | , joined ∷ Column Date Default 19 | ) 20 | 21 | type UsersTable = Table "users" Users 22 | 23 | type Messages = 24 | ( id ∷ Column Int (PrimaryKey /\ Identity) 25 | , sender ∷ Column Int (Constraint "sender_user" (ForeignKey "id" UsersTable)) 26 | , recipient ∷ Int 27 | , date ∷ Column DateTime Default 28 | , second_date ∷ Column DateTime Default 29 | , sent ∷ Boolean 30 | ) 31 | 32 | type Tags = 33 | ( id ∷ Column Int (PrimaryKey /\ Identity) 34 | , name ∷ String 35 | , created ∷ Maybe Date 36 | , by ∷ Column (Maybe Int) (Constraint "by_user" (ForeignKey "id" UsersTable)) 37 | ) 38 | 39 | type MaybeKeys = 40 | ( id ∷ Column Int PrimaryKey 41 | ) 42 | 43 | type UniqueValues = 44 | ( name ∷ Column String Unique 45 | , by ∷ Column (Maybe Int) Unique 46 | ) 47 | 48 | type DefaultColumns = 49 | ( sender ∷ Column SenderColumn (Unique /\ Default) 50 | , recipient ∷ Column RecipientColumn Default 51 | ) 52 | 53 | type DoublePrimaryKey = 54 | ( id ∷ Column Int (Identity /\ Constraint (Composite "pk_double_primary_key") PrimaryKey) 55 | , second_id ∷ Column Int (Identity /\ Constraint (Composite "pk_double_primary_key") PrimaryKey) 56 | ) 57 | 58 | type DoublePrimaryKeyTable = Table "double_primary_key" DoublePrimaryKey 59 | 60 | type Migrated = 61 | ( id ∷ Column Int PrimaryKey) 62 | 63 | 64 | type CompositeT = 65 | ( id ∷ Column Int (Identity /\ Constraint (Composite "pk_composite") PrimaryKey) 66 | , second_id ∷ Column Int (Constraint (Composite "pk_composite") PrimaryKey) 67 | , create ∷ Maybe Date 68 | , name ∷ String 69 | , sender ∷ Column Int (Constraint (Composite "sr_user") (ForeignKey "id" DoublePrimaryKeyTable)) 70 | , recipient ∷ Column Int (Constraint (Composite "sr_user") (ForeignKey "second_id" DoublePrimaryKeyTable)) 71 | ) 72 | 73 | newtype SenderColumn = SenderColumn Int 74 | newtype RecipientColumn = RecipientColumn Int 75 | 76 | instance ToValue SenderColumn where 77 | toValue (SenderColumn x) = toValue x 78 | 79 | instance ToValue RecipientColumn where 80 | toValue (RecipientColumn x) = toValue x 81 | 82 | instance FromValue SenderColumn where 83 | fromValue x = SenderColumn <$> fromValue x 84 | 85 | instance FromValue RecipientColumn where 86 | fromValue x = RecipientColumn <$> fromValue x 87 | 88 | derive instance Eq SenderColumn 89 | derive instance Eq RecipientColumn 90 | 91 | instance Show SenderColumn where 92 | show (SenderColumn x) = show x 93 | 94 | instance Show RecipientColumn where 95 | show (RecipientColumn x) = show x 96 | 97 | users ∷ UsersTable 98 | users = Table 99 | 100 | messages ∷ Table "messages" Messages 101 | messages = Table 102 | 103 | tags ∷ Table "tags" Tags 104 | tags = Table 105 | 106 | maybeKeys ∷ Table "maybe_keys" MaybeKeys 107 | maybeKeys = Table 108 | 109 | uniqueValues ∷ Table "unique_values" UniqueValues 110 | uniqueValues = Table 111 | 112 | defaultColumns ∷ Table "default_columns" DefaultColumns 113 | defaultColumns = Table 114 | 115 | doublePrimaryKey ∷ DoublePrimaryKeyTable 116 | doublePrimaryKey = Table 117 | 118 | composite ∷ Table "composite" CompositeT 119 | composite = Table 120 | 121 | migrated ∷ Table "migrated" Migrated 122 | migrated = Table 123 | 124 | id ∷ Proxy "id" 125 | id = Proxy 126 | 127 | name ∷ Proxy "name" 128 | name = Proxy 129 | 130 | surname ∷ Proxy "surname" 131 | surname = Proxy 132 | 133 | sent ∷ Proxy "sent" 134 | sent = Proxy 135 | 136 | date ∷ Proxy "date" 137 | date = Proxy 138 | 139 | joined ∷ Proxy "joined" 140 | joined = Proxy 141 | 142 | birthday ∷ Proxy "birthday" 143 | birthday = Proxy 144 | 145 | sender ∷ Proxy "sender" 146 | sender = Proxy 147 | 148 | recipient ∷ Proxy "recipient" 149 | recipient = Proxy 150 | 151 | secondDate ∷ Proxy "second_date" 152 | secondDate = Proxy 153 | 154 | secondId ∷ Proxy "second_id" 155 | secondId = Proxy 156 | 157 | created ∷ Proxy "created" 158 | created = Proxy 159 | 160 | _by ∷ Proxy "by" 161 | _by = Proxy 162 | 163 | b ∷ Proxy "b" 164 | b = Proxy 165 | 166 | n ∷ Proxy "n" 167 | n = Proxy 168 | 169 | t ∷ Proxy "t" 170 | t = Proxy 171 | 172 | u ∷ Proxy "u" 173 | u = Proxy 174 | 175 | bigB ∷ Proxy "B" 176 | bigB = Proxy 177 | 178 | date_part_age ∷ FunctionSignature (String /\ DateTime) Int 179 | date_part_age = function "date_part_age" 180 | 181 | date_part_age' ∷ FunctionSignature (String /\ Date) Int 182 | date_part_age' = function "date_part_age" 183 | 184 | fire_missiles ∷ FunctionSignature (Int /\ Int) Unit 185 | fire_missiles = function "fire_missiles" 186 | 187 | utc_now ∷ FunctionSignature' DateTime 188 | utc_now = function' "utc_now" -------------------------------------------------------------------------------- /test/Union.purs: -------------------------------------------------------------------------------- 1 | module Test.Union where 2 | 3 | import Droplet.Language (as, from, select, union, unionAll, wher, (.<>.), (.=.)) 4 | import Prelude 5 | import Test.Types (b, id, messages, name, users) 6 | 7 | import Droplet.Language.Internal.Translate as DLIQ 8 | import Test.Model as TM 9 | 10 | import Test.Spec (Spec) 11 | import Test.Spec as TS 12 | 13 | 14 | tests ∷ Spec Unit 15 | tests = do 16 | TS.describe "union" do 17 | TS.it "select" do 18 | let q = (select id # from users # wher (name .=. "mary")) `union` (select id # from users # wher (name .<>. "mary")) 19 | TM.parameterized """(SELECT "id" FROM "users" WHERE "name" = $1 UNION SELECT "id" FROM "users" WHERE "name" <> $2)""" $ DLIQ.buildQuery q 20 | TM.result q [ { id: 2 }, { id: 1 } ] 21 | TS.it "as" do 22 | let q = (select id # from (users # as b)) `union` (select id # from users # wher (name .<>. "mary")) 23 | TM.parameterized """(SELECT "id" FROM "users" AS "b" UNION SELECT "id" FROM "users" WHERE "name" <> $1)""" $ DLIQ.buildQuery q 24 | TM.result q [ { id: 2 }, { id: 1 } ] 25 | TS.describe "from union" do 26 | TS.it "left" do 27 | let q = ((select id # from users) `union` (select id # from messages)) `union` (select id # from users) 28 | TM.notParameterized """((SELECT "id" FROM "users" UNION SELECT "id" FROM "messages") UNION SELECT "id" FROM "users")""" $ DLIQ.buildQuery q 29 | TM.result q [ { id: 2 }, { id: 1 } ] 30 | TS.it "right" do 31 | let q = (select id # from users) `union` ((select id # from messages) `union` (select id # from users)) 32 | TM.notParameterized """(SELECT "id" FROM "users" UNION (SELECT "id" FROM "messages" UNION SELECT "id" FROM "users"))""" $ DLIQ.buildQuery q 33 | TM.result q [ { id: 2 }, { id: 1 } ] 34 | 35 | TS.describe "union all" do 36 | TS.it "select" do 37 | let q = (select id # from users # wher (name .=. "mary")) `unionAll` (select id # from users # wher (name .<>. "mary")) 38 | TM.parameterized """(SELECT "id" FROM "users" WHERE "name" = $1 UNION ALL SELECT "id" FROM "users" WHERE "name" <> $2)""" $ DLIQ.buildQuery q 39 | TM.result q [ { id: 2 }, { id: 1 } ] 40 | TS.it "as" do 41 | let q = (select id # from (users # as b)) `unionAll` (select id # from users # wher (name .<>. "mary")) 42 | TM.parameterized """(SELECT "id" FROM "users" AS "b" UNION ALL SELECT "id" FROM "users" WHERE "name" <> $1)""" $ DLIQ.buildQuery q 43 | TM.result q [ { id: 1 }, { id: 2 }, { id: 1 } ] 44 | TS.describe "from unionAll" do 45 | TS.it "left" do 46 | let q = ((select id # from users) `unionAll` (select id # from messages)) `unionAll` (select id # from users) 47 | TM.notParameterized """((SELECT "id" FROM "users" UNION ALL SELECT "id" FROM "messages") UNION ALL SELECT "id" FROM "users")""" $ DLIQ.buildQuery q 48 | TM.result q [ { id: 1 }, { id: 2 }, { id: 1 }, { id: 2 }, { id: 1 }, { id: 2 } ] 49 | TS.it "right" do 50 | let q = (select id # from users) `unionAll` ((select id # from messages) `unionAll` (select id # from users)) 51 | TM.notParameterized """(SELECT "id" FROM "users" UNION ALL (SELECT "id" FROM "messages" UNION ALL SELECT "id" FROM "users"))""" $ DLIQ.buildQuery q 52 | TM.result q [ { id: 1 }, { id: 2 }, { id: 1 }, { id: 2 }, { id: 1 }, { id: 2 } ] 53 | -------------------------------------------------------------------------------- /test/Unsafe.purs: -------------------------------------------------------------------------------- 1 | module Test.Unsafe where 2 | 3 | import Prelude 4 | 5 | import Data.Array ((!!)) 6 | import Data.Array as DA 7 | import Data.Array.Partial as DAP 8 | import Data.Maybe (Maybe(..)) 9 | import Data.Maybe as DM 10 | import Data.Tuple.Nested ((/\)) 11 | import Droplet.Language.Internal.Translate (Query(..)) 12 | import Droplet.Language.Internal.Translate as DLIQ 13 | import Foreign as F 14 | import Partial.Unsafe as PU 15 | import Test.Model as TM 16 | 17 | import Test.Spec (Spec) 18 | import Test.Spec as TS 19 | import Test.Spec.Assertions as TSA 20 | 21 | 22 | tests ∷ Spec Unit 23 | tests = do 24 | TS.describe "unsafe queries" do 25 | TS.it "select" do 26 | let (plan /\ q /\ pr) = Nothing /\ """SELECT "name", m.id FROM "users" u JOIN "messages" m on "u"."id" = m.sender WHERE "u"."id" = @id OR "u"."id" = @id2 OR "u"."id" = @id3""" /\ { id: 2, id2: 3, id3: 4 } 27 | let Query _ dollaredQ parameters = DLIQ.unsafeBuildQuery plan q pr 28 | --parameters are replaced by field order 29 | TSA.shouldEqual """SELECT "name", m.id FROM "users" u JOIN "messages" m on "u"."id" = m.sender WHERE "u"."id" = $1 OR "u"."id" = $2 OR "u"."id" = $3""" dollaredQ 30 | TSA.shouldEqual 3 $ DA.length parameters 31 | TSA.shouldEqual pr.id <<< F.unsafeFromForeign $ PU.unsafePartial (DAP.head parameters) 32 | TSA.shouldEqual pr.id2 <<< F.unsafeFromForeign $ PU.unsafePartial (DM.fromJust $ parameters !! 1) 33 | TSA.shouldEqual pr.id3 <<< F.unsafeFromForeign $ PU.unsafePartial (DM.fromJust $ parameters !! 2) 34 | TM.unsafeResult plan q pr [ { name: "mary", id: 2 } ] 35 | TS.it "insert" do 36 | let (plan /\ q) = Nothing /\ "insert into tags(name) values('hey')" 37 | let Query _ dollaredQ parameters = DLIQ.unsafeBuildQuery plan q {} 38 | TSA.shouldEqual "insert into tags(name) values('hey')" dollaredQ 39 | TSA.shouldEqual 0 $ DA.length parameters 40 | TM.unsafeResult plan q {} ([] ∷ Array {}) 41 | TS.it "update" do 42 | let (plan /\ q /\ pr) = Nothing /\ """UPDATE users SET "name" = @name WHERE "id" = @id""" /\ { name: "Suzy", id: 23 } 43 | let Query _ dollaredQ parameters = DLIQ.unsafeBuildQuery plan q pr 44 | --parameters are replaced by field order 45 | TSA.shouldEqual """UPDATE users SET "name" = $2 WHERE "id" = $1""" dollaredQ 46 | TSA.shouldEqual 2 $ DA.length parameters 47 | TSA.shouldEqual pr.id <<< F.unsafeFromForeign $ PU.unsafePartial (DAP.head parameters) 48 | TSA.shouldEqual pr.name <<< F.unsafeFromForeign $ PU.unsafePartial (DM.fromJust $ parameters !! 1) 49 | TM.unsafeResult plan q pr ([] ∷ Array {}) 50 | TS.it "delete" do 51 | let (plan /\ q /\ pr) = Nothing /\ """DELETE FROM "users" WHERE joined = @joined""" /\ { joined: TM.makeDate 2000 1 1 } 52 | let Query _ dollaredQ parameters = DLIQ.unsafeBuildQuery plan q pr 53 | --parameters are replaced by field order 54 | TSA.shouldEqual """DELETE FROM "users" WHERE joined = $1""" dollaredQ 55 | TSA.shouldEqual 1 $ DA.length parameters 56 | TM.unsafeResult plan q pr ([] ∷ Array {}) 57 | -------------------------------------------------------------------------------- /test/Update.purs: -------------------------------------------------------------------------------- 1 | module Test.Update where 2 | 3 | import Droplet.Language 4 | import Droplet.Language 5 | import Prelude 6 | import Test.Types 7 | 8 | import Data.Tuple.Nested ((/\)) 9 | import Droplet.Language.Internal.Translate as DLIQ 10 | import Test.Model as TM 11 | 12 | import Test.Spec (Spec) 13 | import Test.Spec as TS 14 | 15 | tests ∷ Spec Unit 16 | tests = TS.describe "setup" do 17 | TS.describe "set" do 18 | TS.it "single field" do 19 | let q = update users # set (surname .=. "Sue") 20 | TM.parameterized """UPDATE "users" SET surname = $1""" $ DLIQ.buildQuery q 21 | TM.result q [] 22 | TS.it "fields" do 23 | let q = update users # set ((name .=. "Mary") /\ (surname .=. "Sue")) 24 | TM.parameterized """UPDATE "users" SET name = $1, surname = $2""" $ DLIQ.buildQuery q 25 | TM.result q [] 26 | TS.it "default" do 27 | let q = update users # set ((name .=. "Mary") /\ (birthday .=. Default)) 28 | TM.parameterized """UPDATE "users" SET name = $1, birthday = DEFAULT""" $ DLIQ.buildQuery q 29 | TM.result q [] 30 | TS.describe "where" do 31 | TS.it "single field" do 32 | let q = update users # set (surname .=. "Sue") # wher (id .=. 1) 33 | TM.parameterized """UPDATE "users" SET surname = $1 WHERE "id" = $2""" $ DLIQ.buildQuery q 34 | TM.result q [] 35 | TS.it "fields" do 36 | let q = update users # set ((name .=. "Mary") /\ (surname .=. "Sue")) # wher (id .=. 2 .||. id .=. 4) 37 | TM.parameterized """UPDATE "users" SET name = $1, surname = $2 WHERE ("id" = $3 OR "id" = $4)""" $ DLIQ.buildQuery q 38 | TM.result q [] 39 | -------------------------------------------------------------------------------- /test/Where.purs: -------------------------------------------------------------------------------- 1 | module Test.Where where 2 | 3 | import Droplet.Language 4 | import Prelude hiding (not, join) 5 | import Test.Types 6 | 7 | import Data.Array.NonEmpty as DAN 8 | import Data.Maybe (Maybe(..)) 9 | import Data.NonEmpty (NonEmpty(..)) 10 | import Data.Tuple.Nested ((/\)) 11 | import Droplet.Language.Internal.Translate as DLIQ 12 | import Test.Model as TM 13 | import Test.Spec (Spec) 14 | import Test.Spec as TS 15 | import Type.Proxy (Proxy(..)) 16 | 17 | tests ∷ Spec Unit 18 | tests = do 19 | TS.describe "where" do 20 | TS.describe "compared to parameter" do 21 | TS.it "equals" do 22 | let q = select recipient # from messages # wher (sender .=. 1) 23 | TM.parameterized """SELECT "recipient" FROM "messages" WHERE "sender" = $1""" $ DLIQ.buildQuery q 24 | TM.result q [ { recipient: 2 } ] 25 | TS.it "not equals" do 26 | let q = select sender # from messages # wher (recipient .<>. 2) 27 | TM.parameterized """SELECT "sender" FROM "messages" WHERE "recipient" <> $1""" $ DLIQ.buildQuery q 28 | TM.result q [ { sender: 2 } ] 29 | TS.it "lesser than" do 30 | let q = select sender # from messages # wher (recipient .<. 2) 31 | TM.parameterized """SELECT "sender" FROM "messages" WHERE "recipient" < $1""" $ DLIQ.buildQuery q 32 | TM.result q [ { sender: 2 } ] 33 | TS.it "lesser equals than" do 34 | let q = select sender # from messages # wher (recipient .<=. 2) 35 | TM.parameterized """SELECT "sender" FROM "messages" WHERE "recipient" <= $1""" $ DLIQ.buildQuery q 36 | TM.result q [ { sender: 1}, { sender: 2 } ] 37 | TS.it "nullable" do 38 | let q = select _by # from tags # wher (_by .=. 2) 39 | TM.parameterized """SELECT "by" FROM "tags" WHERE "by" = $1""" $ DLIQ.buildQuery q 40 | TM.result q [ ] 41 | 42 | TS.describe "compared to field" do 43 | TS.it "equals" do 44 | let q = select (34 # as n) # from users # wher (name .=. surname) 45 | TM.notParameterized """SELECT 34 AS "n" FROM "users" WHERE "name" = "surname"""" $ DLIQ.buildQuery q 46 | TM.result q [] 47 | TS.it "not equals" do 48 | let q = select (34 # as n) # from users # wher (name .<>. surname) 49 | TM.notParameterized """SELECT 34 AS "n" FROM "users" WHERE "name" <> "surname"""" $ DLIQ.buildQuery q 50 | TM.result q [ { n: 34 }, { n: 34 } ] 51 | TS.it "greater than" do 52 | let q = select sender # from messages # wher (recipient .>. 2) 53 | TM.parameterized """SELECT "sender" FROM "messages" WHERE "recipient" > $1""" $ DLIQ.buildQuery q 54 | TM.result q [] 55 | TS.it "greater equals than" do 56 | let q = select sender # from messages # wher (recipient .>=. 2) 57 | TM.parameterized """SELECT "sender" FROM "messages" WHERE "recipient" >= $1""" $ DLIQ.buildQuery q 58 | TM.result q [{sender: 1}] 59 | 60 | TS.describe "logical operands" do 61 | TS.describe "and" do 62 | TS.it "single" do 63 | let q = select id # from users # wher (name .=. "josh" .&&. name .<>. surname) 64 | TM.parameterized """SELECT "id" FROM "users" WHERE ("name" = $1 AND "name" <> "surname")""" $ DLIQ.buildQuery q 65 | TM.result q [ { id: 1 } ] 66 | TS.it "many" do 67 | let q = select id # from users # wher (name .=. "josh" .&&. "josh" .=. name .&&. surname .=. "j.") 68 | TM.parameterized """SELECT "id" FROM "users" WHERE (("name" = $1 AND $2 = "name") AND "surname" = $3)""" $ DLIQ.buildQuery q 69 | TM.result q [ { id: 1 } ] 70 | 71 | TS.describe "or" do 72 | TS.it "single" do 73 | let q = select id # from users # wher (name .=. "mary" .||. name .=. surname) 74 | TM.parameterized """SELECT "id" FROM "users" WHERE ("name" = $1 OR "name" = "surname")""" $ DLIQ.buildQuery q 75 | TM.result q [ { id: 2 } ] 76 | TS.it "many" do 77 | let q = select id # from users # wher (name .=. "josh" .||. name .=. "j." .||. surname .<>. "josh") 78 | TM.parameterized """SELECT "id" FROM "users" WHERE (("name" = $1 OR "name" = $2) OR "surname" <> $3)""" $ DLIQ.buildQuery q 79 | TM.result q [ { id: 1 }, { id: 2 } ] 80 | 81 | TS.it "in" do 82 | let q = select id # from users # wher (id `in_` DAN.fromNonEmpty (NonEmpty 3 [4, 5])) 83 | TM.parameterized """SELECT "id" FROM "users" WHERE "id" IN ($1, $2, $3)""" $ DLIQ.buildQuery q 84 | TM.result q [] 85 | 86 | TS.describe "is null" do 87 | TS.it "maybe field" do 88 | let q = select id # from tags # wher (_by # isNull) 89 | TM.notParameterized """SELECT "id" FROM "tags" WHERE "by" IS NULL""" $ DLIQ.buildQuery q 90 | TM.result q [ ] 91 | TS.it "joined field" do 92 | let q = select joined # from (leftJoin users (tags # as t) # on (joined .=. created)) # wher (isNull (t ... id)) 93 | TM.notParameterized """SELECT "joined" FROM "users" LEFT JOIN "tags" AS "t" ON "joined" = "created" WHERE "t"."id" IS NULL""" $ DLIQ.buildQuery q 94 | TM.result' q [] 95 | 96 | TS.describe "is not null" do 97 | TS.it "maybe field" do 98 | let q = select id # from tags # wher (_by # isNotNull) 99 | TM.notParameterized """SELECT "id" FROM "tags" WHERE "by" IS NOT NULL""" $ DLIQ.buildQuery q 100 | TM.result q [ { id: 1 } ] 101 | TS.it "joined field" do 102 | let q = select joined # from (leftJoin users (tags # as t) # on (joined .=. created)) # wher (isNotNull (t ... id)) 103 | TM.notParameterized """SELECT "joined" FROM "users" LEFT JOIN "tags" AS "t" ON "joined" = "created" WHERE "t"."id" IS NOT NULL""" $ DLIQ.buildQuery q 104 | TM.result q [ ] 105 | 106 | TS.describe "not" do 107 | TS.it "operator" do 108 | let q = select id # from users # wher (not (id .<>. 5)) 109 | TM.parameterized """SELECT "id" FROM "users" WHERE NOT "id" <> $1""" $ DLIQ.buildQuery q 110 | TM.result q [] 111 | TS.it "and" do 112 | let q = select id # from (users # as u) # wher (not (id .<>. 5) .&&. id .=. 1) 113 | TM.parameterized """SELECT "id" FROM "users" AS "u" WHERE (NOT "id" <> $1 AND "id" = $2)""" $ DLIQ.buildQuery q 114 | TM.result q [] 115 | TS.it "or" do 116 | let q = select id # from (users # as u) # wher (not (id .<>. 5 .||. id .=. 1)) 117 | TM.parameterized """SELECT "id" FROM "users" AS "u" WHERE NOT ("id" <> $1 OR "id" = $2)""" $ DLIQ.buildQuery q 118 | TM.result q [] 119 | TS.it "exists" do 120 | let q = select id # from (users # as u) # wher (not $ exists $ select id # from users) 121 | TM.notParameterized """SELECT "id" FROM "users" AS "u" WHERE NOT EXISTS (SELECT "id" FROM "users")""" $ DLIQ.buildQuery q 122 | TM.result q [] 123 | 124 | TS.describe "exists" do 125 | TS.it "column" do 126 | let q = select id # from users # wher (exists $ select id # from users) 127 | TM.notParameterized """SELECT "id" FROM "users" WHERE EXISTS (SELECT "id" FROM "users")""" $ DLIQ.buildQuery q 128 | TM.result q [ { id: 1 }, { id: 2 } ] 129 | TS.describe "path" do 130 | TS.it "outer" do 131 | let q = select id # from (users # as u) # wher (exists $ select (u ... id) # from users) 132 | TM.notParameterized """SELECT "id" FROM "users" AS "u" WHERE EXISTS (SELECT "u"."id" "u.id" FROM "users")""" $ DLIQ.buildQuery q 133 | TM.result q [ { id: 1 }, { id: 2 } ] 134 | TS.it "outer where" do 135 | let q = select id # from (users # as u) # wher (exists $ select (3 # as t) # from users # wher (id .=. u ... id)) 136 | TM.notParameterized """SELECT "id" FROM "users" AS "u" WHERE EXISTS (SELECT 3 AS "t" FROM "users" WHERE "id" = "u"."id")""" $ DLIQ.buildQuery q 137 | TM.result q [ { id: 1 }, { id: 2 } ] 138 | TS.it "outer inner where" do 139 | let q = select id # from (users # as u) # wher (exists $ select id # from (users # as t) # wher (t ... id .=. u ... id)) 140 | TM.notParameterized """SELECT "id" FROM "users" AS "u" WHERE EXISTS (SELECT "id" FROM "users" AS "t" WHERE "t"."id" = "u"."id")""" $ DLIQ.buildQuery q 141 | TM.result q [ { id: 1 }, { id: 2 } ] 142 | 143 | TS.describe "mixed" do 144 | TS.it "not bracketed" do 145 | let q = select id # from users # wher (id .=. 333 .||. id .=. 33 .&&. id .=. 3) 146 | TM.parameterized """SELECT "id" FROM "users" WHERE ("id" = $1 OR ("id" = $2 AND "id" = $3))""" $ DLIQ.buildQuery q 147 | TM.result q [] 148 | TS.it "bracketed" do 149 | let q = select id # from users # wher ((id .=. 2 .||. id .=. 22) .&&. id .=. 2) 150 | TM.parameterized """SELECT "id" FROM "users" WHERE (("id" = $1 OR "id" = $2) AND "id" = $3)""" $ DLIQ.buildQuery q 151 | TM.result q [ { id: 2 } ] 152 | TS.it "with exists" do 153 | let q = select id # from users # wher ((id .=. 2 .||. (exists $ select id # from users)) .&&. id .=. 2) 154 | TM.parameterized """SELECT "id" FROM "users" WHERE (("id" = $1 OR EXISTS (SELECT "id" FROM "users")) AND "id" = $2)""" $ DLIQ.buildQuery q 155 | TM.result q [ { id: 2 } ] 156 | TS.it "with not" do 157 | let q = select id # from users # wher ((id .=. 2 .||. not (exists $ select id # from users)) .&&. not (id .=. 2)) 158 | TM.parameterized """SELECT "id" FROM "users" WHERE (("id" = $1 OR NOT EXISTS (SELECT "id" FROM "users")) AND NOT "id" = $2)""" $ DLIQ.buildQuery q 159 | TM.result q [] 160 | 161 | TS.describe "subqueries" do 162 | TS.it "scalar" do 163 | let namep = "mary" 164 | let q = select (select (4 # as n) # from users # wher (name .=. namep) # orderBy id # limit (Proxy :: _ 1) # as b) 165 | TM.parameterized """SELECT (SELECT 4 AS "n" FROM "users" WHERE "name" = $1 ORDER BY "id" LIMIT 1) AS "b"""" $ DLIQ.buildQuery q 166 | TM.result q [ { b: Just 4 } ] 167 | TS.it "field" do 168 | let namep = "josh" 169 | let q = select (select id # from users # wher (name .=. namep) # orderBy id # limit (Proxy :: _ 1) # as b) 170 | TM.parameterized """SELECT (SELECT "id" FROM "users" WHERE "name" = $1 ORDER BY "id" LIMIT 1) AS "b"""" $ DLIQ.buildQuery q 171 | TM.result q [ { b: Just 1 } ] 172 | TS.it "tuple" do 173 | let parameters = { d: "mary", e: 2 } 174 | let q = select ((3 # as (Proxy ∷ Proxy "e")) /\ (select id # from users # wher (name .=. parameters.d) # orderBy id # limit (Proxy :: _ 1) # as b) /\ (select id # from messages # wher (id .=. parameters.e) # orderBy id # limit (Proxy :: _ 1) # as n)) 175 | TM.parameterized """SELECT 3 AS "e", (SELECT "id" FROM "users" WHERE "name" = $1 ORDER BY "id" LIMIT 1) AS "b", (SELECT "id" FROM "messages" WHERE "id" = $2 ORDER BY "id" LIMIT 1) AS "n"""" $ DLIQ.buildQuery q 176 | TM.result q [ { e: 3, b: Just 2, n: Just 2 } ] 177 | TS.it "where" do 178 | let parameters = { d: "mary", e: 2 } 179 | let q = select ((3 # as (Proxy ∷ Proxy "e")) /\ (select id # from users # wher (name .=. parameters.d) # orderBy id # limit (Proxy :: _ 1) # as b) /\ (select id # from messages # wher (id .=. parameters.e) # orderBy id # limit (Proxy :: _ 1) # as n)) # from users # wher (id .=. 1 .||. id .=. 2) 180 | TM.parameterized """SELECT 3 AS "e", (SELECT "id" FROM "users" WHERE "name" = $1 ORDER BY "id" LIMIT 1) AS "b", (SELECT "id" FROM "messages" WHERE "id" = $2 ORDER BY "id" LIMIT 1) AS "n" FROM "users" WHERE ("id" = $3 OR "id" = $4)""" $ DLIQ.buildQuery q 181 | TM.result q [ { e: 3, b: Just 2, n: Just 2 }, { e: 3, b: Just 2, n: Just 2 } ] 182 | 183 | TS.describe "references" do 184 | TS.it "named table" do 185 | let q = select recipient # from (messages # as u) # wher (sender .=. 1) 186 | TM.parameterized """SELECT "recipient" FROM "messages" AS "u" WHERE "sender" = $1""" $ DLIQ.buildQuery q 187 | TM.result q [ { recipient: 2 } ] 188 | TS.it "named table alias" do 189 | let q = select (u ... id) # from (users # as u) # wher (u ... id .<>. 3) 190 | TM.parameterized """SELECT "u"."id" "u.id" FROM "users" AS "u" WHERE "u"."id" <> $1""" $ DLIQ.buildQuery q 191 | TM.result q [ { "u.id": 1 }, { "u.id": 2 } ] 192 | TS.it "named subquery" do 193 | let q = select n # from (select (id # as n) # from users # as u) # wher (u ... n .<>. 3) 194 | TM.parameterized """SELECT "n" FROM (SELECT "id" AS "n" FROM "users") AS "u" WHERE "u"."n" <> $1""" $ DLIQ.buildQuery q 195 | TM.result q [ { n: 1 }, { n: 2 } ] 196 | TS.describe "column subquery" do 197 | TS.it "outer" do 198 | let q = select (select id # from users # wher (u ... id .<>. id) # orderBy id # limit (Proxy :: _ 1)) # from (users # as u) 199 | TM.notParameterized """SELECT (SELECT "id" FROM "users" WHERE "u"."id" <> "id" ORDER BY "id" LIMIT 1) FROM "users" AS "u"""" $ DLIQ.buildQuery q 200 | TM.result q [ { id: Just 2 }, { id: Just 1 } ] 201 | TS.it "value" do 202 | let q = select (id /\ (select ((u ... id) # as n) # from users # wher (id .=. 2) # orderBy id # limit (Proxy :: _ 1))) # from (users # as u) 203 | TM.parameterized """SELECT "id", (SELECT "u"."id" AS "n" FROM "users" WHERE "id" = $1 ORDER BY "id" LIMIT 1) FROM "users" AS "u"""" $ DLIQ.buildQuery q 204 | TM.result q [ { id: 1, n: Just 1 }, { id: 2, n: Just 2 } ] 205 | TS.it "inner alias" do 206 | let q = select (select (n ... name) # from (users # as n) # wher (u ... id .<>. n ... id) # orderBy id # limit (Proxy :: _ 1)) # from (users # as u) 207 | TM.notParameterized """SELECT (SELECT "n"."name" "n.name" FROM "users" AS "n" WHERE "u"."id" <> "n"."id" ORDER BY "id" LIMIT 1) FROM "users" AS "u"""" $ DLIQ.buildQuery q 208 | TM.result q [ { "n.name": Just "mary" }, { "n.name": Just "josh" } ] 209 | TS.it "same alias" do 210 | let q = select (id /\ (select (u ... id) # from (users # as u) # wher (u ... id .<>. u ... id) # orderBy id # limit (Proxy :: _ 1))) # from (users # as u) 211 | TM.notParameterized """SELECT "id", (SELECT "u"."id" "u.id" FROM "users" AS "u" WHERE "u"."id" <> "u"."id" ORDER BY "id" LIMIT 1) FROM "users" AS "u"""" $ DLIQ.buildQuery q 212 | TM.result q [ { id: 1, "u.id": Nothing }, { id: 2, "u.id": Nothing } ] 213 | TS.it "join" do 214 | let q = select ((select name # from users # wher (id .=. u ... _by) # orderBy id # limit (Proxy :: _ 1)) # as b) # from (join (tags # as u) (messages # as b) # on (u ... id .=. b ... id)) # wher (u ... id .=. 34) 215 | TM.parameterized """SELECT (SELECT "name" FROM "users" WHERE "id" = "u"."by" ORDER BY "id" LIMIT 1) AS "b" FROM "tags" AS "u" INNER JOIN "messages" AS "b" ON "u"."id" = "b"."id" WHERE "u"."id" = $1""" $ DLIQ.buildQuery q 216 | TM.result q [] -------------------------------------------------------------------------------- /test/sql/index.sql: -------------------------------------------------------------------------------- 1 | create or replace function utc_now() 2 | returns timestamptz as 3 | $body$ 4 | begin 5 | return now() at time zone 'utc'; 6 | end; 7 | $body$ 8 | language plpgsql; 9 | 10 | create or replace function recipient_default() 11 | returns integer as 12 | $body$ 13 | begin 14 | return (select coalesce(max(recipient), 1) from default_columns); -- don't try it at home 15 | end; 16 | $body$ 17 | language plpgsql; 18 | 19 | create table users ( 20 | id integer generated always as identity primary key, 21 | name text not null, 22 | surname text not null, 23 | birthday date default (utc_now()), 24 | joined date default (utc_now()) 25 | ); 26 | 27 | create table messages ( 28 | id integer generated always as identity primary key, 29 | sender integer not null, 30 | recipient integer not null, 31 | date timestamp without time zone default (utc_now()), 32 | second_date timestamp with time zone default (utc_now()), 33 | sent bool not null, 34 | 35 | constraint sender_user foreign key (sender) references users(id), 36 | constraint recipient_user foreign key (recipient) references users(id) 37 | ); 38 | 39 | create table tags ( 40 | id integer generated always as identity primary key, 41 | name text not null, 42 | created date, 43 | by integer, 44 | 45 | constraint by_user foreign key (by) references users(id) 46 | ); 47 | 48 | create table maybe_keys ( 49 | id integer primary key 50 | ); 51 | 52 | create table unique_values ( 53 | name text not null unique, 54 | by integer unique 55 | ); 56 | 57 | create table default_columns ( 58 | recipient integer unique not null default (recipient_default()), 59 | sender integer default (44) 60 | ); 61 | 62 | create table double_primary_key ( 63 | id integer generated always as identity, 64 | second_id integer generated always as identity , 65 | 66 | constraint pk_double_primary_key primary key (id, second_id) 67 | ); 68 | 69 | create table composite ( 70 | id integer generated always as identity, 71 | second_id integer not null, 72 | name text not null, 73 | created date, 74 | sender integer, 75 | recipient integer, 76 | 77 | constraint pk_composite primary key (id, second_id), 78 | constraint sr_user foreign key (sender, recipient) references double_primary_key(id, second_id ) 79 | ); 80 | 81 | create or replace function truncate_tables() 82 | returns void as 83 | $body$ 84 | begin 85 | truncate table users restart identity cascade; 86 | truncate table messages restart identity cascade; 87 | truncate table tags restart identity cascade; 88 | truncate table maybe_keys cascade; 89 | truncate table unique_values cascade; 90 | truncate table default_columns cascade; 91 | truncate table double_primary_key restart identity cascade; 92 | truncate table composite restart identity cascade; 93 | drop table if exists test; 94 | drop table if exists migrated; 95 | drop table if exists __droplet_migrations__; 96 | end; 97 | $body$ 98 | language plpgsql; 99 | 100 | create or replace function date_part_age(part text, tm timestamp with time zone) 101 | returns integer as 102 | $body$ 103 | begin 104 | return date_part(part, age(now (), tm)); 105 | end; 106 | $body$ 107 | language plpgsql; 108 | 109 | create or replace function fire_missiles(a integer, b integer) 110 | returns void as 111 | $body$ 112 | begin 113 | 114 | end; 115 | $body$ 116 | language plpgsql; --------------------------------------------------------------------------------