Handle Argonaut.Json

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
 

spago.dhall

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

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

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
 
@@ -164,6 +174,12 @@ else instance toSQLValueObject ∷ ToSQLValue a ⇒ ToSQLValue (Object a) where
 else instance toSQLValueDecimal :: ToSQLValue Decimal where
   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
 

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