├── docker ├── tmux.conf ├── entrypoint.sh ├── bashrc ├── vimrc ├── pg_hba.conf ├── zshrc └── Dockerfile ├── .gitignore ├── doc ├── Makefile ├── content-docinfo.html └── content.adoc ├── .travis.yml ├── README.md ├── deploy.clj ├── test ├── user.clj └── suricatta │ ├── dsl_test.clj │ ├── extend_test.clj │ └── core_test.clj ├── scripts └── bench.clj ├── deps.edn ├── LICENSE ├── pom.xml ├── manage.sh ├── src └── suricatta │ ├── proto.clj │ ├── core.clj │ ├── dsl │ └── alpha.clj │ └── impl.clj └── CHANGES.adoc /docker/tmux.conf: -------------------------------------------------------------------------------- 1 | set -g mouse off 2 | set -g history-limit 50000 3 | setw -g mode-keys emacs 4 | -------------------------------------------------------------------------------- /docker/entrypoint.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env zsh 2 | set -ex 3 | sudo pg_ctlcluster 9.6 main start 4 | 5 | exec "$@" 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | /pom.xml.asc 5 | *.jar 6 | *.class 7 | /.lein-* 8 | /.nrepl-port 9 | /doc/dist 10 | /.cpcache 11 | /.rebel_readline_history -------------------------------------------------------------------------------- /docker/bashrc: -------------------------------------------------------------------------------- 1 | export PATH=$HOME/.local/bin:$PATH 2 | 3 | alias l='ls --color -GFlh' 4 | alias rm='rm -r' 5 | alias ls='ls --color -F' 6 | alias lsd='ls -d *(/)' 7 | alias lsf='ls -h *(.)' 8 | 9 | export LEIN_FAST_TRAMPOLINE=y 10 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | all: doc 2 | 3 | doc: 4 | mkdir -p dist/latest/ 5 | asciidoctor -a docinfo -a stylesheet! -o dist/latest/index.html content.adoc 6 | 7 | github: doc 8 | ghp-import -m "Generate documentation" -b gh-pages dist/ 9 | git push origin gh-pages 10 | -------------------------------------------------------------------------------- /doc/content-docinfo.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /docker/vimrc: -------------------------------------------------------------------------------- 1 | set nocompatible 2 | 3 | set bs=2 4 | set ts=4 5 | set tw=1000000000 6 | 7 | set expandtab 8 | set tabstop=8 9 | set softtabstop=4 10 | set shiftwidth=4 11 | filetype indent off 12 | filetype plugin on 13 | 14 | syntax on 15 | 16 | set autoindent 17 | set showmatch 18 | set showmode 19 | set mousehide 20 | 21 | set nowrapscan 22 | set hlsearch 23 | set incsearch 24 | 25 | set fileencoding=utf8 26 | set encoding=utf8 27 | -------------------------------------------------------------------------------- /docker/pg_hba.conf: -------------------------------------------------------------------------------- 1 | # Database administrative login by Unix domain socket 2 | local all postgres trust 3 | 4 | # TYPE DATABASE USER ADDRESS METHOD 5 | 6 | # "local" is for Unix domain socket connections only 7 | local all all trust 8 | # IPv4 local connections: 9 | host all all 127.0.0.1/32 trust 10 | # IPv6 local connections: 11 | host all all ::1/128 trust 12 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: xenial 2 | 3 | language: java 4 | sudo: required 5 | 6 | cache: 7 | directories: 8 | - $HOME/.m2 9 | 10 | install: 11 | - curl -O https://download.clojure.org/install/linux-install-1.10.1.447.sh 12 | - chmod +x linux-install-1.10.1.447.sh 13 | - sudo ./linux-install-1.10.1.447.sh 14 | 15 | addons: 16 | postgresql: 9.6 17 | 18 | services: 19 | - postgresql 20 | 21 | before_script: 22 | - createdb test 23 | 24 | jdk: 25 | - openjdk8 26 | 27 | branches: 28 | only: 29 | - master 30 | - wip 31 | 32 | script: 33 | - clojure -Adev:test 34 | 35 | notifications: 36 | email: false 37 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # suricatta # 2 | 3 | [![Travis Badge](https://img.shields.io/travis/funcool/suricatta.svg?style=flat)](https://travis-ci.org/funcool/suricatta "Travis Badge") 4 | 5 | High level sql toolkit for clojure (backed by jooq library) 6 | 7 | ## Latest Version 8 | 9 | [![Clojars Project](http://clojars.org/funcool/suricatta/latest-version.svg)](http://clojars.org/funcool/suricatta) 10 | 11 | 12 | ## Quick Start ## 13 | 14 | Put suricatta on your dependency list: 15 | 16 | ```clojure 17 | [funcool/suricatta "2.0.0"] 18 | [com.h2database/h2 "1.4.191"] ;; For this example only 19 | ``` 20 | 21 | Connect to the database and execute a query: 22 | 23 | ```clojure 24 | (require '[suricatta.core :as sc]) 25 | 26 | (with-open [ctx (sc/context "h2:mem:")] 27 | (sc/fetch ctx "select x from system_range(1, 2);")) 28 | ;; => [{:x 1} {:x 2}] 29 | ``` 30 | 31 | 32 | ## Documentation ## 33 | 34 | http://funcool.github.io/suricatta/latest/ 35 | -------------------------------------------------------------------------------- /deploy.clj: -------------------------------------------------------------------------------- 1 | (require '[clojure.java.shell :as shell] 2 | '[clojure.main]) 3 | (require '[badigeon.jar] 4 | '[badigeon.deploy]) 5 | 6 | (defmulti task first) 7 | 8 | (defmethod task "jar" 9 | [args] 10 | (badigeon.jar/jar 'funcool/suricatta 11 | {:mvn/version "2.0.0-SNAPSHOT"} 12 | {:out-path "target/suricatta.jar" 13 | :mvn/repos '{"clojars" {:url "https://repo.clojars.org/"}} 14 | :allow-all-dependencies? false})) 15 | 16 | (defmethod task "deploy" 17 | [args] 18 | (let [artifacts [{:file-path "target/suricatta.jar" :extension "jar"} 19 | {:file-path "pom.xml" :extension "pom"}]] 20 | (badigeon.deploy/deploy 21 | 'funcool/suricatta "2.0.0-SNAPSHOT" 22 | artifacts 23 | {:id "clojars" :url "https://repo.clojars.org/"} 24 | {:allow-unsigned? true}))) 25 | 26 | 27 | (defmethod task :default 28 | [args] 29 | (task ["jar"]) 30 | (task ["deploy"])) 31 | 32 | ;;; Build script entrypoint. This should be the last expression. 33 | 34 | (task *command-line-args*) 35 | -------------------------------------------------------------------------------- /test/user.clj: -------------------------------------------------------------------------------- 1 | ;; This Source Code Form is subject to the terms of the Mozilla Public 2 | ;; License, v. 2.0. If a copy of the MPL was not distributed with this 3 | ;; file, You can obtain one at http://mozilla.org/MPL/2.0/. 4 | ;; 5 | ;; Copyright (c) 2016-2019 Andrey Antukh 6 | 7 | (ns user 8 | (:require [clojure.tools.namespace.repl :as repl] 9 | [clojure.walk :refer [macroexpand-all]] 10 | [clojure.pprint :refer [pprint]] 11 | [clojure.test :as test])) 12 | 13 | (defn- run-test 14 | ([] (run-test #"^suricatta\..*test.*")) 15 | ([o] 16 | (repl/refresh) 17 | (cond 18 | (instance? java.util.regex.Pattern o) 19 | (test/run-all-tests o) 20 | 21 | (symbol? o) 22 | (if-let [sns (namespace o)] 23 | (do (require (symbol sns)) 24 | (test/test-vars [(resolve o)])) 25 | (test/test-ns o))))) 26 | 27 | (defn -main 28 | [& args] 29 | (require 'suricatta.core-test) 30 | (require 'suricatta.extend-test) 31 | (require 'suricatta.dsl-test) 32 | (let [{:keys [fail]} (run-test)] 33 | (if (pos? fail) 34 | (System/exit fail) 35 | (System/exit 0)))) 36 | 37 | -------------------------------------------------------------------------------- /scripts/bench.clj: -------------------------------------------------------------------------------- 1 | ;; HOW TO RUN: clojure -J-Xmx128m -Adev:bench scripts/bench.clj 2 | 3 | (require '[criterium.core :as b]) 4 | (require '[next.jdbc :as jdbc]) 5 | (require '[next.jdbc.result-set :as jdbc-rs]) 6 | (require '[suricatta.core :as sc]) 7 | 8 | (def uri "jdbc:postgresql://127.0.0.1/test") 9 | 10 | (def conn1 (jdbc/get-connection uri)) 11 | (def conn2 (sc/context uri)) 12 | 13 | (def sql1 "SELECT x FROM generate_series(1, 10000) as x;") 14 | 15 | (defn test-next-jdbc1 16 | [] 17 | (let [result (jdbc/execute! conn1 [sql1] {:builder-fn jdbc-rs/as-unqualified-lower-maps})] 18 | (with-out-str 19 | (prn result)))) 20 | 21 | (defn test-suricatta1 22 | [] 23 | (let [result (sc/fetch conn2 sql1)] 24 | (with-out-str 25 | (prn result)))) 26 | 27 | (println "***** START: next.jdbc (1) *****") 28 | ;; (b/with-progress-reporting (b/quick-bench (test-next-jdbc1) :verbose)) 29 | (b/bench (test-next-jdbc1)) 30 | (println "***** END: next.jdbc (1) *****") 31 | 32 | (println "***** START: suricatta (1) *****") 33 | ;; (b/with-progress-reporting (b/quick-bench (test-suricatta1) :verbose)) 34 | (b/bench (test-suricatta1)) 35 | (println "***** END: suricatta (1) *****") 36 | 37 | 38 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clojure/clojure {:mvn/version "1.10.1"} 2 | org.jooq/jooq {:mvn/version "3.12.1"}} 3 | :paths ["src"] 4 | :aliases 5 | {:dev {:extra-deps {com.bhauman/rebel-readline {:mvn/version "0.1.4"} 6 | org.clojure/tools.namespace {:mvn/version "0.3.1"} 7 | org.postgresql/postgresql {:mvn/version "42.2.6"} 8 | com.h2database/h2 {:mvn/version "1.4.199"} 9 | cheshire/cheshire {:mvn/version "5.9.0"}} 10 | :extra-paths ["test"]} 11 | :bench {:extra-deps {seancorfield/next.jdbc {:mvn/version "1.0.6"} 12 | criterium/criterium {:mvn/version "0.4.5"}}} 13 | 14 | :jar {:extra-deps {seancorfield/depstar {:mvn/version "RELEASE"}} 15 | :main-opts ["-m" "hf.depstar.jar"]} 16 | 17 | :repl {:main-opts ["-m" "rebel-readline.main"]} 18 | :ancient {:main-opts ["-m" "deps-ancient.deps-ancient"] 19 | :extra-deps {deps-ancient {:mvn/version "RELEASE"}}} 20 | :test {:main-opts ["-m" "user"]} 21 | 22 | :deploy {:extra-deps {badigeon/badigeon {:git/url "https://github.com/EwenG/badigeon.git" 23 | :sha "db25a8f7053dec65afeb7fb0d1a5351dcdbe78bd" 24 | :tag "0.0.8"}} 25 | :main-opts ["deploy.clj"]} 26 | }} 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /test/suricatta/dsl_test.clj: -------------------------------------------------------------------------------- 1 | (ns suricatta.dsl-test 2 | (:require [clojure.test :refer :all] 3 | [suricatta.core :as sc] 4 | [suricatta.dsl.alpha :as dsl])) 5 | 6 | (deftest select-statement-1 7 | (let [qq (-> (dsl/select) 8 | (dsl/from "posts" "p") 9 | (dsl/join "authors" "a" "p.author_id = a.id") 10 | (dsl/field "p.*") 11 | (dsl/field "a.slug" "author_slug") 12 | (dsl/limit 10))] 13 | (is (= (dsl/fmt qq) 14 | ["SELECT p.*, a.slug author_slug FROM posts p INNER JOIN authors a ON (p.author_id = a.id) "])))) 15 | 16 | (deftest select-statement-2 17 | (let [qq (-> (dsl/select) 18 | (dsl/from "posts" "p") 19 | (dsl/field "p.id" "post_id") 20 | (dsl/where "p.category = ?" "offtopic"))] 21 | (is (= (dsl/fmt qq) 22 | ["SELECT p.id post_id FROM posts p WHERE (p.category = ?)" "offtopic"])))) 23 | 24 | (deftest update-statement-1 25 | (let [qq (-> (dsl/update "users" "u") 26 | (dsl/set "u.username" "foobar") 27 | (dsl/set "u.email" "foo@bar.com") 28 | (dsl/where "u.id = ? AND u.deleted_at IS null" 555))] 29 | (is (= (dsl/fmt qq) 30 | ["UPDATE users u SET u.username = ?, u.email = ? WHERE (u.id = ? AND u.deleted_at IS null)" "foobar" "foo@bar.com" 555])))) 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014-2015, Andrey Antukh 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /docker/zshrc: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env zsh 2 | 3 | export EDITOR=vim 4 | 5 | bindkey "^[[3~" delete-char 6 | bindkey "^[3;5~" delete-char 7 | bindkey '^R' history-incremental-search-backward 8 | 9 | bindkey -e 10 | 11 | autoload -U promptinit 12 | promptinit 13 | prompt off 14 | 15 | #------------------------------ 16 | ## Comp stuff 17 | ##------------------------------ 18 | zmodload zsh/complist 19 | autoload -Uz compinit 20 | compinit 21 | 22 | #------------------------------ 23 | # Alias stuff 24 | #------------------------------ 25 | alias cp='cp -r' 26 | alias ls='ls -F' 27 | alias l='ls -Flha' 28 | alias rm='rm -r' 29 | alias ls='ls --color -F' 30 | alias lsd='ls -d *(/)' 31 | alias lsf='ls -h *(.)' 32 | 33 | #----------------- 34 | # Options 35 | #----------------- 36 | 37 | setopt AUTO_CD # implicate cd for non-commands 38 | setopt CORRECT_ALL # correct spelling 39 | setopt COMPLETE_IN_WORD # complete commands anywhere in the word 40 | setopt NOTIFY # Notify when jobs finish 41 | setopt BASH_AUTO_LIST # Autolist options on repeition of ambiguous args 42 | setopt AUTO_PUSHD # Push dirs into history 43 | setopt MULTIOS # Allow Multiple pipes 44 | setopt MAGIC_EQUAL_SUBST # Expand inside equals 45 | setopt EXTENDED_GLOB 46 | setopt NOBEEP 47 | setopt INC_APPEND_HISTORY 48 | export HISTSIZE=100000 49 | export SAVEHIST=100000 50 | export HISTFILE=~/.zhistory 51 | setopt hist_ignore_all_dups 52 | setopt hist_ignore_space 53 | 54 | export PATH=$HOME/.local/bin:$PATH 55 | -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4.0.0 4 | funcool 5 | suricatta 6 | jar 7 | 2.0.0-SNAPSHOT 8 | suricatta 9 | High level sql toolkit for clojure (backed by jooq library) 10 | https://github.com/funcool/suricatta 11 | 12 | 13 | BSD (2-Clause) 14 | http://opensource.org/licenses/BSD-2-Clause 15 | 16 | 17 | 18 | scm:git:git://github.com/funcool/suricatta.git 19 | scm:git:ssh://git@github.com/funcool/suricatta.git 20 | 5be805429be9e4226013af63947d19b93ecdd083 21 | 22 | https://github.com/funcool/suricatta 23 | 24 | 25 | src 26 | test 27 | 28 | 29 | resources 30 | 31 | 32 | 33 | 34 | 35 | clojars 36 | https://repo.clojars.org/ 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | org.clojure 45 | clojure 46 | 1.10.1 47 | 48 | 49 | org.jooq 50 | jooq 51 | 3.12.1 52 | 53 | 54 | 55 | -------------------------------------------------------------------------------- /docker/Dockerfile: -------------------------------------------------------------------------------- 1 | # FROM ubuntu:xenial 2 | FROM openjdk:8-jdk 3 | LABEL maintainer="Andrey Antukh " 4 | 5 | ARG EXTERNAL_UID=1000 6 | 7 | ENV CLOJURE_VERSION=1.10.0.442 \ 8 | LANG=en_US.UTF-8 \ 9 | LC_ALL=C.UTF-8 10 | 11 | RUN set -ex; \ 12 | apt-get update && \ 13 | apt-get install -yq \ 14 | locales \ 15 | ca-certificates \ 16 | wget \ 17 | sudo \ 18 | curl \ 19 | bash \ 20 | zsh \ 21 | git \ 22 | rlwrap \ 23 | ; \ 24 | rm -rf /var/lib/apt/lists/*; 25 | 26 | RUN set -ex; \ 27 | echo "deb http://apt.postgresql.org/pub/repos/apt/ stretch-pgdg main" >> /etc/apt/sources.list; \ 28 | wget --quiet -O - https://www.postgresql.org/media/keys/ACCC4CF8.asc | apt-key add -; \ 29 | apt-get update -yq && \ 30 | apt-get install -yq \ 31 | postgresql-9.6 \ 32 | postgresql-contrib-9.6 \ 33 | ;\ 34 | rm -rf /var/lib/apt/lists/*; 35 | 36 | COPY pg_hba.conf /etc/postgresql/9.6/main/pg_hba.conf 37 | 38 | # Copy user config files 39 | COPY bashrc /root/.bashrc 40 | COPY zshrc /root/.zshrc 41 | COPY vimrc /root/.vimrc 42 | COPY entrypoint.sh /entrypoint.sh 43 | COPY tmux.conf /root/.tmux.conf 44 | 45 | RUN set -ex; \ 46 | /etc/init.d/postgresql start \ 47 | && createuser -U postgres -sl devuser \ 48 | && createdb -U devuser test \ 49 | && /etc/init.d/postgresql stop 50 | 51 | RUN set -ex; \ 52 | wget "https://download.clojure.org/install/linux-install-$CLOJURE_VERSION.sh"; \ 53 | chmod +x "linux-install-$CLOJURE_VERSION.sh"; \ 54 | "./linux-install-$CLOJURE_VERSION.sh"; \ 55 | rm -rf "linux-install-$CLOJURE_VERSION.sh" 56 | 57 | RUN set -ex; \ 58 | useradd -m -g users -s /bin/zsh -u $EXTERNAL_UID devuser; \ 59 | passwd devuser -d; \ 60 | echo "devuser ALL=(ALL) NOPASSWD:ALL" >> /etc/sudoers 61 | 62 | USER devuser 63 | WORKDIR /home/devuser 64 | 65 | # Copy user config files 66 | COPY bashrc /home/devuser/.bashrc 67 | COPY zshrc /home/devuser/.zshrc 68 | COPY vimrc /home/devuser/.vimrc 69 | COPY tmux.conf /home/devuser/.tmux.conf 70 | 71 | ENTRYPOINT ["zsh", "/entrypoint.sh"] 72 | -------------------------------------------------------------------------------- /manage.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | set -e 3 | 4 | REV=`git log -n 1 --pretty=format:%h -- docker/` 5 | IMGNAME="suricatta-devenv" 6 | 7 | function kill-container { 8 | echo "Cleaning development container $IMGNAME:$REV..." 9 | if $(docker ps | grep -q $IMGNAME); then 10 | docker ps | grep $IMGNAME | awk '{print $1}' | xargs --no-run-if-empty docker kill 11 | fi 12 | if $(docker ps -a | grep -q $IMGNAME); then 13 | docker ps -a | grep $IMGNAME | awk '{print $1}' | xargs --no-run-if-empty docker rm 14 | fi 15 | } 16 | 17 | function remove-image { 18 | echo "Clean old development image $IMGNAME..." 19 | docker images | grep $IMGNAME | awk '{print $3}' | xargs --no-run-if-empty docker rmi 20 | } 21 | 22 | function build-devenv { 23 | kill-container 24 | echo "Building development image $IMGNAME:$REV..." 25 | docker build --rm=true -t $IMGNAME:$REV -t $IMGNAME:latest --build-arg EXTERNAL_UID=$(id -u) docker/ 26 | } 27 | 28 | function reset { 29 | kill-container 30 | 31 | if ! $(docker images | grep $IMGNAME | grep -q $REV); then 32 | build-devenv 33 | fi 34 | } 35 | 36 | function docker-run { 37 | docker run --rm -ti \ 38 | -v `pwd`:/home/devuser/suricatta \ 39 | -v $HOME/.m2:/home/devuser/.m2 \ 40 | -w /home/devuser/suricatta \ 41 | $IMGNAME:latest $@ 42 | } 43 | 44 | 45 | function run-devenv { 46 | reset || exit -1; 47 | mkdir -p $HOME/.m2 48 | docker-run /bin/zsh 49 | } 50 | 51 | function run-tests { 52 | reset || exit -1; 53 | docker-run clojure -Adev:test 54 | } 55 | 56 | function help { 57 | echo "suricatta devenv manager v$REV" 58 | echo "USAGE: $0 OPTION" 59 | echo "Options:" 60 | echo "- clean Kill container and remove image" 61 | echo "- build-devenv Build docker container for development" 62 | echo "- run-devenv Run (and build if necessary) development container" 63 | echo "- run-tests Execute unit tests for both backend and frontend" 64 | } 65 | 66 | case $1 in 67 | clean) 68 | kill-container 69 | remove-image 70 | ;; 71 | build-devenv) 72 | build-devenv 73 | ;; 74 | run-devenv) 75 | run-devenv 76 | ;; 77 | run-tests) 78 | run-tests 79 | ;; 80 | *) 81 | help 82 | ;; 83 | esac 84 | -------------------------------------------------------------------------------- /src/suricatta/proto.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2014-2015 Andrey Antukh 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 | ;; * Redistributions of source code must retain the above copyright notice, this 8 | ;; list of conditions and the following disclaimer. 9 | ;; 10 | ;; * 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 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 | ;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 | ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | ;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 18 | ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19 | ;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 20 | ;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 22 | ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 23 | ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | 25 | (ns suricatta.proto) 26 | 27 | (defprotocol IContextHolder 28 | (-context [_] "Get jooq context with attached configuration") 29 | (-config [_] "Get attached configuration.")) 30 | 31 | (defprotocol IConnectionFactory 32 | (-connection [_ _] "Create a jdbc connection.")) 33 | 34 | (defprotocol IExecute 35 | (-execute [q ctx] "Execute a query and return a number of rows affected.")) 36 | 37 | (defprotocol IFetch 38 | (-fetch [q ctx opts] "Fetch eagerly results executing query.")) 39 | 40 | (defprotocol IFetchLazy 41 | (-fetch-lazy [q ctx opts] "Fetch lazy results executing query.")) 42 | 43 | (defprotocol IQuery 44 | (-query [_ ctx] "Build a query.")) 45 | 46 | (defprotocol IParam 47 | (-param [_ ctx] "Returns a jOOQ compatible param type.")) 48 | 49 | (defprotocol ISQLType 50 | "An abstraction for handle the backward type 51 | conversion: from SQL->User." 52 | (-convert [_] "Convert sql type to user type.")) 53 | -------------------------------------------------------------------------------- /test/suricatta/extend_test.clj: -------------------------------------------------------------------------------- 1 | (ns suricatta.extend-test 2 | (:require [clojure.test :refer :all] 3 | [suricatta.core :as sc] 4 | [suricatta.impl :as impl] 5 | [suricatta.proto :as proto] 6 | [cheshire.core :as json]) 7 | (:import org.postgresql.util.PGobject)) 8 | 9 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10 | ;; Connection setup 11 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12 | 13 | (def ^:dynamic *ctx*) 14 | 15 | (defn setup-connection-fixture 16 | [end] 17 | (with-open [ctx (sc/context "jdbc:postgresql://127.0.0.1/test")] 18 | (sc/atomic ctx 19 | (binding [*ctx* ctx] 20 | (end) 21 | (sc/set-rollback! ctx))))) 22 | 23 | (use-fixtures :each setup-connection-fixture) 24 | 25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26 | ;; Tests Data 27 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 28 | 29 | (deftype MyJson [data]) 30 | 31 | (defn myjson 32 | [data] 33 | (MyJson. data)) 34 | 35 | (extend-protocol proto/IParam 36 | MyJson 37 | (-param [self ctx] 38 | (let [qp (json/encode (.-data self))] 39 | (impl/sql->param "{0}::jsonb" qp)))) 40 | 41 | (extend-protocol proto/ISQLType 42 | org.jooq.JSONB 43 | (-convert [self] 44 | (json/decode (.toString self) true))) 45 | 46 | (deftype MyArray [data]) 47 | 48 | (defn myintarray 49 | [data] 50 | (MyArray. data)) 51 | 52 | (extend-protocol proto/IParam 53 | MyArray 54 | (-param [self ctx] 55 | (let [items (->> (map str (.-data self)) 56 | (interpose ","))] 57 | (impl/sql->param (str "'{" (apply str items) "}'::bigint[]"))))) 58 | 59 | 60 | (extend-protocol proto/ISQLType 61 | (Class/forName "[Ljava.lang.Long;") 62 | (-convert [self] 63 | (into [] self)) 64 | 65 | java.sql.Array 66 | (-convert [self] 67 | (into [] (.getArray self)))) 68 | 69 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 70 | ;; Tests Code 71 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 72 | 73 | (deftest inserting-json-test 74 | (sc/execute *ctx* "create table t1 (k jsonb)") 75 | (sc/execute *ctx* ["insert into t1 (k) values (?)" (myjson {:foo 1})]) 76 | 77 | (let [result (sc/fetch *ctx* ["select * from t1"]) 78 | result1 (first result)] 79 | (is (= (:k result1) {:foo 1})))) 80 | 81 | (deftest inserting-arrays-test 82 | (sc/execute *ctx* "create table t1 (data bigint[])") 83 | (let [data (myintarray [1 2 3])] 84 | (sc/execute *ctx* ["insert into t1 (data) values (?)" data])) 85 | (let [result (sc/fetch *ctx* "select * from t1")] 86 | (is (= result [{:data [1 2 3]}])))) 87 | -------------------------------------------------------------------------------- /src/suricatta/core.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2014-2016 Andrey Antukh 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 | ;; * Redistributions of source code must retain the above copyright notice, this 8 | ;; list of conditions and the following disclaimer. 9 | ;; 10 | ;; * 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 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 | ;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 | ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | ;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 18 | ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19 | ;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 20 | ;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 22 | ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 23 | ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | 25 | (ns suricatta.core 26 | "High level sql toolkit for Clojure" 27 | (:require [suricatta.proto :as proto] 28 | [suricatta.impl :as impl]) 29 | (:import org.jooq.SQLDialect 30 | org.jooq.Configuration 31 | org.jooq.impl.DefaultConfiguration 32 | org.jooq.tools.jdbc.JDBCUtils 33 | java.sql.Connection)) 34 | 35 | (defn context 36 | "Context constructor." 37 | ([uri] (context uri {})) 38 | ([uri opts] (impl/context uri opts))) 39 | 40 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 41 | ;; SQL Executor 42 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43 | 44 | (defn execute 45 | "Execute a query and return a number of rows affected." 46 | ([q] (proto/-execute q nil)) 47 | ([ctx q] (proto/-execute q ctx))) 48 | 49 | (defn fetch 50 | "Fetch eagerly results executing a query. 51 | 52 | This function returns a vector of records (default) or 53 | rows (depending on specified opts). Resources are relased 54 | inmediatelly without specific explicit action for it." 55 | ([q] (proto/-fetch q nil {})) 56 | ([ctx q] (proto/-fetch q ctx {})) 57 | ([ctx q opts] (proto/-fetch q ctx opts))) 58 | 59 | (def fetch-one (comp first fetch)) 60 | 61 | (defn query 62 | "Mark a query for reuse the prepared statement. 63 | 64 | This function should be used with precaution and 65 | close method should be called when query is not 66 | longer needed. In almost all cases you should not 67 | need use this function." 68 | [ctx querylike] 69 | (proto/-query querylike ctx)) 70 | 71 | (defn fetch-lazy 72 | "Fetch lazily results executing a query. 73 | 74 | This function returns a cursor instead of result. 75 | You should explicitly close the cursor at the end of 76 | iteration for release resources." 77 | ([ctx q] (proto/-fetch-lazy q ctx {})) 78 | ([ctx q opts] (proto/-fetch-lazy q ctx opts))) 79 | 80 | (defn cursor->seq 81 | "Transform a cursor in a lazyseq. 82 | 83 | The returned lazyseq will return values until a cursor 84 | is closed or all values are fetched." 85 | ([cursor] (impl/cursor->seq cursor {})) 86 | ([cursor opts] (impl/cursor->seq cursor opts))) 87 | 88 | (defn typed-field 89 | "Get a instance of Field definitio." 90 | [data type] 91 | (impl/typed-field data type)) 92 | 93 | (defn load-into 94 | "Load data into a table. Supports csv and json formats." 95 | ([ctx tablename data] (load-into ctx tablename data {})) 96 | ([ctx tablename data opts] 97 | (impl/load-into ctx tablename data opts))) 98 | 99 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 100 | ;; Transactions 101 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 102 | 103 | (defn apply-atomic 104 | "Apply a function in a transaction." 105 | [& args] 106 | (apply impl/apply-atomic args)) 107 | 108 | (defmacro atomic 109 | "Convenience macro for execute a computation 110 | in a transaction or subtransaction." 111 | [ctx & body] 112 | `(impl/apply-atomic ~ctx (fn [~ctx] ~@body))) 113 | 114 | (defn set-rollback! 115 | "Mark current transaction for rollback. 116 | 117 | This function is not safe and it not aborts 118 | the execution of current function, it only 119 | marks the current transaction for rollback." 120 | [ctx] 121 | (impl/set-rollback! ctx)) 122 | -------------------------------------------------------------------------------- /test/suricatta/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns suricatta.core-test 2 | (:require [clojure.test :refer :all] 3 | [suricatta.core :as sc])) 4 | 5 | (def ^:dynamic *ctx*) 6 | 7 | (defn database-fixture 8 | [end] 9 | (with-open [ctx (sc/context "jdbc:postgresql://127.0.0.1/test")] 10 | (sc/atomic ctx 11 | (binding [*ctx* ctx] 12 | (end) 13 | (sc/set-rollback! ctx))))) 14 | 15 | (use-fixtures :each database-fixture) 16 | 17 | (deftest query-execute 18 | (sc/execute *ctx* "create temporary table foo (n int) on commit drop") 19 | 20 | (testing "Execute string directly" 21 | (let [r (sc/execute *ctx* "insert into foo (n) values (1), (2)")] 22 | (is (= r 2)))) 23 | 24 | (testing "Execute sqlvec directly" 25 | (let [r (sc/execute *ctx* ["insert into foo (n) values (?), (?)" 1 2])] 26 | (is (= r 2))))) 27 | 28 | (deftest query-fetch 29 | (testing "Fetch by default vector of records." 30 | (let [sql "select x from generate_series(1, 3) as x" 31 | r (sc/fetch *ctx* sql)] 32 | (is (= r [{:x 1} {:x 2} {:x 3}])))) 33 | 34 | (testing "Fetch vector of rows" 35 | (let [sql "select x, x+1 as i from generate_series(1, 3) as x" 36 | result (sc/fetch *ctx* sql {:format :row})] 37 | (is (= result [[1 2] [2 3] [3 4]])))) 38 | 39 | (testing "Reuse the statement" 40 | (with-open [q (sc/query *ctx* ["select ? \"x\"" 1])] 41 | (is (= (sc/fetch *ctx* q) [{:x 1}])) 42 | (is (= (sc/fetch *ctx* q) [{:x 1}])) 43 | (is (= (sc/execute *ctx* q) 1)) 44 | (is (= (sc/execute *ctx* q) 1)))) 45 | ) 46 | 47 | (deftest lazy-fetch 48 | (testing "Fetch by default vector of rows." 49 | (sc/atomic *ctx* 50 | (with-open [cursor (sc/fetch-lazy *ctx* "select x from generate_series(1, 300) as x")] 51 | (let [res (take 3 (sc/cursor->seq cursor {:format :row}))] 52 | (is (= (mapcat identity (vec res)) [1 2 3])))))) 53 | 54 | (testing "Fetch by default vector of records." 55 | (sc/atomic *ctx* 56 | (with-open [cursor (sc/fetch-lazy *ctx* "select x from generate_series(1, 300) as x;")] 57 | (let [res (take 3 (sc/cursor->seq cursor))] 58 | (is (= (vec res) [{:x 1} {:x 2} {:x 3}])))))) 59 | ) 60 | 61 | #_(deftest fetch-format 62 | (testing "Fetch in csv format" 63 | (let [sql "select x, x+1 as i, 'a,b' as k from generate_series(1, 1) as x" 64 | result (sc/fetch *ctx* sql {:format :csv})] 65 | (is (= (str "x,i,k\n1,2,\"a,b\"\n") result)))) 66 | 67 | (testing "Fetch in json format" 68 | (let [sql "select x, x+1 as i, 'a,b' as k from generate_series(1, 1) as x" 69 | result (sc/fetch *ctx* sql {:format :json})] 70 | (is (= (str "{\"fields\":[" 71 | "{\"name\":\"x\",\"type\":\"INT4\"}," 72 | "{\"name\":\"i\",\"type\":\"INT4\"}," 73 | "{\"name\":\"k\",\"type\":\"OTHER\"}]," 74 | "\"records\":[[1,2,\"a,b\"]]}") 75 | result)))) 76 | ) 77 | 78 | (deftest data-loading 79 | (testing "load csv" 80 | (sc/execute *ctx* "create table foo1 (a int, b int)") 81 | (let [data (str "1,2\n3,4\n")] 82 | (sc/load-into *ctx* :foo1 data {:fields [(sc/typed-field "a" :pg/int4) 83 | (sc/typed-field "b" :pg/int4)] 84 | :format :csv})) 85 | (let [result (sc/fetch *ctx* "select * from foo1")] 86 | (is (= [{:a 1, :b 2} {:a 3, :b 4}] result))))) 87 | 88 | (deftest transactions 89 | (testing "Execute in a transaction" 90 | (with-open [ctx (sc/context "jdbc:h2:mem:")] 91 | (sc/execute ctx "create table foo (id int)") 92 | (sc/atomic ctx 93 | (sc/execute ctx ["insert into foo (id) values (?), (?)" 1 2]) 94 | (try 95 | (sc/atomic ctx 96 | (sc/execute ctx ["insert into foo (id) values (?), (?)" 3 4]) 97 | (let [result (sc/fetch ctx "select * from foo")] 98 | (is (= 4 (count result)))) 99 | (throw (RuntimeException. "test"))) 100 | (catch RuntimeException e 101 | (let [result (sc/fetch ctx "select * from foo")] 102 | (is (= 2 (count result))))))))) 103 | 104 | (testing "Execute in a transaction with explicit rollback" 105 | (with-open [ctx (sc/context "jdbc:h2:mem:")] 106 | (sc/execute ctx "create table foo (id int)") 107 | (sc/atomic ctx 108 | (sc/execute ctx ["insert into foo (id) values (?), (?)" 1 2]) 109 | (sc/atomic ctx 110 | (sc/execute ctx ["insert into foo (id) values (?), (?)" 3 4]) 111 | (let [result (sc/fetch ctx "select * from foo")] 112 | (is (= 4 (count result)))) 113 | (sc/set-rollback! ctx)) 114 | (let [result (sc/fetch ctx "select * from foo")] 115 | (is (= 2 (count result))))))) 116 | 117 | (testing "Execute in a transaction with explicit rollback" 118 | (with-open [ctx (sc/context "jdbc:h2:mem:")] 119 | (sc/execute ctx "create table foo (id int)") 120 | (sc/atomic ctx 121 | (sc/execute ctx ["insert into foo (id) values (?), (?)" 1 2]) 122 | (sc/atomic ctx 123 | (sc/execute ctx ["insert into foo (id) values (?), (?)" 3 4]) 124 | (let [result (sc/fetch ctx "select * from foo")] 125 | (is (= 4 (count result))))) 126 | (sc/set-rollback! ctx)) 127 | (let [result (sc/fetch ctx "select * from foo")] 128 | (is (= 0 (count result)))))) 129 | ) 130 | -------------------------------------------------------------------------------- /CHANGES.adoc: -------------------------------------------------------------------------------- 1 | = Changelog 2 | 3 | == 2.0.0-SNAPSHOT 4 | 5 | Date: unreleased 6 | 7 | BREAKING CHANGES: 8 | - `suricatta.format` namespace is removed 9 | - `suricatta.dsl` namespace is removed 10 | - dbspec connection format is removed (now only the simplest methods 11 | are supported: `DataSource` instance and URL. 12 | - `cursor->lazyseq` is renamed to `cursor->seq` 13 | - New and simplfied method for add type extensions (see docs). 14 | - Improved json and jsonb support thanks to JOOQ 3.12.1 15 | 16 | Other changes: 17 | - Many performance improvements on standart queries. 18 | - Many performance improvements on lazy fetching. 19 | - Update JOOQ to 3.12.1 20 | 21 | 22 | == 1.3.1 23 | 24 | Date: 2016-12-25 25 | 26 | - Fix compatibility issues with jOOQ 3.9.0 27 | 28 | 29 | == 1.3.0 30 | 31 | Date: 2016-12-25 32 | 33 | - Update to jOOQ 3.8.6. 34 | - Fix unexpected exception when core and dsl is imported without importing format. 35 | 36 | 37 | == 1.2.0 38 | 39 | Date: 2016-11-15 40 | 41 | - Add `dsl/exists` and `dsl/not-exists` subquery clauses. 42 | - Add `suricatta.dsl.pgsql` namespace for PostgreSQL specific dsl extensions. 43 | - Update to jOOQ 3.8.6. 44 | 45 | 46 | == 1.1.0 47 | 48 | Date: 2016-05-28 49 | 50 | - Rename `atomic-apply` to `apply-atomic`. 51 | - Keep backward compatible alias for previous change. 52 | - Update to jOOQ 3.8.2 53 | 54 | 55 | == 1.0.0 56 | 57 | Date: 2016-05-26 58 | 59 | - Update jOOQ to 3.8.1 60 | - BREAKING CHANGE: change internal protocol function names. This change will 61 | affect only who use them for exented suricatta behavior. 62 | - Format functions renamed to more simpler names (backward compatible aliases 63 | are maintained). 64 | - Remove internal (not documented) agent from context instances. 65 | 66 | 67 | == 0.9.0 68 | 69 | Date: 2016-03-20 70 | 71 | - Update clojure to 1.8.0 72 | - Update jOOQ to 3.7.3 73 | 74 | 75 | == 0.8.1 76 | 77 | Date: 2016-02-08 78 | 79 | - Add additional parameters to sqlvec enablig the option to specify the dialect. 80 | - Add the ability to use insert statements in fetch operations. 81 | 82 | 83 | == 0.8.0 84 | 85 | Date: 2016-01-16 86 | 87 | Breaking changes: 88 | 89 | - The approach introduced in previous version for create 90 | aliases is a little bit changed. Now uses lists instead vector for avoid 91 | confusion with the widelly used vector for pass params. 92 | - Removed `as-table` function (replaced with `to-table` with specific 93 | implementation for common table expresions). 94 | - The functions `field` and `table` now receives alias as optional argument 95 | instead of map of options. 96 | 97 | 98 | Other changes: 99 | 100 | - Add `f` function as shortcut for declare functions. Previously `field` is used 101 | (and can continue to be used). Is just a shortcut. 102 | - Set function improved. 103 | 104 | 105 | == 0.7.0 106 | 107 | Date: 2016-01-15 108 | 109 | - Fix unexpected behavior of join dsl method. 110 | - Improved way to set aliases to fields and tables. 111 | - Minor internal improvements related to dsl internals. 112 | 113 | 114 | == 0.6.2 115 | 116 | Date: 2016-01-06 117 | 118 | - Update jOOQ to 3.7.2 119 | 120 | 121 | == 0.6.1 122 | 123 | Date: 2015-11-16 124 | 125 | - Update jOOQ to 3.7.1 126 | 127 | 128 | == 0.6.0 129 | 130 | Date: 2015-10-26 131 | 132 | - Add support for the missing :pg/json type. 133 | - Add the ability to use types defined by arbitrary string. 134 | - BREAKING CHANGE: The extension mechanism for third party types 135 | has ben rewritten. 136 | 137 | 138 | == 0.5.0 139 | 140 | Date: 2015-10-17 141 | 142 | - Remove cats dependency. 143 | - Remove clojure.jdbc dependency. 144 | 145 | 146 | == 0.4.0 147 | 148 | Date: 2015-10-12 149 | 150 | - Update cats dependency to the last version (1.0.0) 151 | - Update clojure default version to 1.7.0 152 | - Update clojure.jdbc version to the last version (0.6.1) 153 | - BREAKING CHANGE: Update jOOQ version to 3.7.0 that 154 | now requires jdk8. 155 | - BREAKING CHANGE: all protocols functions are renamed to 156 | the `-functionname` naming style. 157 | - BREAKING CHANGE: async interface is removed. 158 | More detailed explication is found on faq section of 159 | the documentation. 160 | 161 | 162 | == 0.3.0 163 | 164 | Date: 2015-04-28 165 | 166 | - Update to the next major release of cats that simplifies usage of return values 167 | of async api. 168 | - Update to the next major release of clojure.jdbc that introduces some improvements 169 | and bugfixes on connection management. 170 | - Update to the next major release of jooq, that also introduces improvements an a 171 | lot of bug fixes. 172 | 173 | 174 | == 0.2.2 175 | 176 | Date: 2015-03-02 177 | 178 | - Update jooq to 3.5.3 179 | - Add fetch-one function (thanks to @jespino) 180 | 181 | 182 | == 0.2.1 183 | 184 | Date: 2015-02-22 185 | 186 | - Update JOOQ to 3.5.2 187 | - Update clojure.jdbc to 0.4.0 188 | - Update cats to 0.3.2 189 | 190 | 191 | == 0.2.0 192 | 193 | Date: 2015-01-17 194 | 195 | - Add support for CREATE/ALTER/DROP INDEX on dsl. 196 | - Add support for CREATE/ALTER/DROP SEQUENCE on dsl. 197 | - Add support for FULL/LEFT/RIGHT OUTER JOIN on dsl. 198 | - Add support for CREATE TABLE on dsl. 199 | - Fix inconsistencies when connection is created from datasource. 200 | - Add suport for csv and json as export format. 201 | - Delegate connection creation to clojure.jdbc. 202 | - Add support for extending self with custom types. 203 | 204 | Backward incompatible changes: 205 | 206 | - Fetch options are changed. It is mainly affects if you are using the rows parameter. 207 | In that case change `{:rows true}` with `{:format :row}` 208 | - Change dsl/table and dsl/field api: remove named parameters in favor to options map. 209 | - suricatta.async/fetch changed returned value. 210 | - suricatta.core/cursor->lazyseq opts are changed. See the first point. 211 | 212 | 213 | == 0.1.0-alpha 214 | 215 | Date: 2014-11-06 216 | 217 | - Initial version. 218 | -------------------------------------------------------------------------------- /src/suricatta/dsl/alpha.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2019 Andrey Antukh 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 | ;; * Redistributions of source code must retain the above copyright notice, this 8 | ;; list of conditions and the following disclaimer. 9 | ;; 10 | ;; * 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 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 | ;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 | ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | ;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 18 | ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19 | ;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 20 | ;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 22 | ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 23 | ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | 25 | (ns suricatta.dsl.alpha 26 | "A SQL build helpers." 27 | (:refer-clojure :exclude [test update set format])) 28 | 29 | (alias 'core 'clojure.core) 30 | 31 | (defn- query? 32 | [m] 33 | (::query m)) 34 | 35 | (defn select 36 | [] 37 | {::query true 38 | ::type ::select}) 39 | 40 | (defn update 41 | ([table] 42 | (update table nil)) 43 | ([table alias] 44 | {::query true 45 | ::type ::update 46 | ::table [table alias]})) 47 | 48 | (defn delete 49 | [] 50 | {::query true 51 | ::type ::delete}) 52 | 53 | (defn insert 54 | [table fields] 55 | {::query true 56 | ::table table 57 | ::fields fields 58 | ::type ::insert}) 59 | 60 | (defn from 61 | ([m name] 62 | (from m name nil)) 63 | ([m name alias] 64 | {:pre [(query? m)]} 65 | (core/update m ::from (fnil conj []) [name alias]))) 66 | 67 | (defn field 68 | ([m name] 69 | (field m name nil)) 70 | ([m name alias] 71 | {:pre [(query? m)]} 72 | (core/update m ::fields (fnil conj []) [name alias]))) 73 | 74 | (defn fields 75 | [m & fields] 76 | {:pre [(query? m)]} 77 | (reduce (fn [acc item] 78 | (if (vector? item) 79 | (apply field acc item) 80 | (field acc item))) 81 | m 82 | fields)) 83 | 84 | (defn limit 85 | [m n] 86 | {:pre [(= (::type m) ::select) 87 | (query? m)]} 88 | (assoc m ::limit n)) 89 | 90 | (defn offset 91 | [m n] 92 | {:pre [(= (::type m) ::select) 93 | (query? m)]} 94 | (assoc m ::offset n)) 95 | 96 | (defn- join* 97 | [m type table alias condition] 98 | {:pre [(= (::type m) ::select) 99 | (query? m)]} 100 | (core/update m ::joins (fnil conj []) 101 | {:type type 102 | :name table 103 | :alias alias 104 | :condition condition})) 105 | 106 | (defn join 107 | ([m table condition] 108 | (join m table nil condition)) 109 | ([m table alias condition] 110 | {:pre [(= (::type m) ::select) 111 | (query? m)]} 112 | (join* m :inner table alias condition))) 113 | 114 | (defn left-join 115 | ([m table condition] 116 | (left-join m table nil condition)) 117 | ([m table alias condition] 118 | {:pre [(= (::type m) ::select) 119 | (query? m)]} 120 | (join* m :left table alias condition))) 121 | 122 | (defn where 123 | [m condition & params] 124 | {:pre [(query? m)]} 125 | (-> m 126 | (core/update ::where (fnil conj []) condition) 127 | (cond-> (seq params) 128 | (core/update ::params (fnil into []) params)))) 129 | 130 | (defn set 131 | [m field value] 132 | {:pre [(query? m)]} 133 | (-> m 134 | (core/update ::assignations (fnil conj []) field) 135 | (core/update ::params (fnil conj []) value))) 136 | 137 | (defn values 138 | [m values] 139 | {:pre [(query? m)]} 140 | (-> m 141 | (assoc ::values values) 142 | (core/update ::params (fnil into []) (mapcat identity values)))) 143 | 144 | (defn raw 145 | [m sql & params] 146 | (-> m 147 | (core/update ::raw (fnil conj []) sql) 148 | (core/update ::params (fnil into []) params))) 149 | 150 | (defmulti format ::type) 151 | 152 | (defn fmt 153 | [m] 154 | (into [(format m)] (::params m))) 155 | 156 | ;; --- Formating 157 | 158 | (defn- format-fields 159 | [fields] 160 | (letfn [(transform [[name alias]] 161 | (if (string? alias) 162 | (str name " " alias) 163 | name))] 164 | (apply str (->> (map transform fields) 165 | (interpose ", "))))) 166 | 167 | (defn- format-join 168 | [{:keys [type name alias condition]}] 169 | (str (case type 170 | :inner "INNER JOIN " 171 | :left "LEFT JOIN ") 172 | (if alias 173 | (str name " " alias) 174 | name) 175 | " ON (" condition ")")) 176 | 177 | (defn- format-joins 178 | [clauses] 179 | (apply str (->> (map format-join clauses) 180 | (interpose " ")))) 181 | 182 | (defn- format-where 183 | [conditions] 184 | (when (seq conditions) 185 | (str "WHERE (" (apply str (interpose ") AND (" conditions)) ")"))) 186 | 187 | 188 | 189 | (defn- format-assignations 190 | [assignations] 191 | (apply str (->> (map #(str % " = ?") assignations) 192 | (interpose ", ")))) 193 | 194 | (defn- format-raw 195 | [items] 196 | (when (seq items) 197 | (apply str (interpose " " items)))) 198 | 199 | (defmethod format ::select 200 | [{:keys [::fields ::from ::joins ::where]}] 201 | (str "SELECT " 202 | (format-fields fields) 203 | " FROM " 204 | (format-fields from) 205 | " " 206 | (format-joins joins) 207 | " " 208 | (format-where where))) 209 | 210 | (defmethod format ::update 211 | [{:keys [::table ::assignations ::where]}] 212 | (str "UPDATE " 213 | (format-fields [table]) 214 | " SET " 215 | (format-assignations assignations) 216 | " " 217 | (format-where where))) 218 | 219 | (defmethod format ::delete 220 | [{:keys [::from ::where]}] 221 | (str "DELETE FROM " 222 | (format-fields from) 223 | " " 224 | (format-where where))) 225 | 226 | (defmethod format ::insert 227 | [{:keys [::table ::fields ::values ::raw]}] 228 | (let [fsize (count fields) 229 | pholder (str "(" (apply str (->> (map (constantly "?") fields) 230 | (interpose ", "))) ")")] 231 | 232 | (str "INSERT INTO " table "(" (apply str (interpose ", " fields)) ")" 233 | " VALUES " (apply str (->> (map (constantly pholder) values) 234 | (interpose ", "))) 235 | " " 236 | (format-raw raw)))) 237 | 238 | ;; (defn test-update 239 | ;; [] 240 | ;; (-> (update "users" "u") 241 | ;; (set "u.username" "foobar") 242 | ;; (set "u.email" "niwi@niwi.nz") 243 | ;; (where "u.id = ? AND u.deleted_at IS null" 555))) 244 | 245 | ;; (defn test-delete 246 | ;; [] 247 | ;; (-> (delete) 248 | ;; (from "users" "u") 249 | ;; (where "u.id = ? AND u.deleted_at IS null" 555))) 250 | 251 | ;; (defn test-insert 252 | ;; [] 253 | ;; (-> (insert "users" ["id", "username"]) 254 | ;; (values [[1 "niwinz"] [2 "niwibe"]]) 255 | ;; (raw "RETURNING *"))) 256 | 257 | -------------------------------------------------------------------------------- /doc/content.adoc: -------------------------------------------------------------------------------- 1 | = suricatta documentation 2 | Andrey Antukh, 3 | 2.0.0 4 | :toc: left 5 | :!numbered: 6 | :source-highlighter: pygments 7 | :pygments-style: friendly 8 | :sectlinks: 9 | 10 | 11 | == Introduction 12 | 13 | _suricatta_ is a high level sql toolkit for clojure (backed by fantastic 14 | link:http://www.jooq.org/[jooq library]) 15 | 16 | It consists in four modules: 17 | 18 | - *suricatta.core*: api for executing queries. 19 | - *suricatta.dsl.alpha*: lightweight dsl for idiomatic and composable sql building. 20 | 21 | 22 | === Project Maturity 23 | 24 | Since _suricatta_ is a young project there may be some API breakage. 25 | 26 | 27 | === Install 28 | 29 | The simplest way to use _suricatta_ in a clojure project, is by 30 | including it in the dependency vector on your *_project.clj_* file: 31 | 32 | [source,clojure] 33 | ---- 34 | [funcool/suricatta "2.0.0"] 35 | ---- 36 | 37 | _Suricatta_ is only runs with *JDK >= 8* and *Clojure >= 1.5* 38 | 39 | 40 | == SQL Execution 41 | 42 | This section explains the usage of the sql execution part of the 43 | library. 44 | 45 | 46 | === Connecting to database 47 | 48 | _suricatta_, unlike other database libraries, uses a concept of *context* instead 49 | of *connection*. A **context** has the resposibility of jdbc connection resource 50 | management, transaction isolation flags and sql rendering dialect. 51 | 52 | You can create a **context** from: 53 | 54 | - a datasource instance (connection pool). 55 | - a valid jdbc url 56 | 57 | 58 | ==== Create Context from jdbc url 59 | 60 | .Example creating context from dbspec. 61 | [source, clojure] 62 | ---- 63 | (require '[suricatta.core :as sc]) 64 | 65 | (with-open [ctx (sc/context "h2:mem:")] 66 | (do-something-with ctx)) 67 | ---- 68 | 69 | 70 | ==== Create Context from DataSource. 71 | 72 | DataSource is the preferd way to connect to the database in production enviroments 73 | and is usually used to implement connection pools. 74 | 75 | In our case we will use *hikaricp* as a datasource with a connection pool. Lets 76 | start by adding hikari's dependency entry to your _deps.edn_: 77 | 78 | [source, clojure] 79 | ---- 80 | hikari-cp/hikari-cp {:mvn/version "2.7.1"} 81 | ---- 82 | 83 | Now create the datasource instance: 84 | 85 | [source, clojure] 86 | ---- 87 | (require '[hikari-cp.core :as hikari]) 88 | 89 | (def ^javax.sql.Datasource datasource 90 | (hikari/make-datasource 91 | {:connection-timeout 30000 92 | :idle-timeout 600000 93 | :max-lifetime 1800000 94 | :minimum-idle 10 95 | :maximum-pool-size 10 96 | :adapter "postgresql" 97 | :username "username" 98 | :password "password" 99 | :database-name "database" 100 | :server-name "localhost" 101 | :port-number 5432})) 102 | ---- 103 | 104 | Now, having a datasource instace, you can use it like plain dbspec for creating 105 | a context instance: 106 | 107 | [source, clojure] 108 | ---- 109 | (with-open [ctx (sc/context datasource)] 110 | (do-something-with ctx)) 111 | ---- 112 | 113 | You can found more information and documentation about hikari-cp 114 | here: https://github.com/tomekw/hikari-cp 115 | 116 | 117 | === Executing queries 118 | 119 | _suricatta_ has a clear separation between queries that can return a result, and 120 | queries that can't. 121 | 122 | .Example using `suricatta.core/execute` function. 123 | [source, clojure] 124 | ---- 125 | (require '[suricatta.core :as sc]) 126 | (sc/execute ctx "CREATE TABLE foo") 127 | ---- 128 | 129 | The return value of `suricatta.core/execute` function depends on the query, but 130 | in almost all cases it returns a number of affected rows. 131 | 132 | 133 | === Fetching results 134 | 135 | Let see an example of how to execute a query and fetch results: 136 | 137 | [source, clojure] 138 | ---- 139 | (require '[suricatta.core :as sc]) 140 | (sc/fetch ctx "select x from generate_series(1,3) as x") 141 | ;; => [{:x 1} {:x 2} {:x 3}] 142 | 143 | (sc/fetch-one ctx "select x from generate_series(1,1) as x") 144 | ;; => {:x 1} 145 | ---- 146 | 147 | [NOTE] 148 | ==== 149 | _suricatta_ gives you the power of raw sql queries without 150 | any restrictions (unlike jdbc). As a great example, _suricatta_ does 151 | not have special syntax for queries with `RETURNING` clause: 152 | 153 | [source, clojure] 154 | ---- 155 | (sc/fetch ctx "INSERT INTO foo (name) values ('bar') returning id") 156 | ;; => [{:id 27}] 157 | ---- 158 | ==== 159 | 160 | 161 | === Parametrized queries 162 | 163 | Like _clojure.jdbc_ and _clojure.java.jdbc_, _suricatta_ has support for 164 | parametrized queries in *sqlvec* format. 165 | 166 | [source, clojure] 167 | ---- 168 | (sc/fetch ctx ["select id from books where age > ? limit 1" 100]) 169 | ;; => [{:id 4232}] 170 | ---- 171 | 172 | 173 | === Reusing query statement 174 | 175 | The above technique can be quite useful when you want to reuse expensive database 176 | resources. 177 | 178 | [source, clojure] 179 | ---- 180 | (with-open [q (sc/query ctx ["select ?" 1])] 181 | (sc/fetch ctx q) ;; Creates a statement 182 | (sc/fetch ctx q)) ;; Reuses the previous created statement 183 | ---- 184 | 185 | 186 | === Transactions 187 | 188 | The _suricatta_ library does not have support for low level transactions api, 189 | instead of it, offers a lightweight abstraction over complex transaction api. 190 | 191 | .Execute a query in a transaction block. 192 | [source, clojure] 193 | ---- 194 | (sc/atomic-apply ctx (fn [ctx] 195 | (sc/fetch ctx "select id, name from book for update"))) 196 | ---- 197 | 198 | Additionally to `atomic-apply` high order functiom, _suricatta_ has a convenient 199 | macro offering lightweight sugar sytax for atomic blocks: 200 | 201 | .Execute a query in a transaction block using sugar syntax macro. 202 | [source, clojure] 203 | ---- 204 | (sc/atomic ctx 205 | (sc/fetch ctx "select id, name from book for update")) 206 | ---- 207 | 208 | You can nest atomic usage as deep as you want, subtransactions are fully supported. 209 | 210 | If an exception is raised inside atomic context the transaction will be aborted. 211 | Also, in some circumstances, you probably want an explicit rollback, for which 212 | the _suricatta_ library exposes a `suricatta.core/set-rollback!` function. 213 | 214 | .Explicit rollback example 215 | [source, clojure] 216 | ---- 217 | (sc/atomic ctx 218 | (sc/execute ctx "update table1 set f1 = 1") 219 | (sc/set-rollback! ctx)) 220 | ---- 221 | 222 | The `set-rollback!` function only marks the current transaction for rollback. It 223 | does not abort the execution, and it is aware of subtransactions. If it is used 224 | in a subtransaction, only the subtransaction will be marked for rollback, not 225 | the entire transaction. 226 | 227 | 228 | === Lazy result fetching 229 | 230 | The _suricatta_ library also comes with lazy fetching support. When lazy fetching 231 | support is enabled, instead of fetching all results in memory, suricatta will 232 | fetch results in small groups, allowing lower memory usage. 233 | 234 | Lazy fetching has a few quirks: 235 | 236 | - In some databases, like _PostgreSQL_, it requires the entire fetch to occur in 237 | one transaction because it uses server side cursors. 238 | - Lazy fetching requires explicit resource management, because a connection and 239 | an internal resultset must be mantained open until fetching is finished. 240 | 241 | Using lazy fetch is realy easy, because suricatta exposes it as a simple lazy 242 | sequence. Let's see one example: 243 | 244 | .Example executing large query and fetching elemens in groups of 10. 245 | [source, clojure] 246 | ---- 247 | (def sql "SELECT x FROM generate_series(1, 10000)") 248 | 249 | (sc/atomic ctx 250 | (with-open [cursor (sc/fetch-lazy ctx sql {:fetch-size 10})] 251 | (doseq [item (sc/cursor->seq cursor)] 252 | (println item)))) 253 | 254 | ;; This should print something similar to: 255 | ;; {:x 1} 256 | ;; {:x 2} 257 | ;; ... 258 | ---- 259 | 260 | The third parameter of `sc/fetch-lazy` function is the optional. The 261 | default fetch size is `128`. 262 | 263 | 264 | === Custom types 265 | 266 | If you want to use suricatta with a database that exposes 267 | non-standard/complex types, suricatta provides an easy path for 268 | extending it. That consists in two protocols, one for converting user 269 | defined types to jooq/jdbc compatible types, and other for backwards 270 | conversion. 271 | 272 | .Example adapting clojure persistent map interface to postgresql json file. 273 | [source, clojure] 274 | ---- 275 | (require '[suricatta.proto :as proto] 276 | '[suricatta.impl :as impl] 277 | '[cheshire.core :as json]) 278 | 279 | (extend-protocol proto/IParam 280 | clojure.lang.IPersistentMap 281 | (-param [self ctx] 282 | (let [qp (json/encode (.-data self))] 283 | (impl/sql->param "{0}::json" qp)))) 284 | ---- 285 | 286 | The `-param` function is responsible of generate the appropiate sql 287 | part for this field. 288 | 289 | Now let see the backward conversion example: 290 | 291 | [source, clojure] 292 | ---- 293 | (extend-protocol proto/ISQLType 294 | org.jooq.JSON 295 | (-convert [self] 296 | (json/decode (.toString self) true))) 297 | ---- 298 | 299 | Having defined the two way conversions, you can pass the clojure 300 | hash-map as a value to the query and it is automatically converted. 301 | 302 | .Insert and query example using postgresql json fields. 303 | [source, clojure] 304 | ---- 305 | ;; Create table 306 | (sc/execute ctx "create table t1 (k json)") 307 | 308 | ;; Insert a json value 309 | (sc/execute ctx ["insert into t1 (k) values (?)" {:foo 1}]) 310 | 311 | ;; Query a table with json value 312 | (sc/fetch ctx ["select * from t1"]) 313 | ;; => [{:k {:foo 1}}] 314 | ---- 315 | 316 | 317 | == SQL Building and Formatting 318 | 319 | TBD 320 | 321 | Since version 2.0.0, the complex sql composition functions based on 322 | jooq are eliminated (buggy and complex code that uses api mostly 323 | defined for java). There are `suricatta.dsl.alpha` namespace that 324 | contains a work in progress of the new approach. 325 | 326 | If you want play with that look tests code to see how it works. 327 | 328 | 329 | == FAQ 330 | 331 | === Why I should use suricatta instead of next.jdbc or java.jdbc? 332 | 333 | Unlike any jdbc library, _suricatta_ works at a slightly higher level. It hides a 334 | lot of idiosyncrasies of jdbc under a much *simpler, cleaner and less error prone 335 | api*, with better resource management. 336 | 337 | 338 | === Why another dsl? Is it just yet another dsl? 339 | 340 | First _suricatta_ is not a dsl library, it's a sql toolkit, and one part of the 341 | toolkit is a dsl. 342 | 343 | Secondly, _suricatta_'s dsl's don't intends to be a sql abstraction. The real 344 | purpose of _suricatta_'s dsl is make SQL composable while still allowing use all or 345 | almost all vendor specific sql constructions. 346 | 347 | 348 | === What are some suricatta use cases? 349 | 350 | The _suricatta_ library is very flexible and it can be used in very different ways: 351 | 352 | - You can build queries with _suricatta_ and execute them with _next.jdbc_. 353 | - You can use _suricatta_ for executing queries with string-based sql. 354 | - You can combine the _suricatta_ library with _next.jdbc_. 355 | - And obviously, you can forget jdbc and use _suricatta_ for both purposes, building 356 | and/or executing queries. 357 | 358 | 359 | === Is it a korma-clone? 360 | 361 | Nope, it's not korma clone, because it works very different, and it has a different 362 | philosophy. 363 | 364 | _suricatta_ has cleaner differentiation between dsl and query execution/fetching. 365 | It doesn't intend to be a replacement of Korma, it intends be a replacement to raw 366 | jdbc access to the database. 367 | 368 | 369 | === Is a JOOQ comercial license requried? 370 | 371 | Not, _suricatta_ works and is tested with the opensource (Apache 2.0 licensed) 372 | version of JOOQ. 373 | 374 | I have plans to make _suricatta_ work with enterprise version of JOOQ for users 375 | that want to use "enterprise" databases in the future. In any case, that will not 376 | affect the open source version. 377 | 378 | 379 | === Can I store safely queries builded by DSL in a var, they are immutable? 380 | 381 | Yes. Unlike JOOQ DSL interface which has a mutable api, _suricatta_ exposes an 382 | immutable api for building queries. 383 | 384 | Queries built with _suricatta_ can be safely shared through different threads. 385 | 386 | 387 | == Developers Guide 388 | 389 | === Philosophy 390 | 391 | The five most important rules are: 392 | 393 | - Beautiful is better than ugly. 394 | - Explicit is better than implicit. 395 | - Simple is better than complex. 396 | - Complex is better than complicated. 397 | - Readability counts. 398 | 399 | All contributions to _suricatta_ should keep these important rules in mind. 400 | 401 | 402 | === Contributing 403 | 404 | Unlike Clojure and other Clojure contributed libraries _suricatta_ does not have many 405 | restrictions for contributions. Just open an issue or pull request. 406 | 407 | 408 | === Source Code 409 | 410 | _suricatta_ is open source and can be found on 411 | link:https://github.com/funcool/suricatta[github]. 412 | 413 | You can clone the public repository with this command: 414 | 415 | [source,text] 416 | ---- 417 | git clone https://github.com/funcool/suricatta 418 | ---- 419 | 420 | 421 | === Run tests 422 | 423 | [source, text] 424 | ---- 425 | clojure -Adev:test 426 | ---- 427 | 428 | === License 429 | 430 | _suricatta_ is licensed under BSD (2-Clause) license: 431 | 432 | ---- 433 | Copyright (c) 2014-2019 Andrey Antukh 434 | 435 | All rights reserved. 436 | 437 | Redistribution and use in source and binary forms, with or without 438 | modification, are permitted provided that the following conditions are met: 439 | 440 | * Redistributions of source code must retain the above copyright notice, this 441 | list of conditions and the following disclaimer. 442 | 443 | * Redistributions in binary form must reproduce the above copyright notice, 444 | this list of conditions and the following disclaimer in the documentation 445 | and/or other materials provided with the distribution. 446 | 447 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 448 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 449 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 450 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 451 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 452 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 453 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 454 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 455 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 456 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 457 | ---- 458 | -------------------------------------------------------------------------------- /src/suricatta/impl.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2014-2019 Andrey Antukh 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 | ;; * Redistributions of source code must retain the above copyright notice, this 8 | ;; list of conditions and the following disclaimer. 9 | ;; 10 | ;; * 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 | ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 | ;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 | ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | ;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 18 | ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19 | ;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 20 | ;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | ;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 22 | ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 23 | ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | 25 | (ns suricatta.impl 26 | (:require 27 | [clojure.string :as str] 28 | [clojure.walk :as walk] 29 | [suricatta.proto :as proto]) 30 | (:import 31 | clojure.lang.PersistentVector 32 | java.sql.Connection 33 | java.sql.DriverManager 34 | java.sql.PreparedStatement 35 | java.util.Properties 36 | javax.sql.DataSource 37 | org.jooq.Configuration 38 | org.jooq.ConnectionProvider 39 | org.jooq.Cursor 40 | org.jooq.DSLContext 41 | org.jooq.DataType 42 | org.jooq.Field 43 | org.jooq.Param 44 | org.jooq.Query 45 | org.jooq.QueryPart 46 | org.jooq.Result 47 | org.jooq.ResultQuery 48 | org.jooq.SQLDialect 49 | org.jooq.TransactionContext 50 | org.jooq.TransactionProvider 51 | org.jooq.impl.DSL 52 | org.jooq.impl.DefaultConfiguration 53 | org.jooq.impl.DefaultTransactionContext 54 | org.jooq.tools.jdbc.JDBCUtils 55 | org.jooq.exception.DataAccessException 56 | org.jooq.util.mariadb.MariaDBDataType 57 | org.jooq.util.mysql.MySQLDataType 58 | org.jooq.util.postgres.PostgresDataType)) 59 | 60 | (set! *warn-on-reflection* false) 61 | 62 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 63 | ;; Helpers 64 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 65 | 66 | (defn ^SQLDialect translate-dialect 67 | "Translate keyword dialect name to proper 68 | jooq SQLDialect enum value." 69 | [dialect] 70 | (if (instance? SQLDialect dialect) 71 | dialect 72 | (case dialect 73 | :postgresql SQLDialect/POSTGRES 74 | :postgres SQLDialect/POSTGRES 75 | :pgsql SQLDialect/POSTGRES 76 | :mariadb SQLDialect/MARIADB 77 | :firebird SQLDialect/FIREBIRD 78 | :mysql SQLDialect/MYSQL 79 | :h2 SQLDialect/H2 80 | :sqlite SQLDialect/SQLITE 81 | SQLDialect/SQL99))) 82 | 83 | (def ^{:doc "Transaction isolation levels" :static true} 84 | +isolation-levels+ 85 | {:none Connection/TRANSACTION_NONE 86 | :read-uncommitted Connection/TRANSACTION_READ_UNCOMMITTED 87 | :read-committed Connection/TRANSACTION_READ_COMMITTED 88 | :repeatable-read Connection/TRANSACTION_REPEATABLE_READ 89 | :serializable Connection/TRANSACTION_SERIALIZABLE}) 90 | 91 | ;; Default implementation for avoid call `satisfies?` 92 | 93 | (extend-protocol proto/IParam 94 | Object 95 | (-param [v _] v) 96 | 97 | nil 98 | (-param [v _] v)) 99 | 100 | (defn wrap-if-need 101 | [ctx obj] 102 | (proto/-param obj ctx)) 103 | 104 | (defn- map->properties 105 | "Convert hash-map to java.utils.Properties instance. This method is used 106 | internally for convert dbspec map to properties instance, but it can 107 | be usefull for other purposes." 108 | [data] 109 | (let [p (Properties.)] 110 | (dorun (map (fn [[k v]] (.setProperty p (name k) (str v))) (seq data))) 111 | p)) 112 | 113 | (defn sql->param 114 | [sql & parts] 115 | (let [wrap (fn [o] (if (instance? Param o) o (DSL/val o))) 116 | parts (->> (map wrap parts) (into-array QueryPart))] 117 | (DSL/field ^String sql ^"[Lorg.jooq.QueryPart;" parts))) 118 | 119 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 120 | ;; Connection management 121 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 122 | 123 | (defn- make-connection 124 | [uri opts] 125 | (let [^Connection conn (proto/-connection uri opts)] 126 | ;; Set readonly flag if it found on the options map 127 | (some->> (:read-only opts) 128 | (.setReadOnly conn)) 129 | 130 | ;; Set the concrete isolation level if it found 131 | ;; on the options map 132 | (some->> (:isolation-level opts) 133 | (get +isolation-levels+) 134 | (.setTransactionIsolation conn)) 135 | 136 | ;; Set the schema if it found on the options map 137 | (some->> (:schema opts) 138 | (.setSchema conn)) 139 | 140 | conn)) 141 | 142 | (defn- map->properties 143 | ^java.util.Properties 144 | [opts] 145 | (letfn [(reduce-fn [^Properties acc k v] 146 | (.setProperty acc (name k) (str v)) 147 | acc)] 148 | (reduce-kv reduce-fn (Properties.) opts))) 149 | 150 | (defn make-context 151 | ([conf] (make-context conf nil)) 152 | ([conf conn] 153 | (reify 154 | proto/IContextHolder 155 | (-context [_] (DSL/using conf)) 156 | (-config [_] conf) 157 | 158 | java.io.Closeable 159 | (close [_] 160 | (when (and conn (not (.isClosed conn))) 161 | (.close conn) 162 | (.set conf (org.jooq.impl.NoConnectionProvider.))))))) 163 | 164 | (defn context 165 | [uri opts] 166 | (let [^Connection connection (make-connection uri opts) 167 | ^SQLDialect dialect (if (:dialect opts) 168 | (translate-dialect (:dialect opts)) 169 | (JDBCUtils/dialect connection)) 170 | ^Configuration conf (doto (DefaultConfiguration.) 171 | (.set dialect) 172 | (.set connection))] 173 | (make-context conf connection))) 174 | 175 | (extend-protocol proto/IConnectionFactory 176 | java.sql.Connection 177 | (-connection [it opts] it) 178 | 179 | javax.sql.DataSource 180 | (-connection [it opts] 181 | (.getConnection it)) 182 | 183 | java.lang.String 184 | (-connection [url opts] 185 | (let [url (if (.startsWith url "jdbc:") url (str "jdbc:" url))] 186 | (DriverManager/getConnection url (map->properties opts))))) 187 | 188 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 189 | ;; IExecute implementation 190 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 191 | 192 | (defn- make-params 193 | ^"[Ljava.lang.Object;" 194 | [^DSLContext context params] 195 | (->> (map (partial wrap-if-need context) params) 196 | (into-array Object))) 197 | 198 | (extend-protocol proto/IExecute 199 | java.lang.String 200 | (-execute [^String sql ctx] 201 | (let [^DSLContext context (proto/-context ctx)] 202 | (.execute context sql))) 203 | 204 | org.jooq.Query 205 | (-execute [^Query query ctx] 206 | (let [^DSLContext context (proto/-context ctx)] 207 | (.execute context query))) 208 | 209 | PersistentVector 210 | (-execute [^PersistentVector sqlvec ctx] 211 | (let [^DSLContext context (proto/-context ctx) 212 | ^String sql (first sqlvec) 213 | params (make-params context (rest sqlvec)) 214 | query (.query context sql params)] 215 | (.execute context ^Query query))) 216 | 217 | ResultQuery 218 | (-execute [query ctx] 219 | (let [^DSLContext context (proto/-context ctx)] 220 | (.execute context query)))) 221 | 222 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 223 | ;; IFetch Implementation 224 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 225 | 226 | ;; Default implementation for avoid call to `satisfies?` 227 | (extend-protocol proto/ISQLType 228 | Object 229 | (-convert [v] v) 230 | 231 | nil 232 | (-convert [v] v)) 233 | 234 | 235 | (defn- result-record->record 236 | [^org.jooq.Record record] 237 | (letfn [(reduce-fn [acc ^Field field] 238 | (let [value (.getValue field record) 239 | name (.getName field)] 240 | (assoc! acc (keyword (.toLowerCase name)) 241 | (proto/-convert value))))] 242 | (-> (reduce reduce-fn (transient {}) (.fields record)) 243 | (persistent!)))) 244 | 245 | (defn- result-record->row 246 | [^org.jooq.Record record] 247 | (letfn [(reduce-fn [acc ^Field field] 248 | (let [value (.getValue field record) 249 | name (.getName field)] 250 | (conj! acc (proto/-convert value))))] 251 | (-> (reduce reduce-fn (transient []) (.fields record)) 252 | (persistent!)))) 253 | 254 | (defn- result->vector 255 | [^org.jooq.Result result {:keys [mapfn format] :or {rows false format :record}}] 256 | (if mapfn 257 | (mapv mapfn result) 258 | (case format 259 | :record (mapv result-record->record result) 260 | :row (mapv result-record->row result) 261 | :json (.formatJSON result) 262 | :csv (.formatCSV result)))) 263 | 264 | (extend-protocol proto/IFetch 265 | String 266 | (-fetch [^String sql ctx opts] 267 | (let [^DSLContext context (proto/-context ctx) 268 | ^Result result (.fetch context sql)] 269 | (result->vector result opts))) 270 | 271 | PersistentVector 272 | (-fetch [^PersistentVector sqlvec ctx opts] 273 | (let [^DSLContext context (proto/-context ctx) 274 | ^String sql (first sqlvec) 275 | params (make-params context (rest sqlvec)) 276 | query (.resultQuery context sql params)] 277 | (-> (.fetch context ^ResultQuery query) 278 | (result->vector opts)))) 279 | 280 | ResultQuery 281 | (-fetch [^ResultQuery query ctx opts] 282 | (let [^DSLContext context (proto/-context ctx)] 283 | (-> (.fetch context query) 284 | (result->vector opts))))) 285 | 286 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 287 | ;; IFetchLazy Implementation 288 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 289 | 290 | (extend-protocol proto/IFetchLazy 291 | java.lang.String 292 | (-fetch-lazy [^String query ctx opts] 293 | (let [^DSLContext context (proto/-context ctx) 294 | ^ResultQuery query (.resultQuery context query)] 295 | (->> (.fetchSize query (get opts :fetch-size 128)) 296 | (.fetchLazy context)))) 297 | 298 | PersistentVector 299 | (-fetch-lazy [^PersistentVector sqlvec ctx opts] 300 | (let [^DSLContext context (proto/-context ctx) 301 | ^String sql (first sqlvec) 302 | params (make-params context (rest sqlvec)) 303 | query (.resultQuery context sql params)] 304 | (->> (.fetchSize query (get opts :fetch-size 128)) 305 | (.fetchLazy context)))) 306 | 307 | org.jooq.ResultQuery 308 | (-fetch-lazy [^ResultQuery query ctx opts] 309 | (let [^DSLContext context (proto/-context ctx)] 310 | (->> (.fetchSize query (get opts :fetch-size 128)) 311 | (.fetchLazy context))))) 312 | 313 | (defn cursor->seq 314 | [^Cursor cursor {:keys [format mapfn] :or {format :record}}] 315 | (letfn [(transform-fn [item] 316 | (if mapfn 317 | (mapfn item) 318 | (case format 319 | :record (result-record->record item) 320 | :row (result-record->row item))))] 321 | (sequence (map transform-fn) cursor))) 322 | 323 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 324 | ;; IQuery Implementation 325 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 326 | 327 | (extend-protocol proto/IQuery 328 | java.lang.String 329 | (-query [sql ctx] 330 | (let [^DSLContext context (proto/-context ctx) 331 | ^Configuration conf (proto/-config ctx)] 332 | (-> (.resultQuery context sql) 333 | (.keepStatement true)))) 334 | 335 | PersistentVector 336 | (-query [sqlvec ctx] 337 | (let [^DSLContext context (proto/-context ctx) 338 | ^Configuration conf (proto/-config ctx) 339 | ^String sql (first sqlvec) 340 | params (make-params context (rest sqlvec))] 341 | (-> (.resultQuery context sql params) 342 | (.keepStatement true))))) 343 | 344 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 345 | ;; Load into implementation 346 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 347 | 348 | (def ^{:doc "Datatypes translation map" :dynamic true} 349 | *datatypes* 350 | {:pg/varchar PostgresDataType/VARCHAR 351 | :pg/any PostgresDataType/ANY 352 | :pg/bigint PostgresDataType/BIGINT 353 | :pg/bigserial PostgresDataType/BIGSERIAL 354 | :pg/boolean PostgresDataType/BOOLEAN 355 | :pg/date PostgresDataType/DATE 356 | :pg/decimal PostgresDataType/DECIMAL 357 | :pg/real PostgresDataType/REAL 358 | :pg/double PostgresDataType/DOUBLEPRECISION 359 | :pg/int4 PostgresDataType/INT4 360 | :pg/int2 PostgresDataType/INT2 361 | :pg/int8 PostgresDataType/INT8 362 | :pg/integer PostgresDataType/INTEGER 363 | :pg/serial PostgresDataType/SERIAL 364 | :pg/serial4 PostgresDataType/SERIAL4 365 | :pg/serial8 PostgresDataType/SERIAL8 366 | :pg/smallint PostgresDataType/SMALLINT 367 | :pg/text PostgresDataType/TEXT 368 | :pg/time PostgresDataType/TIME 369 | :pg/timetz PostgresDataType/TIMETZ 370 | :pg/timestamp PostgresDataType/TIMESTAMP 371 | :pg/timestamptz PostgresDataType/TIMESTAMPTZ 372 | :pg/uuid PostgresDataType/UUID 373 | :pg/char PostgresDataType/CHAR 374 | :pg/bytea PostgresDataType/BYTEA 375 | :pg/numeric PostgresDataType/NUMERIC 376 | :pg/json PostgresDataType/JSON 377 | :maria/bigint MariaDBDataType/BIGINT 378 | :maria/ubigint MariaDBDataType/BIGINTUNSIGNED 379 | :maria/binary MariaDBDataType/BINARY 380 | :maria/blob MariaDBDataType/BLOB 381 | :maria/bool MariaDBDataType/BOOL 382 | :maria/boolean MariaDBDataType/BOOLEAN 383 | :maria/char MariaDBDataType/CHAR 384 | :maria/date MariaDBDataType/DATE 385 | :maria/datetime MariaDBDataType/DATETIME 386 | :maria/decimal MariaDBDataType/DECIMAL 387 | :maria/double MariaDBDataType/DOUBLE 388 | :maria/enum MariaDBDataType/ENUM 389 | :maria/float MariaDBDataType/FLOAT 390 | :maria/int MariaDBDataType/INT 391 | :maria/integer MariaDBDataType/INTEGER 392 | :maria/uint MariaDBDataType/INTEGERUNSIGNED 393 | :maria/longtext MariaDBDataType/LONGTEXT 394 | :maria/mediumint MariaDBDataType/MEDIUMINT 395 | :maria/real MariaDBDataType/REAL 396 | :maria/smallint MariaDBDataType/SMALLINT 397 | :maria/time MariaDBDataType/TIME 398 | :maria/timestamp MariaDBDataType/TIMESTAMP 399 | :maria/varchar MariaDBDataType/VARCHAR 400 | :mysql/bigint MySQLDataType/BIGINT 401 | :mysql/ubigint MySQLDataType/BIGINTUNSIGNED 402 | :mysql/binary MySQLDataType/BINARY 403 | :mysql/blob MySQLDataType/BLOB 404 | :mysql/bool MySQLDataType/BOOL 405 | :mysql/boolean MySQLDataType/BOOLEAN 406 | :mysql/char MySQLDataType/CHAR 407 | :mysql/date MySQLDataType/DATE 408 | :mysql/datetime MySQLDataType/DATETIME 409 | :mysql/decimal MySQLDataType/DECIMAL 410 | :mysql/double MySQLDataType/DOUBLE 411 | :mysql/enum MySQLDataType/ENUM 412 | :mysql/float MySQLDataType/FLOAT 413 | :mysql/int MySQLDataType/INT 414 | :mysql/integer MySQLDataType/INTEGER 415 | :mysql/uint MySQLDataType/INTEGERUNSIGNED 416 | :mysql/longtext MySQLDataType/LONGTEXT 417 | :mysql/mediumint MySQLDataType/MEDIUMINT 418 | :mysql/real MySQLDataType/REAL 419 | :mysql/smallint MySQLDataType/SMALLINT 420 | :mysql/time MySQLDataType/TIME 421 | :mysql/timestamp MySQLDataType/TIMESTAMP 422 | :mysql/varchar MySQLDataType/VARCHAR}) 423 | 424 | (defn typed-field 425 | [data type] 426 | (let [f (clojure.core/name data) 427 | dt (get *datatypes* type)] 428 | (DSL/field f ^DataType dt))) 429 | 430 | (defn load-into 431 | [ctx tablename data {:keys [format commit fields ignore-rows 432 | nullstring quotechar separator] 433 | :or {format :csv commit :none ignore-rows 0 434 | nullstring "" quotechar \" separator \,}}] 435 | (let [^DSLContext context (proto/-context ctx) 436 | step (.loadInto context (DSL/table (name tablename))) 437 | step (case commit 438 | :none (.commitNone step) 439 | :each (.commitEach step) 440 | :all (.commitAll step) 441 | (.commitAfter step commit)) 442 | step (case format 443 | :csv (.loadCSV step data) 444 | :json (.loadJSON step data)) 445 | fields (into-array org.jooq.Field fields)] 446 | (doto step 447 | (.fields fields) 448 | (.ignoreRows ignore-rows)) 449 | (when (= format :csv) 450 | (doto step 451 | (.quote quotechar) 452 | (.nullString nullstring) 453 | (.separator separator))) 454 | (.execute step))) 455 | 456 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 457 | ;; Transactions 458 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 459 | 460 | (defn transaction-context 461 | {:internal true} 462 | [^Configuration conf] 463 | (let [transaction (atom nil) 464 | cause (atom nil)] 465 | (reify TransactionContext 466 | (configuration [_] conf) 467 | (settings [_] (.settings conf)) 468 | (dialect [_] (.dialect conf)) 469 | (family [_] (.family (.dialect conf))) 470 | (transaction [_] @transaction) 471 | (transaction [self t] (reset! transaction t) self) 472 | (cause [_] @cause) 473 | (cause [self c] (reset! cause c) self)))) 474 | 475 | (defn apply-atomic 476 | [ctx func & args] 477 | (let [^Configuration conf (.derive (proto/-config ctx)) 478 | ^TransactionContext txctx (transaction-context conf) 479 | ^TransactionProvider provider (.transactionProvider conf)] 480 | (doto conf 481 | (.data "suricatta.rollback" false) 482 | (.data "suricatta.transaction" true)) 483 | (try 484 | (.begin provider txctx) 485 | (let [result (apply func (make-context conf) args) 486 | rollback? (.data conf "suricatta.rollback")] 487 | (if rollback? 488 | (.rollback provider txctx) 489 | (.commit provider txctx)) 490 | result) 491 | (catch Exception cause 492 | (.rollback provider (.cause txctx cause)) 493 | (if (instance? RuntimeException cause) 494 | (throw cause) 495 | (throw (DataAccessException. "Rollback caused" cause))))))) 496 | 497 | (defn set-rollback! 498 | [ctx] 499 | (let [^Configuration conf (proto/-config ctx)] 500 | (.data conf "suricatta.rollback" true) 501 | ctx)) 502 | --------------------------------------------------------------------------------