Handle Argonaut.Json

This commit is contained in:
Tomasz Rybarczyk 2019-11-10 15:27:24 +01:00
parent 71d55170dc
commit 0df63e841d
5 changed files with 56 additions and 7 deletions

View File

@ -1,6 +1,8 @@
# purescript-postgresql-client # 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 ## Install

View File

@ -8,6 +8,7 @@ You can edit this file as you like.
, dependencies = , dependencies =
[ "aff" [ "aff"
, "arrays" , "arrays"
, "argonaut"
, "assert" , "assert"
, "bifunctors" , "bifunctors"
, "bytestrings" , "bytestrings"

View File

@ -3,6 +3,11 @@
'use strict'; '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'); var pg = require('pg');
// pg does strange thing converting DATE // pg does strange thing converting DATE

View File

@ -1,9 +1,15 @@
module Database.PostgreSQL.Value where 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 Prelude
import Control.Monad.Error.Class (throwError) import Control.Monad.Error.Class (throwError)
import Control.Monad.Except (ExceptT, except, runExcept, runExceptT) 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 (foldl)
import Data.Array as Array import Data.Array as Array
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
@ -93,7 +99,7 @@ else instance fromSQLValueMaybe :: (FromSQLValue a) => FromSQLValue (Maybe a) wh
else instance fromSQLValueForeign :: FromSQLValue Foreign where else instance fromSQLValueForeign :: FromSQLValue Foreign where
fromSQLValue = pure 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 fromSQLValue sql = lmap showErr $ unwrap $ runExceptT main
where where
showErr MultipleErrors String showErr MultipleErrors String
@ -104,11 +110,15 @@ else instance fromSQLValueObject ∷ FromSQLValue a ⇒ FromSQLValue (Object a)
let eso = sequence $ map fromSQLValue objF let eso = sequence $ map fromSQLValue objF
let emo = lmap (singleton <<< ForeignError) eso let emo = lmap (singleton <<< ForeignError) eso
except emo except emo
else instance fromSQLValueDecimal :: FromSQLValue Decimal where else instance fromSQLValueDecimal :: FromSQLValue Decimal where
fromSQLValue v = do fromSQLValue v = do
s <- lmap show $ runExcept (readString v) s <- lmap show $ runExcept (readString v)
note ("Decimal literal parsing failed: " <> s) (Decimal.fromString s) 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 a b. Newtype a b FromSQLValue b Foreign Either String a
newtypeFromSQLValue = map wrap <<< fromSQLValue newtypeFromSQLValue = map wrap <<< fromSQLValue
@ -162,7 +172,13 @@ else instance toSQLValueObject ∷ ToSQLValue a ⇒ ToSQLValue (Object a) where
toSQLValue = unsafeToForeign toSQLValue = unsafeToForeign
else instance toSQLValueDecimal :: ToSQLValue Decimal where 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 a b. Newtype a b ToSQLValue b a Foreign
newtypeToSQLValue = unwrap >>> toSQLValue newtypeToSQLValue = unwrap >>> toSQLValue

View File

@ -7,6 +7,8 @@ import Prelude
import Control.Monad.Error.Class (throwError, try) import Control.Monad.Error.Class (throwError, try)
import Control.Monad.Except.Trans (runExceptT) import Control.Monad.Except.Trans (runExceptT)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Data.Argonaut (Json)
import Data.Argonaut (fromArray, fromObject, fromString) as Argonaut
import Data.Array (zip) import Data.Array (zip)
import Data.Date (Date, canonicalDate) import Data.Date (Date, canonicalDate)
import Data.DateTime.Instant (Instant, unInstant) import Data.DateTime.Instant (Instant, unInstant)
@ -25,7 +27,8 @@ import Effect (Effect)
import Effect.Aff (Aff, error, launchAff) import Effect.Aff (Aff, error, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (message) import Effect.Exception (message)
import Foreign.Object (Object, fromFoldable) import Foreign.Object (fromFoldable) as Object
import Foreign.Object (Object)
import Global.Unsafe (unsafeStringify) import Global.Unsafe (unsafeStringify)
import Math ((%)) import Math ((%))
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
@ -286,9 +289,9 @@ main = do
pgEqual 3 (length dates) pgEqual 3 (length dates)
liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3]) liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3])
test conn "handling json and jsonb value" $ do test conn "handling Foreign.Object as json and jsonb" $ do
let jsonIn = fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3] let jsonIn = Object.fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3]
let expected = fromFoldable [Tuple "a" 2, Tuple "2" 3] let expected = Object.fromFoldable [Tuple "a" 2, Tuple "2" 3]
execute conn (Query """ execute conn (Query """
INSERT INTO jsons (json, jsonb) 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 (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 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 test conn "handling jsdate value" $ do
let let
jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0 jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0