feat: FromResult, tests

package.json

@@ -12,7 +12,8 @@
     "typescript": "^5.0.0"
   },
   "dependencies": {
-    "postgres-range": "^1.1.4",
+    "decimal.js": "^10.4.3",
-    "pg": "^8.11.3"
+    "pg": "^8.11.3",
+    "postgres-range": "^1.1.4"
   }
 }

spago.lock

@@ -5,6 +5,7 @@ workspace:
       dependencies:
         - aff
         - aff-promise
+        - arrays
         - bifunctors
         - control
         - datetime

spago.yaml

@@ -6,6 +6,7 @@ package:
   dependencies:
     - aff
     - aff-promise
+    - arrays
     - bifunctors
     - control
     - datetime

src/Data.Postgres.Result.purs

@@ -0,0 +1,52 @@
+module Data.Postgres.Result where
+
+import Prelude
+
+import Control.Monad.Error.Class (liftMaybe, throwError)
+import Data.Array as Array
+import Data.Int as Int
+import Data.Maybe (Maybe)
+import Data.Nullable (Nullable)
+import Data.Nullable as Nullable
+import Data.Postgres (class Rep, RepT, deserialize)
+import Data.Postgres.Raw (Raw)
+import Data.Tuple (Tuple)
+import Data.Tuple.Nested (type (/\), (/\))
+import Foreign (ForeignError(..))
+import Type.Prelude (Proxy(..))
+
+foreign import data Result :: Type
+
+foreign import rowsAffectedImpl :: Result -> Nullable Number
+foreign import rows :: Result -> Array (Array Raw)
+
+rowsAffected :: Result -> Maybe Int
+rowsAffected = Int.fromNumber <=< Nullable.toMaybe <<< rowsAffectedImpl
+
+class FromResult (a :: Type) where
+  expectedRowLength :: forall g. g a -> Int
+  fromRow :: Array Raw -> RepT a
+
+instance (Rep a, FromResult b) => FromResult (a /\ b) where
+  expectedRowLength _ = expectedRowLength (Proxy @b) + 1
+  fromRow r =
+    let
+      expLen = expectedRowLength (Proxy @(Tuple a b))
+      lengthMismatch = pure $ TypeMismatch ("Expected row of length " <> show expLen) ("Found row of length " <> show (Array.length r))
+    in
+      do
+        when (Array.length r /= expLen) (throwError lengthMismatch)
+        a <- deserialize =<< liftMaybe lengthMismatch (Array.head r)
+        b <- fromRow =<< liftMaybe lengthMismatch (Array.tail r)
+        pure $ a /\ b
+else instance FromResult Unit where
+  expectedRowLength _ = 0
+  fromRow _ = pure unit
+else instance Rep a => FromResult a where
+  expectedRowLength _ = 1
+  fromRow =
+    let
+      get [ a ] = pure a
+      get o = throwError $ pure $ TypeMismatch "Expected row of length 1" $ show o
+    in
+      deserialize <=< get

src/Data.Postgres.purs

@@ -27,6 +27,9 @@ import Simple.JSON (class ReadForeign, class WriteForeign, readJSON', writeJSON)
 newtype JSON a = JSON a
 
 derive instance Newtype (JSON a) _
+derive newtype instance Show a => Show (JSON a)
+derive newtype instance Eq a => Eq (JSON a)
+derive newtype instance Ord a => Ord (JSON a)
 derive newtype instance WriteForeign a => WriteForeign (JSON a)
 derive newtype instance ReadForeign a => ReadForeign (JSON a)
 

src/Effect.Aff.Postgres.Client.purs

@@ -4,14 +4,18 @@ import Prelude
 
 import Control.Promise (Promise)
 import Control.Promise as Promise
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Nullable (Nullable, toNullable)
+import Data.Postgres (smash)
 import Data.Postgres.Raw (Raw)
+import Data.Postgres.Result (class FromResult, Result, fromRow, rows, rowsAffected)
+import Data.Traversable (traverse)
 import Data.Tuple.Nested (type (/\), (/\))
 import Effect (Effect)
 import Effect.Aff (Aff)
-import Effect.Postgres.Client (Client)
+import Effect.Class (liftEffect)
-import Effect.Postgres.Result (Result)
+import Effect.Postgres.Client (Client, Config, make)
+import Prim.Row (class Union)
 import Record (insert, modify)
 import Type.Prelude (Proxy(..))
 
@@ -45,11 +49,23 @@ instance AsQuery String where
 instance AsQuery (String /\ Array Raw) where
   asQuery (text /\ values) = Query { text, values, name: Nothing }
 
+connected :: forall r trash. Union r trash (Config ()) => Record r -> Aff Client
+connected c = do
+  client <- liftEffect $ make c
+  connect client
+  pure client
+
 connect :: Client -> Aff Unit
 connect = Promise.toAffE <<< connectImpl
 
 end :: Client -> Aff Unit
 end = Promise.toAffE <<< endImpl
 
-query :: forall q. AsQuery q => q -> Client -> Aff Result
+queryRaw :: forall q. AsQuery q => q -> Client -> Aff Result
-query q = Promise.toAffE <<< queryImpl (queryToRaw $ asQuery q)
+queryRaw q = Promise.toAffE <<< queryImpl (queryToRaw $ asQuery q)
+
+exec :: forall q. AsQuery q => q -> Client -> Aff Int
+exec q = map (fromMaybe 0 <<< rowsAffected) <<< queryRaw q
+
+query :: forall q r. AsQuery q => FromResult r => q -> Client -> Aff (Array r)
+query q = traverse (liftEffect <<< smash <<< fromRow) <=< map rows <<< queryRaw q

src/Effect.Postgres.Result.purs

@@ -1,17 +0,0 @@
-module Effect.Postgres.Result where
-
-import Prelude
-
-import Data.Int as Int
-import Data.Maybe (Maybe)
-import Data.Nullable (Nullable)
-import Data.Nullable as Nullable
-import Data.Postgres.Raw (Raw)
-
-foreign import data Result :: Type
-
-foreign import rowsAffectedImpl :: Result -> Nullable Number
-foreign import rows :: Result -> Array (Array Raw)
-
-rowsAffected :: Result -> Maybe Int
-rowsAffected = Int.fromNumber <=< Nullable.toMaybe <<< rowsAffectedImpl

test/Test.Effect.Postgres.Client.purs

@@ -3,50 +3,62 @@ module Test.Effect.Postgres.Client where
 import Prelude
 
 import Control.Monad.Error.Class (try)
-import Data.Array as Array
+import Data.Either (Either, isLeft)
-import Data.Either (isLeft)
+import Data.Newtype (wrap)
-import Data.Postgres (deserialize, smash)
+import Data.Postgres (JSON(..))
-import Data.Traversable (traverse)
+import Data.PreciseDateTime (fromRFC3339String, toDateTimeLossy)
-import Effect.Aff (Aff)
+import Effect (Effect)
+import Effect.Aff (Aff, bracket)
+import Effect.Aff.Postgres.Client (query)
 import Effect.Aff.Postgres.Client as PG.Aff.Client
 import Effect.Class (liftEffect)
-import Effect.Console (log)
 import Effect.Postgres.Client as PG
-import Effect.Postgres.Client as PG.Client
-import Effect.Postgres.Result as Result
 import Node.Path as Path
 import Node.Process (cwd)
-import Test.Spec (Spec, describe, it)
+import Test.Spec (Spec, around, describe, it)
 import Test.Spec.Assertions (shouldEqual)
 
-client :: Aff PG.Client
+config
-client = do
+  :: Effect
+       { database :: String
+       , host :: String
+       , password :: String
+       , user :: String
+       }
+config = do
   cwd' <- liftEffect cwd
   host <- liftEffect $ Path.resolve [ cwd' ] "./pg"
-  liftEffect $ PG.Client.make { host, user: "postgres", password: "password", database: "postgres" }
+  pure { host, user: "postgres", password: "password", database: "postgres" }
+
+withClient :: (PG.Client -> Aff Unit) -> Aff Unit
+withClient = bracket (PG.Aff.Client.connected =<< liftEffect config) PG.Aff.Client.end
 
 spec :: Spec Unit
-spec = do
+spec =
-  describe "Client" do
+  around withClient do
-    describe "make" do
+    describe "Client" do
-      it "does not throw" $ void $ client
+      it "connect & end do not throw" $ const $ pure unit
-    describe "connect" do
+      describe "query" do
-      it "does not throw" $ PG.Aff.Client.connect =<< client
+        it "ok if connected" \c -> shouldEqual [ 1, 2, 3 ] =<< query "select unnest(array[1, 2, 3])" c
-    describe "end" do
+        it "throws if ended" \c -> do
-      it "does not throw" $ do
+          PG.Aff.Client.end c
-        c <- client
+          res :: Either _ (Array Int) <- try $ query "select 1" c
-        PG.Aff.Client.connect c
+          isLeft res `shouldEqual` true
-        PG.Aff.Client.end c
+        it "rowsAffected is correct" \c -> do
-    describe "query" do
+          void $ PG.Aff.Client.exec "create temp table foo (bar int);" c
-      it "ok if connected" $ do
+          cta <- PG.Aff.Client.exec "insert into foo values (1);" c
-        c <- client
+          cta `shouldEqual` 1
-        PG.Aff.Client.connect c
+          ctb <- PG.Aff.Client.exec "insert into foo values (1), (2), (3);" c
-        res <- Result.rows <$> PG.Aff.Client.query "select unnest(array[1, 2, 3])" c
+          ctb `shouldEqual` 3
-        ints :: Array Int <- liftEffect $ smash $ traverse deserialize $ Array.catMaybes $ map Array.head res
+          ctc <- PG.Aff.Client.exec "update foo set bar = 10;" c
-        ints `shouldEqual` [ 1, 2, 3 ]
+          ctc `shouldEqual` 4
-      it "throws if ended" $ do
+        describe "timestamp" do
-        c <- client
+          it "unmarshals" \c -> do
-        PG.Aff.Client.connect c
+            let exp = toDateTimeLossy <$> fromRFC3339String (wrap "2020-01-01T00:00:00Z")
-        PG.Aff.Client.end c
+            shouldEqual [ exp ] =<< query "select '2020-01-01T00:00:00Z' :: timestamptz" c
-        res <- try $ PG.Aff.Client.query "select 1" c
+          it "is string" \c -> shouldEqual [ "2020-01-01 00:00:00+00" ] =<< query "select '2020-01-01T00:00:00Z' :: timestamptz" c
-        isLeft res `shouldEqual` true
+          it "array is string" \c -> shouldEqual [ [ "2020-01-01 00:00:00+00" ] ] =<< query "select array['2020-01-01T00:00:00Z' :: timestamptz]" c
+        describe "json" do
+          it "unmarshals" \c -> shouldEqual [ JSON { foo: "bar" } ] =<< query "select '{\"foo\": \"bar\"}' :: json" c
+          it "is string" \c -> shouldEqual [ "{\"foo\": \"bar\"}" ] =<< query "select '{\"foo\": \"bar\"}' :: json" c
+          it "array is string" \c -> shouldEqual [ [ "{\"foo\": \"bar\"}" ] ] =<< query "select array['{\"foo\": \"bar\"}' :: json]" c