Allow nested tuples to be used as query rows

src/Database/PostgreSQL/Row.purs

@@ -1,11 +1,14 @@
 module Database.PostgreSQL.Row where
 
-import Data.Array as Array
-import Data.Either (Either(..))
-import Foreign (Foreign)
-import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, toSQLValue)
 import Prelude
 
+import Data.Array (uncons, (:))
+import Data.Array as Array
+import Data.Either (Either(..), note)
+import Data.Tuple (Tuple(..))
+import Database.PostgreSQL.Value (class FromSQLValue, class ToSQLValue, fromSQLValue, toSQLValue)
+import Foreign (Foreign)
+
 -- | Convert things to SQL rows.
 class ToSQLRow a where
     toSQLRow :: a -> Array Foreign
@@ -17,6 +20,19 @@ class FromSQLRow a where
 instance toSQLRowForeignArray :: ToSQLRow (Array Foreign) where
   toSQLRow = identity
 
+instance toSQLRowTuple :: (ToSQLValue a, ToSQLRow (Tuple b t)) => ToSQLRow (Tuple a (Tuple b t)) where
+  toSQLRow (Tuple a t) = toSQLValue a : toSQLRow t
+else instance toSQLRowTupleEnd :: (ToSQLValue a, ToSQLValue b) => ToSQLRow (Tuple a b) where
+  toSQLRow (Tuple a b) = [ toSQLValue a, toSQLValue b ]
+
+instance fromSQLRowTuple :: (FromSQLValue a, FromSQLRow (Tuple b t)) => FromSQLRow (Tuple a (Tuple b t)) where
+  fromSQLRow r = do
+    {head, tail} ← note "Expecting more fields in a row" $ uncons r
+    Tuple <$> fromSQLValue head <*> fromSQLRow tail
+else instance fromSQLRowTupleEnd :: (FromSQLValue a, FromSQLValue b) => FromSQLRow (Tuple a b) where
+  fromSQLRow [a, b] = Tuple <$> fromSQLValue a <*> fromSQLValue b
+  fromSQLRow _ = Left "Expecting exactly two more fields."
+
 -- | A row with 0 fields.
 data Row0 = Row0
 

test/Main.purs

@@ -18,6 +18,7 @@ import Data.JSDate as JSDate
 import Data.Maybe (Maybe(..), fromJust)
 import Data.Newtype (unwrap)
 import Data.Tuple (Tuple(..))
+import Data.Tuple.Nested ((/\))
 import Database.PostgreSQL (Connection, PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, newPool, query, scalar, withConnection, withTransaction)
 import Effect (Effect)
 import Effect.Aff (Aff, error, launchAff)
@@ -26,6 +27,7 @@ import Foreign.Object (Object, fromFoldable)
 import Math ((%))
 import Partial.Unsafe (unsafePartial)
 import Test.Assert (assert)
+import Test.Example (run) as Example
 import Test.Unit (TestF, suite)
 import Test.Unit as Test.Unit
 import Test.Unit.Assert (equal)
@@ -61,7 +63,12 @@ jsdate_ year month day hour minute second millisecond =
   jsdate { year, month, day, hour, minute, second, millisecond }
 
 main ∷ Effect Unit
-main = void $ launchAff do
+main = do
+  void $ launchAff do
+    -- Running guide from README
+    Example.run
+
+    -- Acctual test suite
     pool <- newPool config
     withConnection pool \conn -> do
       execute conn (Query """
@@ -116,6 +123,22 @@ main = void $ launchAff do
               throwError $ error "fail"
             testCount 0
 
+          test conn "usage of rows represented by nested tuples" $ do
+            execute conn (Query """
+              INSERT INTO foods (name, delicious, price)
+              VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
+            """)
+              ( "pork" /\ true /\ (D.fromString "8.30")
+              /\ "sauerkraut" /\ false /\ (D.fromString "3.30")
+              /\ "rookworst" /\ true /\ (D.fromString "5.60"))
+            names <- query conn (Query """
+              SELECT name, delicious
+              FROM foods
+              WHERE delicious
+              ORDER BY name ASC
+            """) Row0
+            liftEffect <<< assert $ names == ["pork" /\ true, "rookworst" /\ true]
+
           let
             insertFood =
               execute conn (Query """
@@ -125,6 +148,7 @@ main = void $ launchAff do
                   "pork" true (D.fromString "8.30")
                   "sauerkraut" false (D.fromString "3.30")
                   "rookworst" true (D.fromString "5.60"))
+
           test conn "select column subset" $ do
             insertFood
             names <- query conn (Query """
@@ -238,11 +262,11 @@ main = void $ launchAff do
 
 config :: PoolConfiguration
 config =
-  { user: "postgres"
-  , password: "lol123"
-  , host: "127.0.0.1"
-  , port: 5432
+  { user: Nothing
+  , password: Nothing
+  , host: Nothing
+  , port: Nothing
   , database: "purspg"
-  , max: 10
-  , idleTimeoutMillis: 1000
+  , max: Nothing
+  , idleTimeoutMillis: Just 1000
   }