sql value for Object

bower.json

@@ -18,7 +18,9 @@
     "purescript-effect": "^2.0.0",
     "purescript-exceptions": "^4.0.0",
     "purescript-decimals": "^4.0.0",
-    "purescript-js-date": "^6.0.0"
+    "purescript-js-date": "^6.0.0",
+    "purescript-foreign-object": "^1.0.0",
+    "purescript-foreign-generic": "^7.0.0"
   },
   "repository": {
     "type": "git",

src/Database/PostgreSQL/Value.purs

@@ -3,7 +3,8 @@ module Database.PostgreSQL.Value where
 import Prelude
 
 import Control.Monad.Error.Class (throwError)
-import Control.Monad.Except (runExcept)
+import Control.Monad.Except (ExceptT, except, runExcept, runExceptT)
+import Data.Array (foldl)
 import Data.Array as Array
 import Data.Bifunctor (lmap)
 import Data.ByteString (ByteString)
@@ -13,16 +14,20 @@ import Data.Decimal (Decimal)
 import Data.Decimal as Decimal
 import Data.Either (Either(..), note)
 import Data.Enum (fromEnum, toEnum)
+import Data.Identity (Identity)
 import Data.Int (fromString)
 import Data.JSDate (JSDate)
 import Data.List (List)
 import Data.List as List
+import Data.List.NonEmpty (singleton)
 import Data.Maybe (Maybe(..))
+import Data.Newtype (unwrap)
 import Data.String (Pattern(..), split)
-import Data.Time (Time(..))
 import Data.Time.Duration (Milliseconds(..))
-import Data.Traversable (traverse)
-import Foreign (Foreign, isNull, readArray, readBoolean, readChar, readInt, readNumber, readString, unsafeToForeign, unsafeFromForeign)
+import Data.Traversable (sequence, traverse)
+import Foreign (Foreign, ForeignError(..), MultipleErrors, isNull, readArray, readBoolean, readChar, readInt, readNumber, readString, renderForeignError, unsafeFromForeign, unsafeToForeign)
+import Foreign.Internal (readObject)
+import Foreign.Object (Object)
 
 -- | Convert things to SQL values.
 class ToSQLValue a where
@@ -134,6 +139,21 @@ instance toSQLValueForeign :: ToSQLValue Foreign where
 instance fromSQLValueForeign :: FromSQLValue Foreign where
     fromSQLValue = pure
 
+instance toSQLValueObject ∷ ToSQLValue a ⇒ ToSQLValue (Object a) where
+  toSQLValue = unsafeToForeign
+
+instance fromSQLValueObject ∷ FromSQLValue a ⇒ FromSQLValue (Object a) where
+  fromSQLValue sql = lmap showErr $ unwrap $ runExceptT main
+    where
+    showErr ∷ MultipleErrors → String
+    showErr e = foldl (\a x → a <> renderForeignError x <> " ") "" e
+    main ∷ ExceptT MultipleErrors Identity (Object a)
+    main = do
+      objF ∷ Object Foreign <- readObject sql
+      let eso = sequence $ map fromSQLValue objF
+      let emo = lmap (singleton <<< ForeignError) eso
+      except emo
+
 instance toSQLValueDecimal :: ToSQLValue Decimal where
     toSQLValue = Decimal.toString >>> unsafeToForeign
 

test/Main.purs

@@ -21,6 +21,8 @@ import Database.PostgreSQL (Connection, PoolConfiguration, Query(Query), Row0(Ro
 import Effect (Effect)
 import Effect.Aff (Aff, error, launchAff)
 import Effect.Class (liftEffect)
+import Effect.Console (logShow)
+import Foreign.Object (Object, fromFoldable)
 import Math ((%))
 import Partial.Unsafe (unsafePartial)
 import Test.Assert (assert)
@@ -76,6 +78,10 @@ main = void $ launchAff do
       CREATE TEMPORARY TABLE timestamps (
         timestamp timestamptz NOT NULL
       );
+      CREATE TEMPORARY TABLE jsons (
+        json json NOT NULL,
+        jsonb jsonb NOT NULL
+      );
     """) Row0
 
     liftEffect $ runTest $ do
@@ -173,6 +179,18 @@ main = void $ launchAff do
           equal 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]
+
+          execute conn (Query """
+            INSERT INTO jsons (json, jsonb)
+            VALUES ($1, $2)
+          """) (Row2 jsonIn jsonIn)
+
+          (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 jsdate value" $ do
           let
             jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0