From a452946f5872ad44bd1d128453bbd893ad115af0 Mon Sep 17 00:00:00 2001 From: Felix Paulusma Date: Mon, 5 Aug 2019 06:10:31 +0200 Subject: [PATCH] PostgreSQL JSON Operators (#128) * added PostgreSQL.JSON module * finished adding all JSON operators * cleanup * half way through writing tests * final tweaks to comments * finished with JSON tests * upped persistent dependency to 2.10.0 because of PersistArray data constructor addition needed for JSON operators * noticed the minus operator with text[] as right operand was only added in PSQL v10, added function and adjusted types/tests * adjusted yaml configs for updated dependencies and PSQL v10 in Travis * try to get PostgreSQL 10 running * use @since notation * removed postgresql from 'services' field * and one more time, with FEELING! (and postgresql-10) * foo * PSQL 10 runs on 5433, it seems? reverting .travis.yml changes and setting test conn to port 5433 * of course I forget to add the PORT env > .< * doop-dee-doo * herp-a-derp * last commit (hopefully) * also have more recent dependencies in the 'compiler should error' tests * why does it feel like this'll go on for a while still? * copied some extra-deps from the persistent ymls * aaaaand we're done... right? * added persistent-postgresql to the dependencies and used its instances for Aeson.Value * small comment fix * moved the instances to their own module, this way they're optional to use if you don't use persistent-postgresql * use port 5432, like a normal PostgreSQL! * added JSONB newtype with instances, instead of orphaning Aeson.Value * reworked everything to use the JSONB newtype. And adjusted most comments to reflect the change * fixed all the tests (just making it compile again) * that's right, Travis' PSQL v10 NEEEEDS it to be port 5433... for some reason * update on the haddockumentation * added JSONAccessor data type for easier usage of certain operators * Also add to changelog.md * JSONExpr -> JSONBExpr * this damn PGPORT is really irritating --- .travis.yml | 16 +- changelog.md | 6 + esqueleto.cabal | 17 +- src/Database/Esqueleto/Internal/Internal.hs | 8 +- src/Database/Esqueleto/PostgreSQL/JSON.hs | 584 ++++++++++++++++++ .../Esqueleto/PostgreSQL/JSON/Instances.hs | 120 ++++ stack-8.2.yaml | 20 +- stack-8.4.yaml | 11 +- test/Common/Test.hs | 4 +- test/PostgreSQL/MigrateJSON.hs | 34 + test/PostgreSQL/Test.hs | 534 +++++++++++++++- test/expected-compile-failures/src/Lib.hs | 2 + test/expected-compile-failures/stack-8.2.yaml | 20 +- test/expected-compile-failures/stack-8.4.yaml | 12 + test/expected-compile-failures/stack-8.6.yaml | 8 +- test/expected-compile-failures/stack.yaml | 11 + .../expected-compile-failures/stack.yaml.lock | 75 +++ 17 files changed, 1435 insertions(+), 47 deletions(-) create mode 100644 src/Database/Esqueleto/PostgreSQL/JSON.hs create mode 100644 src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs create mode 100644 test/PostgreSQL/MigrateJSON.hs create mode 100644 test/expected-compile-failures/stack.yaml.lock diff --git a/.travis.yml b/.travis.yml index 98fc04b..62399b6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,22 +3,24 @@ language: c sudo: false services: - - postgresql - mysql addons: + postgresql: "10" apt: packages: - libgmp-dev - - postgresql-client + - postgresql-10 + - postgresql-client-10 - postgresql-server-dev-all - postgresql: "9.6" - env: - - GHCVER=8.2 - - GHCVER=8.4 - - GHCVER=8.6 + global: + - PGPORT=5433 + matrix: + - GHCVER=8.2 + - GHCVER=8.4 + - GHCVER=8.6 install: - export STACK_YAML=stack-$GHCVER.yaml diff --git a/changelog.md b/changelog.md index 7193682..615e185 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,12 @@ Unreleased ======== +3.1.0 +======= + +- @Vlix + - [#128](https://github.com/bitemyapp/esqueleto/pull/128): Added `Database.Esqueleto.PostgreSQL.JSON` module with JSON operators and `JSONB` data type. + 3.0.0 ======= diff --git a/esqueleto.cabal b/esqueleto.cabal index 8d81084..b89ad99 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: esqueleto -version: 3.0.0 +version: 3.1.0 synopsis: Type-safe EDSL for SQL queries on persistent backends. description: @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends. Its language closely resembles SQL, so you don't have to learn new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime. . @@ -33,20 +33,23 @@ library Database.Esqueleto.Internal.Sql Database.Esqueleto.MySQL Database.Esqueleto.PostgreSQL + Database.Esqueleto.PostgreSQL.JSON Database.Esqueleto.SQLite other-modules: Database.Esqueleto.Internal.Internal Database.Esqueleto.Internal.PersistentImport + Database.Esqueleto.PostgreSQL.JSON.Instances Paths_esqueleto hs-source-dirs: src/ build-depends: base >=4.8 && <5.0 + , aeson >=1.0 , blaze-html , bytestring , conduit >=1.3 , monad-logger - , persistent >=2.8.0 && <2.11 + , persistent >=2.10.0 && <2.11 , resourcet >=1.2 , tagged >=0.2 , text >=0.11 && <1.3 @@ -76,6 +79,7 @@ test-suite mysql , conduit >=1.3 , containers , esqueleto + , exceptions , hspec , monad-logger , mysql @@ -97,21 +101,24 @@ test-suite postgresql main-is: PostgreSQL/Test.hs other-modules: Common.Test + PostgreSQL.MigrateJSON Paths_esqueleto hs-source-dirs: test ghc-options: -Wall build-depends: base >=4.8 && <5.0 + , aeson , blaze-html , bytestring , conduit >=1.3 , containers , esqueleto + , exceptions , hspec , monad-logger - , persistent >=2.8.0 && <2.11 - , persistent-postgresql + , persistent >=2.10.0 && <2.11 + , persistent-postgresql >= 2.10.0 && <2.11 , persistent-template , postgresql-libpq , postgresql-simple @@ -122,6 +129,7 @@ test-suite postgresql , transformers >=0.2 , unliftio , unordered-containers >=0.2 + , vector default-language: Haskell2010 test-suite sqlite @@ -140,6 +148,7 @@ test-suite sqlite , conduit >=1.3 , containers , esqueleto + , exceptions , hspec , monad-logger , persistent >=2.8.0 && <2.11 diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index a63367d..071b50f 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -46,6 +46,7 @@ import Database.Persist.Sql.Util (entityColumnNames, entityColumnCount, parseEnt import qualified Control.Monad.Trans.Reader as R import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.Writer as W +import qualified Data.ByteString as B import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import qualified Data.HashSet as HS @@ -53,16 +54,9 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB -import Control.Exception (Exception) -import Data.Int (Int64) import Data.Typeable (Typeable) -import Database.Esqueleto.Internal.PersistentImport import Text.Blaze.Html (Html) -import qualified Data.ByteString as B -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL - -- | (Internal) Start a 'from' query with an entity. 'from' -- does two kinds of magic using 'fromStart', 'fromJoin' and -- 'fromFinish': diff --git a/src/Database/Esqueleto/PostgreSQL/JSON.hs b/src/Database/Esqueleto/PostgreSQL/JSON.hs new file mode 100644 index 0000000..01e93ae --- /dev/null +++ b/src/Database/Esqueleto/PostgreSQL/JSON.hs @@ -0,0 +1,584 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| + This module contains PostgreSQL-specific JSON functions. + + A couple of things to keep in mind about this module: + + * The @Type@ column in the PostgreSQL documentation tables + are the types of the right operand, the left is always @jsonb@. + * Since these operators can all take @NULL@ values as their input, + and most can also output @NULL@ values (even when the inputs are + guaranteed to not be NULL), all 'JSONB' values are wrapped in + 'Maybe'. This also makes it easier to chain them. (cf. 'JSONBExpr') + Just use the 'just' function to lift any non-'Maybe' JSONB values + in case it doesn't type check. + * As long as the previous operator's resulting value is + a 'JSONBExpr', any other JSON operator can be used to transform + the JSON further. (e.g. @[1,2,3] -> 1 \@> 2@) + + /The PostgreSQL version the functions work with are included/ + /in their description./ + + @since 3.1.0 +-} +module Database.Esqueleto.PostgreSQL.JSON + ( -- * JSONB Newtype + -- + -- | With 'JSONB', you can use your Haskell types in your + -- database table models as long as your type has 'FromJSON' + -- and 'ToJSON' instances. + -- + -- @ + -- import Database.Persist.TH + -- + -- share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| + -- Example + -- json (JSONB MyType) + -- |] + -- @ + -- + -- CAUTION: Remember that changing the 'FromJSON' instance + -- of your type might result in old data becoming unparsable! + -- You can use (@JSONB Data.Aeson.Value@) for unstructured/variable JSON. + JSONB(..) + , JSONBExpr + , jsonbVal + -- * JSONAccessor + , JSONAccessor(..) + -- * Arrow operators + -- + -- | /Better documentation included with individual functions/ + -- + -- The arrow operators are selection functions to select values + -- from JSON arrays or objects. + -- + -- === PostgreSQL Documentation + -- + -- /Requires PostgreSQL version >= 9.3/ + -- + -- @ + -- | Type | Description | Example | Example Result + -- -----+--------+--------------------------------------------+--------------------------------------------------+---------------- + -- -> | int | Get JSON array element (indexed from zero, | '[{"a":"foo"},{"b":"bar"},{"c":"baz"}]'::json->2 | {"c":"baz"} + -- | | negative integers count from the end) | | + -- -> | text | Get JSON object field by key | '{"a": {"b":"foo"}}'::json->'a' | {"b":"foo"} + -- ->> | int | Get JSON array element as text | '[1,2,3]'::json->>2 | 3 + -- ->> | text | Get JSON object field as text | '{"a":1,"b":2}'::json->>'b' | 2 + -- \#> | text[] | Get JSON object at specified path | '{"a": {"b":{"c": "foo"}}}'::json#>'{a,b}' | {"c": "foo"} + -- \#>> | text[] | Get JSON object at specified path as text | '{"a":[1,2,3],"b":[4,5,6]}'::json#>>'{a,2}' | 3 + -- @ + , (->.) + , (->>.) + , (#>.) + , (#>>.) + -- * Filter operators + -- + -- | /Better documentation included with individual functions/ + -- + -- These functions test certain properties of JSON values + -- and return booleans, so are mainly used in WHERE clauses. + -- + -- === PostgreSQL Documentation + -- + -- /Requires PostgreSQL version >= 9.4/ + -- + -- @ + -- | Type | Description | Example + -- ----+--------+-----------------------------------------------------------------+--------------------------------------------------- + -- \@> | jsonb | Does the left JSON value contain within it the right value? | '{"a":1, "b":2}'::jsonb \@> '{"b":2}'::jsonb + -- <\@ | jsonb | Is the left JSON value contained within the right value? | '{"b":2}'::jsonb <\@ '{"a":1, "b":2}'::jsonb + -- ? | text | Does the string exist as a top-level key within the JSON value? | '{"a":1, "b":2}'::jsonb ? 'b' + -- ?| | text[] | Do any of these array strings exist as top-level keys? | '{"a":1, "b":2, "c":3}'::jsonb ?| array['b', 'c'] + -- ?& | text[] | Do all of these array strings exist as top-level keys? | '["a", "b"]'::jsonb ?& array['a', 'b'] + -- @ + , (@>.) + , (<@.) + , (?.) + , (?|.) + , (?&.) + -- * Deletion and concatenation operators + -- + -- | /Better documentation included with individual functions/ + -- + -- These operators change the shape of the JSON value and + -- also have the highest risk of throwing an exception. + -- Please read the descriptions carefully before using these functions. + -- + -- === PostgreSQL Documentation + -- + -- /Requires PostgreSQL version >= 9.5/ + -- + -- @ + -- | Type | Description | Example + -- ----+---------+------------------------------------------------------------------------+------------------------------------------------- + -- || | jsonb | Concatenate two jsonb values into a new jsonb value | '["a", "b"]'::jsonb || '["c", "d"]'::jsonb + -- - | text | Delete key/value pair or string element from left operand. | '{"a": "b"}'::jsonb - 'a' + -- | | Key/value pairs are matched based on their key value. | + -- - | integer | Delete the array element with specified index (Negative integers count | '["a", "b"]'::jsonb - 1 + -- | | from the end). Throws an error if top level container is not an array. | + -- \#- | text[] | Delete the field or element with specified path | '["a", {"b":1}]'::jsonb \#- '{1,b}' + -- | | (for JSON arrays, negative integers count from the end) | + -- @ + -- + -- /Requires PostgreSQL version >= 10/ + -- + -- @ + -- | Type | Description | Example + -- ----+---------+------------------------------------------------------------------------+------------------------------------------------- + -- - | text[] | Delete multiple key/value pairs or string elements from left operand. | '{"a": "b", "c": "d"}'::jsonb - '{a,c}'::text[] + -- | | Key/value pairs are matched based on their key value. | + -- @ + , (-.) + , (--.) + , (#-.) + , (||.) + ) where + +import Data.Text (Text) +import Database.Esqueleto.Internal.Language hiding ((?.), (-.), (||.)) +import Database.Esqueleto.Internal.PersistentImport +import Database.Esqueleto.Internal.Sql +import Database.Esqueleto.PostgreSQL.JSON.Instances + + +infixl 6 ->., ->>., #>., #>>. +infixl 6 @>., <@., ?., ?|., ?&. +infixl 6 ||., -., --., #-. + + +-- | /Requires PostgreSQL version >= 9.3/ +-- +-- This function extracts the jsonb value from a JSON array or object, +-- depending on whether you use an @int@ or a @text@. (cf. 'JSONAccessor') +-- +-- As long as the left operand is @jsonb@, this function will not +-- throw an exception, but will return @NULL@ when an @int@ is used on +-- anything other than a JSON array, or a @text@ is used on anything +-- other than a JSON object. +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example | Example Result +-- ----+------+--------------------------------------------+--------------------------------------------------+---------------- +-- -> | int | Get JSON array element (indexed from zero) | '[{"a":"foo"},{"b":"bar"},{"c":"baz"}]'::json->2 | {"c":"baz"} +-- -> | text | Get JSON object field by key | '{"a": {"b":"foo"}}'::json->'a' | {"b":"foo"} +-- @ +-- +-- @since 3.1.0 +(->.) :: JSONBExpr a -> JSONAccessor -> JSONBExpr b +(->.) value (JSONKey txt) = unsafeSqlBinOp " -> " value $ val txt +(->.) value (JSONIndex i) = unsafeSqlBinOp " -> " value $ val i + +-- | /Requires PostgreSQL version >= 9.3/ +-- +-- Identical to '->.', but the resulting DB type is a @text@, +-- so it could be chained with anything that uses @text@. +-- +-- __CAUTION: if the "scalar" JSON value @null@ is the result__ +-- __of this function, PostgreSQL will interpret it as a__ +-- __PostgreSQL @NULL@ value, and will therefore be 'Nothing'__ +-- __instead of (Just "null")__ +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example | Example Result +-- -----+------+--------------------------------+-----------------------------+---------------- +-- ->> | int | Get JSON array element as text | '[1,2,3]'::json->>2 | 3 +-- ->> | text | Get JSON object field as text | '{"a":1,"b":2}'::json->>'b' | 2 +-- @ +-- +-- @since 3.1.0 +(->>.) :: JSONBExpr a -> JSONAccessor -> SqlExpr (Value (Maybe Text)) +(->>.) value (JSONKey txt) = unsafeSqlBinOp " ->> " value $ val txt +(->>.) value (JSONIndex i) = unsafeSqlBinOp " ->> " value $ val i + +-- | /Requires PostgreSQL version >= 9.3/ +-- +-- This operator can be used to select a JSON value from deep inside another one. +-- It only works on objects and arrays and will result in @NULL@ ('Nothing') when +-- encountering any other JSON type. +-- +-- The 'Text's used in the right operand list will always select an object field, but +-- can also select an index from a JSON array if that text is parsable as an integer. +-- +-- Consider the following: +-- +-- @ +-- x ^. TestBody #>. ["0","1"] +-- @ +-- +-- The following JSON values in the @test@ table's @body@ column will be affected: +-- +-- @ +-- Values in column | Resulting value +-- --------------------------------------+---------------------------- +-- {"0":{"1":"Got it!"}} | "Got it!" +-- {"0":[null,["Got it!","Even here!"]]} | ["Got it!", "Even here!"] +-- [{"1":"Got it again!"}] | "Got it again!" +-- [[null,{\"Wow\":"so deep!"}]] | {\"Wow\": "so deep!"} +-- false | NULL +-- "nope" | NULL +-- 3.14 | NULL +-- @ +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example | Example Result +-- -----+--------+-----------------------------------+--------------------------------------------+---------------- +-- \#> | text[] | Get JSON object at specified path | '{"a": {"b":{"c": "foo"}}}'::json#>'{a,b}' | {"c": "foo"} +-- @ +-- +-- @since 3.1.0 +(#>.) :: JSONBExpr a -> [Text] -> JSONBExpr b +(#>.) value = unsafeSqlBinOp " #> " value . mkTextArray + + +-- | /Requires PostgreSQL version >= 9.3/ +-- +-- This function is to '#>.' as '->>.' is to '->.' +-- +-- __CAUTION: if the "scalar" JSON value @null@ is the result__ +-- __of this function, PostgreSQL will interpret it as a__ +-- __PostgreSQL @NULL@ value, and will therefore be 'Nothing'__ +-- __instead of (Just "null")__ +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example | Example Result +-- -----+--------+-------------------------------------------+---------------------------------------------+---------------- +-- \#>> | text[] | Get JSON object at specified path as text | '{"a":[1,2,3],"b":[4,5,6]}'::json#>>'{a,2}' | 3 +-- @ +-- +-- @since 3.1.0 +(#>>.) :: JSONBExpr a -> [Text] -> SqlExpr (Value (Maybe Text)) +(#>>.) value = unsafeSqlBinOp " #>> " value . mkTextArray + +-- | /Requires PostgreSQL version >= 9.4/ +-- +-- This operator checks for the JSON value on the right to be a subset +-- of the JSON value on the left. +-- +-- Examples of the usage of this operator can be found in +-- the Database.Persist.Postgresql.JSON module. +-- +-- (here: ) +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example +-- ----+-------+-------------------------------------------------------------+--------------------------------------------- +-- \@> | jsonb | Does the left JSON value contain within it the right value? | '{"a":1, "b":2}'::jsonb \@> '{"b":2}'::jsonb +-- @ +-- +-- @since 3.1.0 +(@>.) :: JSONBExpr a -> JSONBExpr b -> SqlExpr (Value Bool) +(@>.) = unsafeSqlBinOp " @> " + +-- | /Requires PostgreSQL version >= 9.4/ +-- +-- This operator works the same as '@>.', just with the arguments flipped. +-- So it checks for the JSON value on the left to be a subset of JSON value on the right. +-- +-- Examples of the usage of this operator can be found in +-- the Database.Persist.Postgresql.JSON module. +-- +-- (here: ) +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example +-- ----+-------+----------------------------------------------------------+--------------------------------------------- +-- <\@ | jsonb | Is the left JSON value contained within the right value? | '{"b":2}'::jsonb <\@ '{"a":1, "b":2}'::jsonb +-- @ +-- +-- @since 3.1.0 +(<@.) :: JSONBExpr a -> JSONBExpr b -> SqlExpr (Value Bool) +(<@.) = unsafeSqlBinOp " <@ " + +-- | /Requires PostgreSQL version >= 9.4/ +-- +-- This operator checks if the given text is a top-level member of the +-- JSON value on the left. This means a top-level field in an object, a +-- top-level string in an array or just a string value. +-- +-- Examples of the usage of this operator can be found in +-- the Database.Persist.Postgresql.JSON module. +-- +-- (here: ) +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example +-- ---+------+-----------------------------------------------------------------+------------------------------- +-- ? | text | Does the string exist as a top-level key within the JSON value? | '{"a":1, "b":2}'::jsonb ? 'b' +-- @ +-- +-- @since 3.1.0 +(?.) :: JSONBExpr a -> Text -> SqlExpr (Value Bool) +(?.) value = unsafeSqlBinOp " ?? " value . val + +-- | /Requires PostgreSQL version >= 9.4/ +-- +-- This operator checks if __ANY__ of the given texts is a top-level member +-- of the JSON value on the left. This means any top-level field in an object, +-- any top-level string in an array or just a string value. +-- +-- Examples of the usage of this operator can be found in +-- the Database.Persist.Postgresql.JSON module. +-- +-- (here: ) +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example +-- ----+--------+--------------------------------------------------------+--------------------------------------------------- +-- ?| | text[] | Do any of these array strings exist as top-level keys? | '{"a":1, "b":2, "c":3}'::jsonb ?| array['b', 'c'] +-- @ +-- +-- @since 3.1.0 +(?|.) :: JSONBExpr a -> [Text] -> SqlExpr (Value Bool) +(?|.) value = unsafeSqlBinOp " ??| " value . mkTextArray + +-- | /Requires PostgreSQL version >= 9.4/ +-- +-- This operator checks if __ALL__ of the given texts are top-level members +-- of the JSON value on the left. This means a top-level field in an object, +-- a top-level string in an array or just a string value. +-- +-- Examples of the usage of this operator can be found in +-- the Database.Persist.Postgresql.JSON module. +-- +-- (here: ) +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example +-- ----+--------+--------------------------------------------------------+---------------------------------------- +-- ?& | text[] | Do all of these array strings exist as top-level keys? | '["a", "b"]'::jsonb ?& array['a', 'b'] +-- @ +-- +-- @since 3.1.0 +(?&.) :: JSONBExpr a -> [Text] -> SqlExpr (Value Bool) +(?&.) value = unsafeSqlBinOp " ??& " value . mkTextArray + +-- | /Requires PostgreSQL version >= 9.5/ +-- +-- This operator concatenates two JSON values. The behaviour is +-- self-evident when used on two arrays, but the behaviour on different +-- combinations of JSON values might behave unexpectedly. +-- +-- __CAUTION: THIS FUNCTION THROWS AN EXCEPTION WHEN CONCATENATING__ +-- __A JSON OBJECT WITH A JSON SCALAR VALUE!__ +-- +-- === __Arrays__ +-- +-- This operator is a standard concatenation function when used on arrays: +-- +-- @ +-- [1,2] || [2,3] == [1,2,2,3] +-- [] || [1,2,3] == [1,2,3] +-- [1,2,3] || [] == [1,2,3] +-- @ +-- +-- === __Objects__ +-- When concatenating JSON objects with other JSON objects, the fields +-- from the JSON object on the right are added to the JSON object on the +-- left. When concatenating a JSON object with a JSON array, the object +-- will be inserted into the array; either on the left or right, depending +-- on the position relative to the operator. +-- +-- When concatening an object with a scalar value, an exception is thrown. +-- +-- @ +-- {"a": 3.14} || {"b": true} == {"a": 3.14, "b": true} +-- {"a": "b"} || {"a": null} == {"a": null} +-- {"a": {"b": true, "c": false}} || {"a": {"b": false}} == {"a": {"b": false}} +-- {"a": 3.14} || [1,null] == [{"a": 3.14},1,null] +-- [1,null] || {"a": 3.14} == [1,null,{"a": 3.14}] +-- 1 || {"a": 3.14} == ERROR: invalid concatenation of jsonb objects +-- {"a": 3.14} || false == ERROR: invalid concatenation of jsonb objects +-- @ +-- +-- === __Scalar values__ +-- +-- Scalar values can be thought of as being singleton arrays when +-- used with this operator. This rule does not apply when concatenating +-- with JSON objects. +-- +-- @ +-- 1 || null == [1,null] +-- true || "a" == [true,"a"] +-- [1,2] || false == [1,2,false] +-- null || [1,"a"] == [null,1,"a"] +-- {"a":3.14} || true == ERROR: invalid concatenation of jsonb objects +-- 3.14 || {"a":3.14} == ERROR: invalid concatenation of jsonb objects +-- {"a":3.14} || [true] == [{"a":3.14},true] +-- [false] || {"a":3.14} == [false,{"a":3.14}] +-- @ +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example +-- ----+-------+-----------------------------------------------------+-------------------------------------------- +-- || | jsonb | Concatenate two jsonb values into a new jsonb value | '["a", "b"]'::jsonb || '["c", "d"]'::jsonb +-- @ +-- +-- /Note: The @||@ operator concatenates the elements at the top level of/ +-- /each of its operands. It does not operate recursively./ +-- +-- /For example, if both operands are objects with a common key field name,/ +-- /the value of the field in the result will just be the value from the right/ +-- /hand operand./ +-- +-- @since 3.1.0 +(||.) :: JSONBExpr a -> JSONBExpr b -> JSONBExpr c +(||.) = unsafeSqlBinOp " || " + +-- | /Requires PostgreSQL version >= 9.5/ +-- +-- This operator can remove a key from an object or a string element from an array +-- when using text, and remove certain elements by index from an array when using +-- integers. +-- +-- Negative integers delete counting from the end of the array. +-- (e.g. @-1@ being the last element, @-2@ being the second to last, etc.) +-- +-- __CAUTION: THIS FUNCTION THROWS AN EXCEPTION WHEN USED ON ANYTHING OTHER__ +-- __THAN OBJECTS OR ARRAYS WHEN USING TEXT, AND ANYTHING OTHER THAN ARRAYS__ +-- __WHEN USING INTEGERS!__ +-- +-- === __Objects and arrays__ +-- +-- @ +-- {"a": 3.14} - "a" == {} +-- {"a": "b"} - "b" == {"a": "b"} +-- {"a": 3.14} - "a" == {} +-- {"a": 3.14, "c": true} - "a" == {"c": true} +-- ["a", 2, "c"] - "a" == [2, "c"] -- can remove strings from arrays +-- [true, "b", 5] - 0 == ["b", 5] +-- [true, "b", 5] - 3 == [true, "b", 5] +-- [true, "b", 5] - -1 == [true, "b"] +-- [true, "b", 5] - -4 == [true, "b", 5] +-- [] - 1 == [] +-- {"1": true} - 1 == ERROR: cannot delete from object using integer index +-- 1 - \ == ERROR: cannot delete from scalar +-- "a" - \ == ERROR: cannot delete from scalar +-- true - \ == ERROR: cannot delete from scalar +-- null - \ == ERROR: cannot delete from scalar +-- @ +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example +-- ---+---------+------------------------------------------------------------------------+------------------------------------------------- +-- - | text | Delete key/value pair or string element from left operand. | '{"a": "b"}'::jsonb - 'a' +-- | | Key/value pairs are matched based on their key value. | +-- - | integer | Delete the array element with specified index (Negative integers count | '["a", "b"]'::jsonb - 1 +-- | | from the end). Throws an error if top level container is not an array. | +-- @ +-- +-- @since 3.1.0 +(-.) :: JSONBExpr a -> JSONAccessor -> JSONBExpr b +(-.) value (JSONKey txt) = unsafeSqlBinOp " - " value $ val txt +(-.) value (JSONIndex i) = unsafeSqlBinOp " - " value $ val i + +-- | /Requires PostgreSQL version >= 10/ +-- +-- Removes a set of keys from an object, or string elements from an array. +-- +-- This is the same operator internally as `-.`, but the option to use a @text +-- array@, instead of @text@ or @integer@ was only added in version 10. +-- That's why this function is seperate from `-.` +-- +-- NOTE: The following is equivalent: +-- +-- @{some JSON expression} -. "a" -. "b"@ +-- +-- is equivalent to +-- +-- @{some JSON expression} --. ["a","b"]@ +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example +-- ---+---------+------------------------------------------------------------------------+------------------------------------------------- +-- - | text[] | Delete multiple key/value pairs or string elements from left operand. | '{"a": "b", "c": "d"}'::jsonb - '{a,c}'::text[] +-- | | Key/value pairs are matched based on their key value. | +-- @ +-- +-- @since 3.1.0 +(--.) :: JSONBExpr a -> [Text] -> JSONBExpr b +(--.) value = unsafeSqlBinOp " - " value . mkTextArray + +-- | /Requires PostgreSQL version >= 9.5/ +-- +-- This operator can remove elements nested in an object. +-- +-- If a 'Text' is not parsable as a number when selecting in an array +-- (even when halfway through the selection) an exception will be thrown. +-- +-- Negative integers delete counting from the end of an array. +-- (e.g. @-1@ being the last element, @-2@ being the second to last, etc.) +-- +-- __CAUTION: THIS FUNCTION THROWS AN EXCEPTION WHEN USED__ +-- __ON ANYTHING OTHER THAN OBJECTS OR ARRAYS, AND WILL__ +-- __ALSO THROW WHEN TRYING TO SELECT AN ARRAY ELEMENT WITH__ +-- __A NON-INTEGER TEXT__ +-- +-- === __Objects__ +-- +-- @ +-- {"a": 3.14, "b": null} #- [] == {"a": 3.14, "b": null} +-- {"a": 3.14, "b": null} #- ["a"] == {"b": null} +-- {"a": 3.14, "b": null} #- ["a","b"] == {"a": 3.14, "b": null} +-- {"a": {"b":false}, "b": null} #- ["a","b"] == {"a": {}, "b": null} +-- @ +-- +-- === __Arrays__ +-- +-- @ +-- [true, {"b":null}, 5] #- [] == [true, {"b":null}, 5] +-- [true, {"b":null}, 5] #- ["0"] == [{"b":null}, 5] +-- [true, {"b":null}, 5] #- ["b"] == ERROR: path element at position 1 is not an integer: "b" +-- [true, {"b":null}, 5] #- ["1","b"] == [true, {}, 5] +-- [true, {"b":null}, 5] #- ["-2","b"] == [true, {}, 5] +-- {"a": {"b":[false,4,null]}} #- ["a","b","2"] == {"a": {"b":[false,4]}} +-- {"a": {"b":[false,4,null]}} #- ["a","b","c"] == ERROR: path element at position 3 is not an integer: "c" +-- @ +-- +-- === __Other values__ +-- +-- @ +-- 1 \#- {anything} == ERROR: cannot delete from scalar +-- "a" \#- {anything} == ERROR: cannot delete from scalar +-- true \#- {anything} == ERROR: cannot delete from scalar +-- null \#- {anything} == ERROR: cannot delete from scalar +-- @ +-- +-- === __PostgreSQL Documentation__ +-- +-- @ +-- | Type | Description | Example +-- ----+--------+---------------------------------------------------------+------------------------------------ +-- \#- | text[] | Delete the field or element with specified path | '["a", {"b":1}]'::jsonb \#- '{1,b}' +-- | | (for JSON arrays, negative integers count from the end) | +-- @ +-- +-- @since 3.1.0 +(#-.) :: JSONBExpr a -> [Text] -> JSONBExpr b +(#-.) value = unsafeSqlBinOp " #- " value . mkTextArray + +mkTextArray :: [Text] -> SqlExpr (Value PersistValue) +mkTextArray = val . PersistArray . fmap toPersistValue diff --git a/src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs b/src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs new file mode 100644 index 0000000..ae92b40 --- /dev/null +++ b/src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +module Database.Esqueleto.PostgreSQL.JSON.Instances where + +import Data.Aeson (FromJSON(..), ToJSON(..), encode, eitherDecodeStrict) +import Data.Bifunctor (first) +import qualified Data.ByteString.Lazy as BSL (toStrict) +import Data.String (IsString(..)) +import Data.Text (Text) +import qualified Data.Text as T (concat, pack) +import qualified Data.Text.Encoding as TE (decodeUtf8, encodeUtf8) +import Database.Esqueleto (Value, just, val) +import Database.Esqueleto.Internal.PersistentImport +import Database.Esqueleto.Internal.Sql (SqlExpr) +import GHC.Generics (Generic) + + +-- | Newtype wrapper around any type with a JSON representation. +-- +-- @since 3.1.0 +newtype JSONB a = JSONB { unJSONB :: a } + deriving + ( Generic + , FromJSON + , ToJSON + , Eq + , Foldable + , Functor + , Ord + , Read + , Show + , Traversable + ) + +-- | 'SqlExpr' of a NULL-able 'JSONB' value. Hence the 'Maybe'. +-- +-- Note: NULL here is a PostgreSQL NULL, not a JSON 'null' +type JSONBExpr a = SqlExpr (Value (Maybe (JSONB a))) + +-- | Convenience function to lift a regular value into +-- a 'JSONB' expression. +jsonbVal :: (FromJSON a, ToJSON a) => a -> JSONBExpr a +jsonbVal = just . val . JSONB + +-- | Used with certain JSON operators. +-- +-- This data type has 'Num' and 'IsString' instances +-- for ease of use by using integer and string literals. +-- +-- >>> 3 :: JSONAccessor +-- JSONIndex 3 +-- >>> -3 :: JSONAccessor +-- JSONIndex -3 +-- +-- >>> "name" :: JSONAccessor +-- JSONKey "name" +-- +-- NOTE: DO NOT USE ANY OF THE 'Num' METHODS ON THIS TYPE! +data JSONAccessor = JSONIndex Int + | JSONKey Text + deriving (Generic, Eq, Show) + +-- | I repeat, DO NOT use any method other than 'fromInteger'! +instance Num JSONAccessor where + fromInteger = JSONIndex . fromInteger + negate (JSONIndex i) = JSONIndex $ negate i + negate (JSONKey _) = error "Can not negate a JSONKey" + (+) = numErr + (-) = numErr + (*) = numErr + abs = numErr + signum = numErr + +numErr :: a +numErr = error "Do not use 'Num' methods on JSONAccessors" + +instance IsString JSONAccessor where + fromString = JSONKey . T.pack + +-- | @since 3.1.0 +instance (FromJSON a, ToJSON a) => PersistField (JSONB a) where + toPersistValue = PersistDbSpecific . BSL.toStrict . encode . unJSONB + fromPersistValue pVal = fmap JSONB $ case pVal of + PersistByteString bs -> first (badParse $ TE.decodeUtf8 bs) $ eitherDecodeStrict bs + PersistText t -> first (badParse t) $ eitherDecodeStrict (TE.encodeUtf8 t) + x -> Left $ fromPersistValueError "string or bytea" x + +-- | jsonb +-- +-- @since 3.1.0 +instance (FromJSON a, ToJSON a) => PersistFieldSql (JSONB a) where + sqlType _ = SqlOther "JSONB" + +badParse :: Text -> String -> Text +badParse t = fromPersistValueParseError t . T.pack + +fromPersistValueError + :: Text -- ^ Database type(s), should appear different from Haskell name, e.g. "integer" or "INT", not "Int". + -> PersistValue -- ^ Incorrect value + -> Text -- ^ Error message +fromPersistValueError databaseType received = T.concat + [ "Failed to parse Haskell newtype `JSONB a`; " + , "expected ", databaseType + , " from database, but received: ", T.pack (show received) + , ". Potential solution: Check that your database schema matches your Persistent model definitions." + ] + +fromPersistValueParseError + :: Text -- ^ Received value + -> Text -- ^ Additional error + -> Text -- ^ Error message +fromPersistValueParseError received err = T.concat + [ "Failed to parse Haskell type `JSONB a`, " + , "but received ", received + , " | with error: ", err + ] diff --git a/stack-8.2.yaml b/stack-8.2.yaml index 0351cb8..d2e6d69 100644 --- a/stack-8.2.yaml +++ b/stack-8.2.yaml @@ -5,10 +5,22 @@ packages: # - examples extra-deps: -- persistent-2.8.1 -- persistent-mysql-2.8.1 -- persistent-postgresql-2.8.1 -- persistent-sqlite-2.8.1 +- aeson-1.4.1.0 +- aeson-compat-0.3.8 +- attoparsec-0.13.2.2 +- case-insensitive-1.2.0.11 - conduit-1.3.0 - conduit-extra-1.3.0 +- hashable-1.2.7.0 +- monad-logger-0.3.28.1 +- persistent-2.10.0 +- persistent-mysql-2.10.0 +- persistent-postgresql-2.10.0 +- persistent-sqlite-2.10.0 +- persistent-template-2.7.0 +- postgresql-libpq-0.9.4.2 +- postgresql-simple-0.6.1 - resourcet-1.2.0 +- scientific-0.3.6.2 +- text-1.2.3.0 +- unliftio-0.2.0.0 diff --git a/stack-8.4.yaml b/stack-8.4.yaml index 05e9eae..b700aeb 100644 --- a/stack-8.4.yaml +++ b/stack-8.4.yaml @@ -4,6 +4,13 @@ packages: - '.' extra-deps: -- persistent-postgresql-2.8.2.0 -- postgresql-simple-0.5.4.0 +- aeson-1.4.1.0 +- persistent-2.10.0 +- persistent-postgresql-2.10.0 +- persistent-sqlite-2.10.0 +- persistent-mysql-2.10.0 +- persistent-template-2.7.0 +- postgresql-libpq-0.9.4.2 +- postgresql-simple-0.6.1 +- transformers-0.5.5.2 allow-newer: true diff --git a/test/Common/Test.hs b/test/Common/Test.hs index a69f534..1770a6b 100644 --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -51,6 +51,7 @@ module Common.Test ) where import Control.Monad (forM_, replicateM, replicateM_, void) +import Control.Monad.Catch (MonadCatch) #if __GLASGOW_HASKELL__ >= 806 import Control.Monad.Fail (MonadFail) #endif @@ -66,7 +67,6 @@ import UnliftIO import Data.Conduit (ConduitT, (.|), runConduit) import qualified Data.Conduit.List as CL -import Control.Monad.Trans.Resource (MonadThrow) import qualified Data.List as L import qualified Data.Set as S import qualified Data.Text.Lazy.Builder as TLB @@ -1428,7 +1428,7 @@ insert' v = flip Entity v <$> insert v type RunDbMonad m = ( MonadUnliftIO m , MonadIO m , MonadLogger m - , MonadThrow m ) + , MonadCatch m ) #if __GLASGOW_HASKELL__ >= 806 type Run = forall a. (forall m. (RunDbMonad m, MonadFail m) => SqlPersistT (R.ResourceT m) a) -> IO a diff --git a/test/PostgreSQL/MigrateJSON.hs b/test/PostgreSQL/MigrateJSON.hs new file mode 100644 index 0000000..447de65 --- /dev/null +++ b/test/PostgreSQL/MigrateJSON.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE FlexibleContexts + , GADTs + , GeneralizedNewtypeDeriving + , MultiParamTypeClasses + , OverloadedStrings + , QuasiQuotes + , RankNTypes + , ScopedTypeVariables + , TemplateHaskell + , TypeFamilies + , UndecidableInstances + #-} +module PostgreSQL.MigrateJSON where + +import Control.Monad.Trans.Resource (ResourceT) +import Data.Aeson (Value) +import Database.Esqueleto (SqlExpr, delete, from) +import Database.Esqueleto.PostgreSQL.JSON (JSONB) +import Database.Persist (Entity) +import Database.Persist.Sql (SqlPersistT) +import Database.Persist.TH + +import Common.Test (RunDbMonad) + +-- JSON Table for PostgreSQL +share [mkPersist sqlSettings, mkMigrate "migrateJSON"] [persistUpperCase| +Json + value (JSONB Value) +|] + +cleanJSON + :: (forall m. RunDbMonad m + => SqlPersistT (ResourceT m) ()) +cleanJSON = delete $ from $ \(_ :: SqlExpr (Entity Json)) -> return () diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs index 27510bf..77fb3d6 100644 --- a/test/PostgreSQL/Test.hs +++ b/test/PostgreSQL/Test.hs @@ -1,34 +1,44 @@ {-# OPTIONS_GHC -fno-warn-unused-binds #-} -{-# LANGUAGE ScopedTypeVariables - , FlexibleContexts - , RankNTypes - , TypeFamilies - , OverloadedStrings +{-# LANGUAGE FlexibleContexts , LambdaCase + , NamedFieldPuns + , OverloadedStrings + , RankNTypes + , ScopedTypeVariables + , TypeApplications + , TypeFamilies #-} module Main (main) where import Control.Arrow ((&&&)) -import Control.Monad (void) +import Control.Monad (void, when) +import Control.Monad.Catch (MonadCatch, catch) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT) import Control.Monad.Trans.Reader (ReaderT, ask) import qualified Control.Monad.Trans.Resource as R +import Data.Aeson hiding (Value) +import qualified Data.Aeson as A (Value) +import Data.ByteString (ByteString) import qualified Data.Char as Char import qualified Data.List as L import Data.Ord (comparing) import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import Data.Time.Clock (getCurrentTime, diffUTCTime) import Database.Esqueleto hiding (random_) import qualified Database.Esqueleto.Internal.Sql as ES import Database.Esqueleto.PostgreSQL (random_) -import qualified Database.Esqueleto.PostgreSQL as EP +import qualified Database.Esqueleto.PostgreSQL as EP +import Database.Esqueleto.PostgreSQL.JSON hiding ((?.), (-.), (||.)) +import qualified Database.Esqueleto.PostgreSQL.JSON as JSON import Database.Persist.Postgresql (withPostgresqlConn) +import Database.PostgreSQL.Simple (SqlError(..)) import System.Environment import Test.Hspec import Common.Test - +import PostgreSQL.MigrateJSON @@ -499,6 +509,495 @@ testPostgresModule = do liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< halfSecond) +--------------- JSON --------------- JSON --------------- JSON --------------- +--------------- JSON --------------- JSON --------------- JSON --------------- +--------------- JSON --------------- JSON --------------- JSON --------------- + +testJSONInsertions :: Spec +testJSONInsertions = + describe "JSON Insertions" $ do + it "adds scalar values" $ do + run $ do + insertIt Null + insertIt $ Bool True + insertIt $ Number 1 + insertIt $ String "test" + it "adds arrays" $ do + run $ do + insertIt $ toJSON ([] :: [A.Value]) + insertIt $ toJSON [Number 1, Bool True, Null] + insertIt $ toJSON [String "test",object ["a" .= Number 3.14], Null, Bool True] + it "adds objects" $ do + run $ do + insertIt $ object ["a" .= (1 :: Int), "b" .= False] + insertIt $ object ["a" .= object ["b" .= object ["c" .= String "message"]]] + where insertIt :: MonadIO m => A.Value -> SqlPersistT m () + insertIt = insert_ . Json . JSONB + + +testJSONOperators :: Spec +testJSONOperators = + describe "JSON Operators" $ do + testArrowOperators + testFilterOperators + testConcatDeleteOperators + +testArrowOperators :: Spec +testArrowOperators = + describe "Arrow Operators" $ do + testArrowJSONB + testArrowText + testHashArrowJSONB + testHashArrowText + +testArrowJSONB :: Spec +testArrowJSONB = + describe "Single Arrow (JSONB)" $ do + it "creates sane SQL" $ + createSaneSQL @JSONValue + (jsonbVal (object ["a" .= True]) ->. "a") + "SELECT (? -> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":true}" + , PersistText "a" ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [1 :: Int,2,3]] + createSaneSQL @JSONValue + (jsonbVal obj ->. "a" ->. 1) + "SELECT ((? -> ?) -> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[1,2,3]}" + , PersistText "a" + , PersistInt64 1 ] + it "works as expected" $ run $ do + x <- selectJSONwhere $ \v -> v ->. "b" ==. jsonbVal (Bool False) + y <- selectJSONwhere $ \v -> v ->. 1 ==. jsonbVal (Bool True) + z <- selectJSONwhere $ \v -> v ->. "a" ->. "b" ->. "c" ==. jsonbVal (String "message") + liftIO $ length x `shouldBe` 1 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 1 + +testArrowText :: Spec +testArrowText = + describe "Single Arrow (Text)" $ do + it "creates sane SQL" $ + createSaneSQL + (jsonbVal (object ["a" .= True]) ->>. "a") + "SELECT (? ->> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":true}" + , PersistText "a" ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [1 :: Int,2,3]] + createSaneSQL + (jsonbVal obj ->. "a" ->>. 1) + "SELECT ((? -> ?) ->> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[1,2,3]}" + , PersistText "a" + , PersistInt64 1 ] + it "works as expected" $ run $ do + x <- selectJSONwhere $ \v -> v ->>. "b" ==. just (val "false") + y <- selectJSONwhere $ \v -> v ->>. 1 ==. just (val "true") + z <- selectJSONwhere $ \v -> v ->. "a" ->. "b" ->>. "c" ==. just (val "message") + liftIO $ length x `shouldBe` 1 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 1 + +testHashArrowJSONB :: Spec +testHashArrowJSONB = + describe "Double Arrow (JSONB)" $ do + it "creates sane SQL" $ do + let list = ["a","b","c"] + createSaneSQL @JSONValue + (jsonbVal (object ["a" .= True]) #>. list) + "SELECT (? #> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":true}" + , persistTextArray list ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL @JSONValue + (jsonbVal obj #>. ["a","1"] #>. ["b"]) + "SELECT ((? #> ?) #> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , persistTextArray ["a","1"] + , persistTextArray ["b"] ] + it "works as expected" $ run $ do + x <- selectJSONwhere $ \v -> v #>. ["a","b","c"] ==. jsonbVal (String "message") + y <- selectJSONwhere $ \v -> v #>. ["1","a"] ==. jsonbVal (Number 3.14) + z <- selectJSONwhere $ \v -> v #>. ["1"] #>. ["a"] ==. jsonbVal (Number 3.14) + liftIO $ length x `shouldBe` 1 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 1 + +testHashArrowText :: Spec +testHashArrowText = + describe "Double Arrow (Text)" $ do + it "creates sane SQL" $ do + let list = ["a","b","c"] + createSaneSQL + (jsonbVal (object ["a" .= True]) #>>. list) + "SELECT (? #>> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":true}" + , persistTextArray list ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL + (jsonbVal obj #>. ["a","1"] #>>. ["b"]) + "SELECT ((? #> ?) #>> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , persistTextArray ["a","1"] + , persistTextArray ["b"] ] + it "works as expected" $ run $ do + x <- selectJSONwhere $ \v -> v #>>. ["a","b","c"] ==. just (val "message") + y <- selectJSONwhere $ \v -> v #>>. ["1","a"] ==. just (val "3.14") + z <- selectJSONwhere $ \v -> v #>. ["1"] #>>. ["a"] ==. just (val "3.14") + liftIO $ length x `shouldBe` 1 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 1 + + +testFilterOperators :: Spec +testFilterOperators = + describe "Filter Operators" $ do + testInclusion + testQMark + testQMarkAny + testQMarkAll + +testInclusion :: Spec +testInclusion = do + describe "@>" $ do + it "creates sane SQL" $ + createSaneSQL + (jsonbVal (object ["a" .= False, "b" .= True]) @>. jsonbVal (object ["a" .= False])) + "SELECT (? @> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":false,\"b\":true}" + , PersistDbSpecific "{\"a\":false}" ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL + (jsonbVal obj ->. "a" @>. jsonbVal (object ["b" .= True])) + "SELECT ((? -> ?) @> ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , PersistText "a" + , PersistDbSpecific "{\"b\":true}" ] + it "works as expected" $ run $ do + x <- selectJSONwhere $ \v -> v @>. jsonbVal (Number 1) + y <- selectJSONwhere $ \v -> v @>. jsonbVal (toJSON [object ["a" .= Number 3.14]]) + z <- selectJSONwhere $ \v -> v ->. 1 @>. jsonbVal (object ["a" .= Number 3.14]) + liftIO $ length x `shouldBe` 2 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 1 + describe "<@" $ do + it "creates sane SQL" $ + createSaneSQL + (jsonbVal (object ["a" .= False]) <@. jsonbVal (object ["a" .= False, "b" .= True])) + "SELECT (? <@ ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":false}" + , PersistDbSpecific "{\"a\":false,\"b\":true}" ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL + (jsonbVal obj ->. "a" <@. jsonbVal (object ["b" .= True, "c" .= Null])) + "SELECT ((? -> ?) <@ ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , PersistText "a" + , PersistDbSpecific "{\"b\":true,\"c\":null}" ] + it "works as expected" $ run $ do + x <- selectJSONwhere $ \v -> v <@. jsonbVal (toJSON [Number 1]) + y <- selectJSONwhere $ \v -> v <@. jsonbVal (object ["a" .= (1 :: Int), "b" .= False, "c" .= Null]) + z <- selectJSONwhere $ \v -> v #>. ["a","b"] <@. jsonbVal (object ["b" .= False, "c" .= String "message"]) + liftIO $ length x `shouldBe` 2 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 1 + +testQMark :: Spec +testQMark = + describe "Question Mark" $ do + it "creates sane SQL" $ + createSaneSQL + (jsonbVal (object ["a" .= False, "b" .= True]) JSON.?. "a") + "SELECT (? ?? ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":false,\"b\":true}" + , PersistText "a" ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL + (jsonbVal obj #>. ["a","0"] JSON.?. "b") + "SELECT ((? #> ?) ?? ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , persistTextArray ["a","0"] + , PersistText "b" ] + it "works as expected" $ run $ do + x <- selectJSONwhere (JSON.?. "a") + y <- selectJSONwhere (JSON.?. "test") + z <- selectJSONwhere $ \v -> v ->. "a" JSON.?. "b" + liftIO $ length x `shouldBe` 2 + liftIO $ length y `shouldBe` 2 + liftIO $ length z `shouldBe` 1 + +testQMarkAny :: Spec +testQMarkAny = + describe "Question Mark (Any)" $ do + it "creates sane SQL" $ + createSaneSQL + (jsonbVal (object ["a" .= False, "b" .= True]) ?|. ["a","c"]) + "SELECT (? ??| ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":false,\"b\":true}" + , persistTextArray ["a","c"] ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL + (jsonbVal obj #>. ["a","0"] ?|. ["b","c"]) + "SELECT ((? #> ?) ??| ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , persistTextArray ["a","0"] + , persistTextArray ["b","c"] ] + it "works as expected" $ run $ do + x <- selectJSONwhere (?|. ["b","test"]) + y <- selectJSONwhere (?|. ["a"]) + z <- selectJSONwhere $ \v -> v ->. (-3) ?|. ["a"] + w <- selectJSONwhere (?|. []) + liftIO $ length x `shouldBe` 3 + liftIO $ length y `shouldBe` 2 + liftIO $ length z `shouldBe` 1 + liftIO $ length w `shouldBe` 0 + +testQMarkAll :: Spec +testQMarkAll = + describe "Question Mark (All)" $ do + it "creates sane SQL" $ + createSaneSQL + (jsonbVal (object ["a" .= False, "b" .= True]) ?&. ["a","c"]) + "SELECT (? ??& ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":false,\"b\":true}" + , persistTextArray ["a","c"] ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL + (jsonbVal obj #>. ["a","0"] ?&. ["b","c"]) + "SELECT ((? #> ?) ??& ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , persistTextArray ["a","0"] + , persistTextArray ["b","c"] ] + it "works as expected" $ run $ do + x <- selectJSONwhere (?&. ["test"]) + y <- selectJSONwhere (?&. ["a","b"]) + z <- selectJSONwhere $ \v -> v ->. "a" ?&. ["b"] + w <- selectJSONwhere (?&. []) + liftIO $ length x `shouldBe` 2 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 1 + liftIO $ length w `shouldBe` 9 + + +testConcatDeleteOperators :: Spec +testConcatDeleteOperators = do + describe "Concatenation Operator" testConcatenationOperator + describe "Deletion Operators" $ do + testMinusOperator + testMinusOperatorV10 + testHashMinusOperator + +testConcatenationOperator :: Spec +testConcatenationOperator = + describe "Concatenation" $ do + it "creates sane SQL" $ + createSaneSQL @JSONValue + (jsonbVal (object ["a" .= False, "b" .= True]) + JSON.||. jsonbVal (object ["c" .= Null])) + "SELECT (? || ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":false,\"b\":true}" + , PersistDbSpecific "{\"c\":null}" ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL @JSONValue + (jsonbVal obj ->. "a" JSON.||. jsonbVal (toJSON [Null])) + "SELECT ((? -> ?) || ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , PersistText "a" + , PersistDbSpecific "[null]" ] + it "works as expected" $ run $ do + x <- selectJSON $ \v -> do + where_ $ v @>. jsonbVal (object []) + where_ $ v JSON.||. jsonbVal (object ["x" .= True]) + @>. jsonbVal (object ["x" .= True]) + y <- selectJSONwhere $ \v -> + v JSON.||. jsonbVal (toJSON [String "a", String "b"]) + ->>. 4 ==. just (val "b") + z <- selectJSONwhere $ \v -> + v JSON.||. jsonbVal (toJSON [Bool False]) + ->. 0 JSON.@>. jsonbVal (Number 1) + w <- selectJSON $ \v -> do + where_ . not_ $ v @>. jsonbVal (object []) + where_ $ jsonbVal (String "test1") JSON.||. v ->>. 0 ==. just (val "test1") + liftIO $ length x `shouldBe` 2 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 2 + liftIO $ length w `shouldBe` 7 + sqlFailWith "22023" $ selectJSONwhere $ \v -> + v JSON.||. jsonbVal (toJSON $ String "test") + @>. jsonbVal (String "test") + +testMinusOperator :: Spec +testMinusOperator = + describe "Minus Operator" $ do + it "creates sane SQL" $ + createSaneSQL @JSONValue + (jsonbVal (object ["a" .= False, "b" .= True]) JSON.-. "a") + "SELECT (? - ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":false,\"b\":true}" + , PersistText "a" ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL @JSONValue + (jsonbVal obj ->. "a" JSON.-. 0) + "SELECT ((? -> ?) - ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , PersistText "a" + , PersistInt64 0 ] + it "works as expected" $ run $ do + x <- selectJSON $ \v -> do + where_ $ v @>. jsonbVal (toJSON ([] :: [Int])) + where_ $ v JSON.-. 0 @>. jsonbVal (toJSON [Bool True]) + y <- selectJSON $ \v -> do + where_ $ v @>. jsonbVal (toJSON ([] :: [Int])) + where_ $ v JSON.-. (-1) @>. jsonbVal (toJSON [Null]) + z <- selectJSON_ $ \v -> v JSON.-. "b" ?&. ["a", "b"] + w <- selectJSON_ $ \v -> do + v JSON.-. "test" @>. jsonbVal (toJSON [String "test"]) + liftIO $ length x `shouldBe` 2 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 0 + liftIO $ length w `shouldBe` 0 + sqlFailWith "22023" $ selectJSONwhere $ \v -> + v JSON.-. 0 @>. jsonbVal (toJSON ([] :: [Int])) + where selectJSON_ f = selectJSON $ \v -> do + where_ $ v @>. jsonbVal (object []) + ||. v @>. jsonbVal (toJSON ([] :: [Int])) + where_ $ f v + +testMinusOperatorV10 :: Spec +testMinusOperatorV10 = + describe "Minus Operator (PSQL >= v10)" $ do + it "creates sane SQL" $ + createSaneSQL @JSONValue + (jsonbVal (object ["a" .= False, "b" .= True]) --. ["a","b"]) + "SELECT (? - ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":false,\"b\":true}" + , persistTextArray ["a","b"] ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL @JSONValue + (jsonbVal obj #>. ["a","0"] --. ["b"]) + "SELECT ((? #> ?) - ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , persistTextArray ["a","0"] + , persistTextArray ["b"] ] + it "works as expected" $ run $ do + x <- selectJSON $ \v -> do + where_ $ v @>. jsonbVal (toJSON ([] :: [Int])) + where_ $ v --. ["test","a"] @>. jsonbVal (toJSON [String "test"]) + y <- selectJSON $ \v -> do + where_ $ v @>. jsonbVal (object []) + where_ $ v --. ["a","b"] <@. jsonbVal (object []) + z <- selectJSON_ $ \v -> v --. ["b"] <@. jsonbVal (object ["a" .= (1 :: Int)]) + w <- selectJSON_ $ \v -> do + v --. ["test"] @>. jsonbVal (toJSON [String "test"]) + liftIO $ length x `shouldBe` 0 + liftIO $ length y `shouldBe` 2 + liftIO $ length z `shouldBe` 1 + liftIO $ length w `shouldBe` 0 + sqlFailWith "22023" $ selectJSONwhere $ \v -> + v --. ["a"] @>. jsonbVal (toJSON ([] :: [Int])) + where selectJSON_ f = selectJSON $ \v -> do + where_ $ v @>. jsonbVal (object []) + ||. v @>. jsonbVal (toJSON ([] :: [Int])) + where_ $ f v + +testHashMinusOperator :: Spec +testHashMinusOperator = + describe "Hash-Minus Operator" $ do + it "creates sane SQL" $ + createSaneSQL @JSONValue + (jsonbVal (object ["a" .= False, "b" .= True]) #-. ["a"]) + "SELECT (? #- ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":false,\"b\":true}" + , persistTextArray ["a"] ] + it "creates sane SQL (chained)" $ do + let obj = object ["a" .= [object ["b" .= True]]] + createSaneSQL @JSONValue + (jsonbVal obj ->. "a" #-. ["0","b"]) + "SELECT ((? -> ?) #- ?)\nFROM \"Json\"\n" + [ PersistDbSpecific "{\"a\":[{\"b\":true}]}" + , PersistText "a" + , persistTextArray ["0","b"] ] + it "works as expected" $ run $ do + x <- selectJSON $ \v -> do + where_ $ v @>. jsonbVal (toJSON ([] :: [Int])) + where_ $ v #-. ["1","a"] @>. jsonbVal (toJSON [object []]) + y <- selectJSON $ \v -> do + where_ $ v @>. jsonbVal (toJSON ([] :: [Int])) + where_ $ v #-. ["-3","a"] @>. jsonbVal (toJSON [object []]) + z <- selectJSON_ $ \v -> v #-. ["a","b","c"] + @>. jsonbVal (object ["a" .= object ["b" .= object ["c" .= String "message"]]]) + w <- selectJSON_ $ \v -> v #-. ["a","b"] JSON.?. "b" + liftIO $ length x `shouldBe` 1 + liftIO $ length y `shouldBe` 1 + liftIO $ length z `shouldBe` 0 + liftIO $ length w `shouldBe` 1 + sqlFailWith "22023" $ selectJSONwhere $ \v -> + v #-. ["0"] @>. jsonbVal (toJSON ([] :: [Int])) + where selectJSON_ f = selectJSON $ \v -> do + where_ $ v @>. jsonbVal (object []) + where_ $ f v + + +type JSONValue = Maybe (JSONB A.Value) + +createSaneSQL :: (PersistField a) => SqlExpr (Value a) -> T.Text -> [PersistValue] -> IO () +createSaneSQL act q vals = run $ do + (query, args) <- showQuery ES.SELECT $ fromValue act + liftIO $ query `shouldBe` q + liftIO $ args `shouldBe` vals + +fromValue :: (PersistField a) => SqlExpr (Value a) -> SqlQuery (SqlExpr (Value a)) +fromValue act = from $ \x -> do + let _ = x :: SqlExpr (Entity Json) + return act + +persistTextArray :: [T.Text] -> PersistValue +persistTextArray = PersistArray . fmap PersistText + +sqlFailWith :: (MonadCatch m, MonadIO m) => ByteString -> SqlPersistT (R.ResourceT m) a -> SqlPersistT (R.ResourceT m) () +sqlFailWith errState f = do + p <- (f >> return True) `catch` success + when p failed + where success SqlError{sqlState} + | sqlState == errState = return False + | otherwise = do + liftIO $ expectationFailure $ T.unpack $ T.concat + [ "should fail with: ", errStateT + , ", but received: ", TE.decodeUtf8 sqlState + ] + return False + failed = liftIO $ expectationFailure $ "should fail with: " `mappend` T.unpack errStateT + errStateT = TE.decodeUtf8 errState + +selectJSONwhere + :: MonadIO m + => (JSONBExpr A.Value -> SqlExpr (Value Bool)) + -> SqlPersistT m [Entity Json] +selectJSONwhere f = selectJSON $ where_ . f + +selectJSON + :: MonadIO m + => (JSONBExpr A.Value -> SqlQuery ()) + -> SqlPersistT m [Entity Json] +selectJSON f = select $ from $ \v -> do + f $ just (v ^. JsonValue) + return v + +--------------- JSON --------------- JSON --------------- JSON --------------- +--------------- JSON --------------- JSON --------------- JSON --------------- +--------------- JSON --------------- JSON --------------- JSON --------------- @@ -522,9 +1021,14 @@ main = do testPostgresqlUpdate testPostgresqlCoalesce testPostgresqlTextFunctions - - - + describe "PostgreSQL JSON tests" $ do + -- NOTE: We only clean the table once, so we + -- can use its contents across all JSON tests + it "MIGRATE AND CLEAN JSON TABLE" $ run $ do + void $ runMigrationSilent migrateJSON + cleanJSON + testJSONInsertions + testJSONOperators run, runSilent, runVerbose :: Run @@ -543,17 +1047,17 @@ run f = do verbose :: Bool verbose = False +run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a +run_worker act = withConn $ runSqlConn (migrateIt >> act) + migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) () migrateIt = do void $ runMigrationSilent migrateAll cleanDB -run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a -run_worker act = withConn $ runSqlConn (migrateIt >> act) - withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a withConn = - R.runResourceT . withPostgresqlConn "host=localhost port=5432 user=esqutest password=esqutest dbname=esqutest" + R.runResourceT . withPostgresqlConn "host=localhost port=5433 user=esqutest password=esqutest dbname=esqutest" -- | Show the SQL generated by a query showQuery :: (Monad m, ES.SqlSelect a r, BackendCompatible SqlBackend backend) diff --git a/test/expected-compile-failures/src/Lib.hs b/test/expected-compile-failures/src/Lib.hs index 677f7d6..db80dc9 100644 --- a/test/expected-compile-failures/src/Lib.hs +++ b/test/expected-compile-failures/src/Lib.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE UndecidableInstances #-} module Lib where import Control.Monad.IO.Class (MonadIO) +import Database.Persist import Database.Persist.Sql (SqlReadT) import Database.Esqueleto (SqlExpr, SqlQuery, from, val, (<#), insertSelect, (<&>), (^.)) diff --git a/test/expected-compile-failures/stack-8.2.yaml b/test/expected-compile-failures/stack-8.2.yaml index 40f35b2..fa18877 100644 --- a/test/expected-compile-failures/stack-8.2.yaml +++ b/test/expected-compile-failures/stack-8.2.yaml @@ -1,13 +1,25 @@ resolver: lts-10.6 extra-deps: -- persistent-2.8.1 -- persistent-mysql-2.8.1 -- persistent-postgresql-2.8.1 -- persistent-sqlite-2.8.1 +- aeson-1.4.1.0 +- aeson-compat-0.3.8 +- attoparsec-0.13.2.2 +- case-insensitive-1.2.0.11 - conduit-1.3.0 - conduit-extra-1.3.0 +- hashable-1.2.7.0 +- monad-logger-0.3.28.1 +- persistent-2.10.0 +- persistent-mysql-2.10.0 +- persistent-postgresql-2.10.0 +- persistent-sqlite-2.10.0 +- persistent-template-2.7.0 +- postgresql-libpq-0.9.4.2 +- postgresql-simple-0.6.1 - resourcet-1.2.0 +- scientific-0.3.6.2 +- text-1.2.3.0 +- unliftio-0.2.0.0 packages: - . diff --git a/test/expected-compile-failures/stack-8.4.yaml b/test/expected-compile-failures/stack-8.4.yaml index 87439c0..f7e38cd 100644 --- a/test/expected-compile-failures/stack-8.4.yaml +++ b/test/expected-compile-failures/stack-8.4.yaml @@ -3,3 +3,15 @@ resolver: lts-12.24 packages: - . - ../../../esqueleto + +extra-deps: +- aeson-1.4.1.0 +- persistent-2.10.0 +- persistent-mysql-2.10.0 +- persistent-postgresql-2.10.0 +- persistent-sqlite-2.10.0 +- persistent-template-2.7.0 +- postgresql-libpq-0.9.4.2 +- postgresql-simple-0.6.1 +- transformers-0.5.5.2 +allow-newer: true diff --git a/test/expected-compile-failures/stack-8.6.yaml b/test/expected-compile-failures/stack-8.6.yaml index 023cdae..7b06b44 100644 --- a/test/expected-compile-failures/stack-8.6.yaml +++ b/test/expected-compile-failures/stack-8.6.yaml @@ -1,8 +1,12 @@ resolver: nightly-2018-12-18 extra-deps: -- persistent-postgresql-2.8.2.0 -- postgresql-simple-0.5.4.0 +- persistent-2.10.0 +- persistent-mysql-2.10.0 +- persistent-postgresql-2.10.0 +- persistent-sqlite-2.10.0 +- persistent-template-2.7.0 +- postgresql-simple-0.6.1 allow-newer: true diff --git a/test/expected-compile-failures/stack.yaml b/test/expected-compile-failures/stack.yaml index 87439c0..d0d35f1 100644 --- a/test/expected-compile-failures/stack.yaml +++ b/test/expected-compile-failures/stack.yaml @@ -3,3 +3,14 @@ resolver: lts-12.24 packages: - . - ../../../esqueleto + +extra-deps: +- aeson-1.4.1.0 +- persistent-2.10.0 +- persistent-mysql-2.10.0 +- persistent-postgresql-2.10.0 +- persistent-sqlite-2.10.0 +- persistent-template-2.7.0 +- postgresql-libpq-0.9.4.2 +- postgresql-simple-0.6.1 +- transformers-0.5.5.2 diff --git a/test/expected-compile-failures/stack.yaml.lock b/test/expected-compile-failures/stack.yaml.lock new file mode 100644 index 0000000..eb70fac --- /dev/null +++ b/test/expected-compile-failures/stack.yaml.lock @@ -0,0 +1,75 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: aeson-1.4.1.0@sha256:a72639fbf44d5c2d5270fb6d9484629ed332d3029987fafd7580b5204265fb8b,6372 + pantry-tree: + size: 39767 + sha256: 3eee6f6a05e563ebdd45e93348240d79eb20c267e70683360758327745d3249d + original: + hackage: aeson-1.4.1.0 +- completed: + hackage: persistent-2.10.0@sha256:6e4566c2cf8dda6bf3e00f4f813dd711e7796a1598f46c5c729491f4b643c91d,4708 + pantry-tree: + size: 2094 + sha256: 5ae7466479cf300e9bf07dc9780a432b4338c4e1e56fc732399260303cdf2f84 + original: + hackage: persistent-2.10.0 +- completed: + hackage: persistent-mysql-2.10.0@sha256:4bf76721312104b726406d3cac4a30185e9e19898605615ded6cbfe5cdabda6a,2884 + pantry-tree: + size: 460 + sha256: 15737a7f8af7085fa6f83f1c084ff4de4922f28576633aa9aab4a8e668ccc5c3 + original: + hackage: persistent-mysql-2.10.0 +- completed: + hackage: persistent-postgresql-2.10.0@sha256:87384a179e44b57af7b12b00ccfdfc4bc03010a438aad207b9f38def0147cda2,2829 + pantry-tree: + size: 671 + sha256: 5a2b25b40cb440466792b9ae293de95b4fcfcd1410c1c7aed9ffc8001699f5dc + original: + hackage: persistent-postgresql-2.10.0 +- completed: + hackage: persistent-sqlite-2.10.0@sha256:d41ad3e2d9b88ab31bfdcd15e76ad41cd495573937921026b3b13f010ff9b8cf,4664 + pantry-tree: + size: 681 + sha256: 86ad7225024dbe74421b78ab6a6c3e05aeb94d0633cde413f7e91453bee3e7c0 + original: + hackage: persistent-sqlite-2.10.0 +- completed: + hackage: persistent-template-2.7.0@sha256:1855a36c7dbfa1554c1711c1d61c41e83495bcb1986851cf1b3340f44ed269af,2703 + pantry-tree: + size: 560 + sha256: 073f355d9425b1553e8e4f8553bb06e63d185c0e113c75512f969eeb92bcb4db + original: + hackage: persistent-template-2.7.0 +- completed: + hackage: postgresql-libpq-0.9.4.2@sha256:3a3f372cf72706f349104f73d4ea5dee9c3eeac1ff749301110dadb55e2ac66f,2804 + pantry-tree: + size: 549 + sha256: b045b567464d6c86ecc23a3915a6aa81c52cfbaa1c51c7fe9649366185c9ce6b + original: + hackage: postgresql-libpq-0.9.4.2 +- completed: + hackage: postgresql-simple-0.6.1@sha256:316e6424da50ec863c74dcf2d7c86cfe6ee00cb142c07a422eb118577dc1d3b7,5256 + pantry-tree: + size: 4055 + sha256: c22e1f054f3be5eaad5eba5abc793504be85e441ff671bf203013ac8f72f9c79 + original: + hackage: postgresql-simple-0.6.1 +- completed: + hackage: transformers-0.5.5.2@sha256:c6a1dc5261d87de1d7d0876b670ca8782c43ac89e59ec2bafa1e32d25c7d3509,3122 + pantry-tree: + size: 2365 + sha256: 5c38ca49a4b2468b6c61682a722611c8a54699bb94f8d6e0ee9f2c546477f116 + original: + hackage: transformers-0.5.5.2 +snapshots: +- completed: + size: 508835 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/24.yaml + sha256: b0a5564eb448e69b9f6a4f67fe72016d9e7ec24e37de1826e1a9cfd064a1b6a5 + original: lts-12.24