diff --git a/bower.json b/bower.json index 5011749..40bc26f 100644 --- a/bower.json +++ b/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", diff --git a/src/Database/PostgreSQL/Value.purs b/src/Database/PostgreSQL/Value.purs index 9ad7ccb..255a3ea 100644 --- a/src/Database/PostgreSQL/Value.purs +++ b/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 diff --git a/test/Main.purs b/test/Main.purs index b93a04a..a94236f 100644 --- a/test/Main.purs +++ b/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