feat: query builder, strict build

spago.yaml

@@ -1,19 +1,25 @@
 package:
+  build:
+    strict: true
+    pedantic_packages: true
   dependencies:
     - aff
-    - console
+    - arrays
+    - bifunctors
+    - control
     - effect
     - either
-    - foldable-traversable
+    - exceptions
     - foreign
     - fork
     - maybe
     - mmorph
     - newtype
+    - parallel
     - postgresql-client
     - prelude
-    - strings
-    - stringutils
+    - record
+    - tailrec
     - transformers
     - tuples
     - typelevel-prelude
@@ -195,4 +201,4 @@ workspace:
       ref: "v0.2.0"
   package_set:
     url: https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.10-20230930/packages.json
-    hash: sha256-nTsd44o7/hrTdk0c6dh0wyBqhFFDJJIeKdQU6L1zv/A=
+    hash: sha256-hp58GPoH+qX3eUsk2ecoHBZpQ50rFeZCCMTdKkYTr/Y=

src/Control.Monad.Postgres.purs

@@ -5,26 +5,21 @@ import Prelude
 import Control.Alternative (class Alt, class Alternative, class Plus)
 import Control.Monad.Cont (class MonadCont)
 import Control.Monad.Error.Class (class MonadError, class MonadThrow, liftEither, throwError)
-import Control.Monad.Fork.Class
-  ( class MonadBracket
-  , class MonadFork
-  , class MonadKill
-  , bracket
-  , kill
-  , never
-  , uninterruptible
-  )
+import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class MonadKill, bracket, kill, never, uninterruptible)
 import Control.Monad.Morph (class MFunctor, class MMonad, embed, hoist)
 import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask)
 import Control.Monad.Rec.Class (class MonadRec)
+import Control.Monad.State (StateT(..))
 import Control.Monad.Trans.Class (class MonadTrans, lift)
-import Control.Monad.Writer (class MonadTell, class MonadWriter)
+import Control.Monad.Writer (class MonadTell, class MonadWriter, WriterT(..))
 import Control.MonadPlus (class MonadPlus)
 import Control.Parallel (class Parallel, parallel, sequential)
 import Data.Bifunctor (lmap)
 import Data.Either (Either(..))
 import Data.Maybe (maybe)
 import Data.Newtype (class Newtype, unwrap, wrap)
+import Data.Postgres.Query.Builder as Query
+import Data.Tuple.Nested ((/\))
 import Database.PostgreSQL as Pg
 import Database.PostgreSQL.Aff as Pg.Aff
 import Effect.Aff.Class (class MonadAff, liftAff)
@@ -152,28 +147,20 @@ else instance
 
 -- | A monad which can perform logs
 class (Monad m, MonadThrow Error m) <= MonadPostgres m where
-  query :: forall @a. Pg.FromSQLRow a => String -> m (Array a)
-  queryP :: forall @a. Pg.FromSQLRow a => Array Foreign -> String -> m (Array a)
-  exec :: String -> m Unit
-  execP :: Array Foreign -> String -> m Unit
+  query' :: forall @a n. Monad n => (n ~> m) -> Pg.FromSQLRow a => Query.BuilderT n String -> m (Array a)
+  exec' :: forall @n. Monad n => (n ~> m) -> Query.BuilderT n String -> m Unit
   transaction :: forall a. m a -> m a
 
 instance (MonadUnliftAff m, MonadThrow Error m) => MonadPostgres (PostgresT m) where
-  query q = do
+  query' nm q = do
     conn <- ask
-    res <- liftAff $ Pg.Aff.query conn (Pg.Query q) Pg.Row0
+    qs /\ ps <- Query.runBuilder $ hoist nm q
+    res <- liftAff $ Pg.Aff.query conn (Pg.Query qs) ps
     liftEither $ lmap (error <<< show) $ res
-  queryP ps q = do
+  exec' nm q = do
     conn <- ask
-    res <- liftAff $ Pg.Aff.query conn (Pg.Query q) ps
-    liftEither $ lmap (error <<< show) $ res
-  exec q = do
-    conn <- ask
-    res <- liftAff $ Pg.Aff.execute conn (Pg.Query q) Pg.Row0
-    liftEither $ lmap (error <<< show) $ maybe (Right unit) Left $ res
-  execP ps q = do
-    conn <- ask
-    res <- liftAff $ Pg.Aff.execute conn (Pg.Query q) ps
+    qs /\ ps <- Query.runBuilder $ hoist nm q
+    res <- liftAff $ Pg.Aff.execute conn (Pg.Query qs) ps
     liftEither $ lmap (error <<< show) $ maybe (Right unit) Left $ res
   transaction pg = do
     conn :: Pg.Connection <- ask
@@ -184,10 +171,14 @@ instance (MonadUnliftAff m, MonadThrow Error m) => MonadPostgres (PostgresT m) w
         res <- liftAff $ Pg.Aff.withTransaction pool $ mToAff <<< pgToM
         liftEither $ lmap (error <<< show) $ res
 else instance (MonadUnliftAff m, Monad (t m), MonadThrow Error (t m), MMonad t, MonadPostgres m) => MonadPostgres (t m) where
-  query q = lift $ query q
-  queryP ps q = lift $ queryP ps q
-  exec q = lift $ exec q
-  execP ps q = lift $ execP ps q
+  query' nt q = do
+    ran <- nt $ Query.runBuilder q
+    let builderInM = StateT $ const $ pure ran
+    lift $ query' identity builderInM
+  exec' nt q = do
+    ran <- nt $ Query.runBuilder q
+    let builderInM = StateT $ const $ pure ran
+    lift $ exec' identity builderInM
   transaction = hoist transaction
 
 runPostgres :: forall m a. Pg.Connection -> PostgresT m a -> m a
@@ -195,3 +186,15 @@ runPostgres conn t = (unwrap $ unwrap t) conn
 
 runHasPostgres :: forall m a. Pg.Connection -> HasPostgresT m a -> m a
 runHasPostgres conn t = (unwrap $ unwrap t) conn
+
+query :: forall m @a. MonadPostgres m => Pg.FromSQLRow a => Query.BuilderT m String -> m (Array a)
+query = query' identity
+
+exec :: forall m @a. MonadPostgres m => Pg.FromSQLRow a => Query.BuilderT m String -> m Unit
+exec = exec' identity
+
+query0 :: forall m @a. MonadPostgres m => Pg.FromSQLRow a => String -> m (Array a)
+query0 q = query' identity (pure q)
+
+exec0 :: forall m @a. MonadPostgres m => Pg.FromSQLRow a => String -> m Unit
+exec0 q = exec' identity (pure q)

src/Data.Postgres.Query.Builder.purs

@@ -0,0 +1,21 @@
+module Data.Postgres.Query.Builder where
+
+import Prelude
+
+import Control.Monad.State (StateT, get, put, runStateT)
+import Data.Array as Array
+import Data.Tuple.Nested (type (/\))
+import Database.PostgreSQL (class ToSQLValue, toSQLValue)
+import Foreign (Foreign)
+
+type BuilderT m a = StateT (Array Foreign) m a
+
+runBuilder :: forall m a. BuilderT m a -> m (a /\ Array Foreign)
+runBuilder = flip runStateT []
+
+param :: forall m a. Monad m => ToSQLValue a => a -> BuilderT m String
+param p =
+  do
+    ps <- get
+    put $ ps <> [ toSQLValue p ]
+    pure $ "$" <> show (Array.length ps + 1)

test/Spec.Data.Postgres.Query.Builder.purs

@@ -0,0 +1,32 @@
+module Spec.Data.Postgres.Query.Builder where
+
+import Prelude
+
+import Control.Monad.Trans.Class (lift)
+import Data.Postgres.Query.Builder (param, runBuilder)
+import Data.Tuple.Nested ((/\))
+import Foreign (unsafeFromForeign)
+import Foreign.Internal.Stringify (unsafeStringify)
+import Test.Spec (Spec, describe, it)
+import Test.Spec.Assertions (shouldEqual)
+
+spec :: Spec Unit
+spec =
+  describe "Data.Postgres.Query.Builder" do
+    describe "runBuilder" do
+      it "empty" do
+        _ /\ ps <- runBuilder (pure unit)
+        map unsafeStringify ps `shouldEqual` []
+    describe "param" do
+      it "single" do
+        p /\ ps <- runBuilder $ param 123
+        p `shouldEqual` "$1"
+        map unsafeFromForeign ps `shouldEqual` [ 123 ]
+      it "many" do
+        _ /\ ps <- runBuilder do
+          a <- param 123
+          b <- param "abc"
+          c <- param [ 123 ]
+          d <- param true
+          lift $ [ a, b, c, d ] `shouldEqual` [ "$1", "$2", "$3", "$4" ]
+        map unsafeStringify ps `shouldEqual` [ "123", "\"abc\"", "[123]", "true" ]

test/Test.Main.purs

@@ -4,6 +4,7 @@ import Prelude
 
 import Effect (Effect)
 import Effect.Aff (launchAff_)
+import Spec.Data.Postgres.Query.Builder as Spec.Data.Postgres.Query.Builder
 import Spec.Data.Postgres.Record as Spec.Data.Postgres.Record
 import Test.Spec.Reporter (consoleReporter)
 import Test.Spec.Runner (runSpec)
@@ -11,3 +12,4 @@ import Test.Spec.Runner (runSpec)
 main :: Effect Unit
 main = launchAff_ $ runSpec [ consoleReporter ] do
   Spec.Data.Postgres.Record.spec
+  Spec.Data.Postgres.Query.Builder.spec