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 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

View File

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

View File

@ -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

View File

@ -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

View File

@ -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