From 0df63e841d970e12af486533a20585873bea03e4 Mon Sep 17 00:00:00 2001 From: Tomasz Rybarczyk Date: Sun, 10 Nov 2019 15:27:24 +0100 Subject: [PATCH] Handle `Argonaut.Json` --- README.md | 4 +++- spago.dhall | 1 + src/Database/PostgreSQL.js | 5 +++++ src/Database/PostgreSQL/Value.purs | 20 ++++++++++++++++-- test/Main.purs | 33 ++++++++++++++++++++++++++---- 5 files changed, 56 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index e45e701..37557fd 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ # purescript-postgresql-client -purescript-postgresql-client is a PostgreSQL client library for PureScript. +## Type conversions / serialization + +purescript-postgresql-client is a PostgreSQL client library for PureScript based on `node-postgres`. ## Install diff --git a/spago.dhall b/spago.dhall index cd9baf4..eb5b7af 100644 --- a/spago.dhall +++ b/spago.dhall @@ -8,6 +8,7 @@ You can edit this file as you like. , dependencies = [ "aff" , "arrays" + , "argonaut" , "assert" , "bifunctors" , "bytestrings" diff --git a/src/Database/PostgreSQL.js b/src/Database/PostgreSQL.js index d538d25..a7826f3 100644 --- a/src/Database/PostgreSQL.js +++ b/src/Database/PostgreSQL.js @@ -3,6 +3,11 @@ 'use strict'; +// `pg related code/bindings are done here as we want to +// allow web related modules to access `PostgreSQL.*` classes. +// Putting this import into `PostgreSQL/Value.js` caused problem +// with web bundlers. + var pg = require('pg'); // pg does strange thing converting DATE diff --git a/src/Database/PostgreSQL/Value.purs b/src/Database/PostgreSQL/Value.purs index 98bc674..6056f12 100644 --- a/src/Database/PostgreSQL/Value.purs +++ b/src/Database/PostgreSQL/Value.purs @@ -1,9 +1,15 @@ module Database.PostgreSQL.Value where +-- | `node-postgres` is playing guessing game regarding type conversions +-- | so we are overriding its defualt behavior for some types - please +-- | check PostgreSQL.js + import Prelude import Control.Monad.Error.Class (throwError) import Control.Monad.Except (ExceptT, except, runExcept, runExceptT) +import Data.Argonaut (Json) +import Data.Argonaut (stringify) as Argonaut import Data.Array (foldl) import Data.Array as Array import Data.Bifunctor (lmap) @@ -93,7 +99,7 @@ else instance fromSQLValueMaybe :: (FromSQLValue a) => FromSQLValue (Maybe a) wh else instance fromSQLValueForeign :: FromSQLValue Foreign where fromSQLValue = pure -else instance fromSQLValueObject ∷ FromSQLValue a ⇒ FromSQLValue (Object a) where +else instance fromSQLValueObject :: FromSQLValue a ⇒ FromSQLValue (Object a) where fromSQLValue sql = lmap showErr $ unwrap $ runExceptT main where showErr ∷ MultipleErrors → String @@ -104,11 +110,15 @@ else instance fromSQLValueObject ∷ FromSQLValue a ⇒ FromSQLValue (Object a) let eso = sequence $ map fromSQLValue objF let emo = lmap (singleton <<< ForeignError) eso except emo + else instance fromSQLValueDecimal :: FromSQLValue Decimal where fromSQLValue v = do s <- lmap show $ runExcept (readString v) note ("Decimal literal parsing failed: " <> s) (Decimal.fromString s) +else instance fromSQLValueJson :: FromSQLValue Json where + fromSQLValue = Right <<< unsafeFromForeign + newtypeFromSQLValue ∷ ∀ a b. Newtype a b ⇒ FromSQLValue b ⇒ Foreign → Either String a newtypeFromSQLValue = map wrap <<< fromSQLValue @@ -162,7 +172,13 @@ else instance toSQLValueObject ∷ ToSQLValue a ⇒ ToSQLValue (Object a) where toSQLValue = unsafeToForeign else instance toSQLValueDecimal :: ToSQLValue Decimal where - toSQLValue = Decimal.toString >>> unsafeToForeign + toSQLValue = Decimal.toString >>> unsafeToForeign + +else instance toSQLValueJson :: ToSQLValue Json where + -- | We are forced to stringify value here to avoid + -- | problems with pg auto conversions - please check for example: + -- | https://github.com/brianc/node-postgres/issues/1383 + toSQLValue = Argonaut.stringify >>> unsafeToForeign newtypeToSQLValue ∷ ∀ a b. Newtype a b ⇒ ToSQLValue b ⇒ a → Foreign newtypeToSQLValue = unwrap >>> toSQLValue diff --git a/test/Main.purs b/test/Main.purs index 3c46c58..f857d4f 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -7,6 +7,8 @@ import Prelude import Control.Monad.Error.Class (throwError, try) import Control.Monad.Except.Trans (runExceptT) import Control.Monad.Trans.Class (lift) +import Data.Argonaut (Json) +import Data.Argonaut (fromArray, fromObject, fromString) as Argonaut import Data.Array (zip) import Data.Date (Date, canonicalDate) import Data.DateTime.Instant (Instant, unInstant) @@ -25,7 +27,8 @@ import Effect (Effect) import Effect.Aff (Aff, error, launchAff) import Effect.Class (liftEffect) import Effect.Exception (message) -import Foreign.Object (Object, fromFoldable) +import Foreign.Object (fromFoldable) as Object +import Foreign.Object (Object) import Global.Unsafe (unsafeStringify) import Math ((%)) import Partial.Unsafe (unsafePartial) @@ -286,9 +289,9 @@ main = do pgEqual 3 (length dates) liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3]) - test conn "handling json and jsonb value" $ do - let jsonIn = fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3] - let expected = fromFoldable [Tuple "a" 2, Tuple "2" 3] + test conn "handling Foreign.Object as json and jsonb" $ do + let jsonIn = Object.fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3] + let expected = Object.fromFoldable [Tuple "a" 2, Tuple "2" 3] execute conn (Query """ INSERT INTO jsons (json, jsonb) @@ -298,6 +301,28 @@ main = do (js ∷ Array (Row2 (Object Int) (Object Int))) <- query conn (Query """SELECT * FROM JSONS""") Row0 liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js + test conn "handling Argonaut.Json as json and jsonb for an object" $ do + let input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ]) + + execute conn (Query """ + INSERT INTO jsons (json, jsonb) + VALUES ($1, $2) + """) (Row2 input input) + + (js ∷ Array (Row2 (Json) (Json))) <- query conn (Query """SELECT * FROM JSONS""") Row0 + liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js + + test conn "handling Argonaut.Json as json and jsonb for an array" $ do + let input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])] + + execute conn (Query """ + INSERT INTO jsons (json, jsonb) + VALUES ($1, $2) + """) (Row2 input input) + + (js ∷ Array (Row2 (Json) (Json))) <- query conn (Query """SELECT * FROM JSONS""") Row0 + liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js + test conn "handling jsdate value" $ do let jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0