chore: prepare v1.2.4

README.md

@@ -255,59 +255,59 @@ the api of [`node-postgres`]:
   - release clients with [`Pool.release`] or [`Pool.destroy`]
   - release with [`Pool.end`]
 
-[`Pool`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Pool#t:Pool
-[`Config`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Pool#t:Config
-[`Pool.make`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Pool#v:make
-[`Pool.end`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Pool#v:end
-[`Pool.connect`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Pool#v:connect
-[`Pool.destroy`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Pool#v:destroy
-[`Pool.release`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Pool#v:release
+[`Pool`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Pool#t:Pool
+[`Config`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Pool#t:Config
+[`Pool.make`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Pool#v:make
+[`Pool.end`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Pool#v:end
+[`Pool.connect`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Pool#v:connect
+[`Pool.destroy`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Pool#v:destroy
+[`Pool.release`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Pool#v:release
 
-[`Client`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Client#t:Client
-[`Client.end`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Client#v:end
-[`Client.make`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Client#v:make
-[`Client.connected`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Client#v:connected
-[`Client.query`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Client#v:query
-[`Client.queryRaw`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Client#v:queryRaw
-[`Client.exec`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Effect.Aff.Postgres.Client#v:exec
+[`Client`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Client#t:Client
+[`Client.end`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Client#v:end
+[`Client.make`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Client#v:make
+[`Client.connected`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Client#v:connected
+[`Client.query`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Client#v:query
+[`Client.queryRaw`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Client#v:queryRaw
+[`Client.exec`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Effect.Aff.Postgres.Client#v:exec
 
-[`Range`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Range#t:Range
-[`Range.gt`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Range#v:gt
-[`Range.gte`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Range#v:gte
-[`Range.lt`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Range#v:lt
-[`Range.lte`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Range#v:lte
+[`Range`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Range#t:Range
+[`Range.gt`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Range#v:gt
+[`Range.gte`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Range#v:gte
+[`Range.lt`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Range#v:lt
+[`Range.lte`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Range#v:lte
 
-[`Raw`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Raw#t:Raw
-[`Null`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Raw#t:Null
+[`Raw`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Raw#t:Raw
+[`Null`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Raw#t:Null
 
-[`Serialize`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres#t:Serialize
-[`Deserialize`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres#t:Deserialize
-[`Rep`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres#t:Rep
-[`modifyPgTypes`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres#v:modifyPgTypes
+[`Serialize`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres#t:Serialize
+[`Deserialize`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres#t:Deserialize
+[`Rep`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres#t:Rep
+[`modifyPgTypes`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres#v:modifyPgTypes
 
-[`Result`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Result#t:Result
-[`FromRow`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Result#t:FromRow
-[`FromRows`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Result#t:FromRows
+[`Result`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Result#t:Result
+[`FromRow`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Result#t:FromRow
+[`FromRows`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Result#t:FromRows
 
-[`Query`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Query#t:Query
-[`AsQuery`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Query#t:AsQuery
+[`Query`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Query#t:Query
+[`AsQuery`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Query#t:AsQuery
 
-[`Query.Builder`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Query.Builder#t:Builder
-[`Query.Builder.param`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Query.Builder#v:param
-[`Query.Builder.build`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Data.Postgres.Query.Builder#v:build
+[`Query.Builder`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Query.Builder#t:Builder
+[`Query.Builder.param`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Query.Builder#v:param
+[`Query.Builder.build`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Data.Postgres.Query.Builder#v:build
 
-[`MonadCursor`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#t:MonadCursor
-[`MonadSession`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#t:MonadSession
-[`CursorT`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#t:CursorT
-[`SessionT`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#t:SessionT
-[`PostgresT`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#t:PostgresT
-[`cursor`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#v:cursor
-[`session`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#v:session
-[`transaction`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#v:transaction
-[`runPostgres`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#v:runPostgres
-[`query`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#v:query
-[`exec`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#v:exec
-[`exec_`]: https://pursuit.purescript.org/packages/postgresql/1.0.1/docs/Control.Monad.Postgres#v:exec_
+[`MonadCursor`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#t:MonadCursor
+[`MonadSession`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#t:MonadSession
+[`CursorT`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#t:CursorT
+[`SessionT`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#t:SessionT
+[`PostgresT`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#t:PostgresT
+[`cursor`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#v:cursor
+[`session`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#v:session
+[`transaction`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#v:transaction
+[`runPostgres`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#v:runPostgres
+[`query`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#v:query
+[`exec`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#v:exec
+[`exec_`]: https://pursuit.purescript.org////////////packages/purescript-postgresql/1.2.4/docs/Control.Monad.Postgres#v:exec_
 
 [`node-postgres`]: https://node-postgres.com/
 [`pg-types`]: https://github.com/brianc/node-pg-types/

bun/prepare.js

@@ -0,0 +1,32 @@
+import { readFile, writeFile } from 'fs/promises'
+import { execSync } from 'child_process'
+
+let ver = process.argv[2]
+if (!ver) {
+  console.error(`tag required: bun bun/prepare.js v1.0.0`)
+} else if (!/v\d+\.\d+\.\d+/.test(ver)) {
+  console.error(`invalid tag: ${ver}`)
+}
+
+ver = (/\d+\.\d+\.\d+/.exec(ver) || [])[0] || ''
+
+const pkg = await readFile('./package.json', 'utf8')
+const pkgnew = pkg.replace(/"version": ".+"/, `"version": "v${ver}"`)
+await writeFile('./package.json', pkgnew)
+
+const spago = await readFile('./spago.yaml', 'utf8')
+const spagonew = spago.replace(/version: .+/, `version: '${ver}'`)
+await writeFile('./spago.yaml', spagonew)
+
+const readme = await readFile('./README.md', 'utf8')
+const readmenew = readme.replace(
+  /packages\/purescript-postgresql\/.+?\//g,
+  `/packages/purescript-postgresql/${ver}/`,
+)
+await writeFile('./README.md', readmenew)
+
+execSync(`git add spago.yaml package.json README.md`)
+execSync(`git commit -m 'chore: prepare v${ver}'`)
+execSync(`git tag v${ver}`)
+execSync(`git push --tags`)
+execSync(`git push --mirror github-mirror`)

spago.lock

@@ -32,6 +32,7 @@ workspace:
         - record: ">=4.0.0 <5.0.0"
         - simple-json: ">=9.0.0 <10.0.0"
         - strings: ">=6.0.1 <7.0.0"
+        - tailrec
         - transformers: ">=6.0.0 <7.0.0"
         - tuples: ">=7.0.0 <8.0.0"
         - typelevel-prelude: ">=7.0.0 <8.0.0"

spago.yaml

@@ -1,7 +1,7 @@
 package:
   name: postgresql
   publish:
-    version: '1.0.1'
+    version: '1.2.4'
     license: 'GPL-3.0-or-later'
     location:
       githubOwner: 'cakekindel'
@@ -13,6 +13,7 @@ package:
     strict: true
     pedanticPackages: true
   dependencies:
+    - tailrec
     - aff: ">=7.1.0 <8.0.0"
     - aff-promise: ">=4.0.0 <5.0.0"
     - arrays: ">=7.3.0 <8.0.0"

src/Control.Monad.Postgres.Base.purs

@@ -9,6 +9,7 @@ import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class Mona
 import Control.Monad.Morph (class MFunctor, class MMonad)
 import Control.Monad.Postgres.Session (class MonadSession, SessionT, exec, exec_, query)
 import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, local, runReaderT)
+import Control.Monad.Rec.Class (class MonadRec)
 import Control.Monad.Trans.Class (class MonadTrans, lift)
 import Control.Parallel (class Parallel, parallel, sequential)
 import Data.Newtype (class Newtype, unwrap, wrap)
@@ -57,6 +58,7 @@ derive newtype instance (Bind m) => Bind (PostgresT m)
 derive newtype instance (Monad m) => Monad (PostgresT m)
 derive newtype instance (MonadEffect m) => MonadEffect (PostgresT m)
 derive newtype instance (MonadAff m) => MonadAff (PostgresT m)
+derive newtype instance MonadRec m => MonadRec (PostgresT m)
 derive newtype instance MonadTrans (PostgresT)
 derive newtype instance (MonadThrow e m) => MonadThrow e (PostgresT m)
 derive newtype instance (MonadError e m) => MonadError e (PostgresT m)
@@ -110,6 +112,12 @@ transaction m =
   in
     session $ begin *> catchError commit rollback
 
+-- | Execute a `PostgresT` using an existing connection pool.
+-- |
+-- | This will not invoke `Pool.end` after executing.
+withPool :: forall m a. PostgresT m a -> Pool -> m a
+withPool = runReaderT <<< unwrap
+
 -- | Create a new connection pool from the provided config and execute
 -- | the postgres monad, invoking `Effect.Aff.Postgres.Pool.end` afterwards.
 runPostgres :: forall m a missing trash r e f. MonadBracket e f m => MonadAff m => Union r missing (Pool.Config trash) => Record r -> PostgresT m a -> m a
@@ -118,4 +126,4 @@ runPostgres cfg m =
     acq = liftEffect $ Pool.make @r @missing @trash cfg
     rel _ p = liftAff $ Pool.end p
   in
-    bracket acq rel $ runReaderT $ unwrap m
+    bracket acq rel $ withPool m

src/Control.Monad.Postgres.Cursor.purs

@@ -9,20 +9,25 @@ import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class Mona
 import Control.Monad.Postgres.Base (PostgresT, transaction)
 import Control.Monad.Postgres.Session (class MonadSession, SessionT, exec, exec_, query)
 import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask, local, runReaderT)
+import Control.Monad.Rec.Class (class MonadRec)
 import Control.Monad.Trans.Class (class MonadTrans, lift)
 import Control.Parallel (class Parallel, parallel, sequential)
 import Data.Array as Array
 import Data.Maybe (Maybe)
 import Data.Newtype (class Newtype, unwrap, wrap)
+import Data.Postgres (RepT, smash)
 import Data.Postgres.Query (class AsQuery, asQuery)
-import Data.Postgres.Result (class FromRow)
+import Data.Postgres.Raw (Raw)
+import Data.Postgres.Result (class FromRow, fromRow)
+import Data.Traversable (traverse)
+import Data.Tuple.Nested (type (/\), (/\))
 import Effect.Aff (Fiber)
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Exception (Error)
 
 newtype CursorT :: forall k. Type -> (k -> Type) -> k -> Type
-newtype CursorT t m a = CursorT (ReaderT String m a)
+newtype CursorT t m a = CursorT (ReaderT (String /\ (Array Raw -> RepT t)) m a)
 
 derive instance Newtype (CursorT t m a) _
 derive newtype instance (Functor m) => Functor (CursorT t m)
@@ -34,6 +39,7 @@ derive newtype instance (Bind m) => Bind (CursorT t m)
 derive newtype instance (Monad m) => Monad (CursorT t m)
 derive newtype instance (MonadEffect m) => MonadEffect (CursorT t m)
 derive newtype instance (MonadAff m) => MonadAff (CursorT t m)
+derive newtype instance MonadRec m => MonadRec (CursorT t m)
 derive newtype instance MonadTrans (CursorT t)
 derive newtype instance (MonadThrow e m) => MonadThrow e (CursorT t m)
 derive newtype instance (MonadError e m) => MonadError e (CursorT t m)
@@ -46,10 +52,10 @@ instance (Monad m, MonadBracket e f (ReaderT String m), MonadBracket e f m) => M
   uninterruptible a = wrap $ uninterruptible $ unwrap a
   never = lift $ never
 
-instance Monad m => MonadAsk String (CursorT t m) where
+instance Monad m => MonadAsk (String /\ (Array Raw -> RepT t)) (CursorT t m) where
   ask = wrap ask
 
-instance Monad m => MonadReader String (CursorT t m) where
+instance Monad m => MonadReader (String /\ (Array Raw -> RepT t)) (CursorT t m) where
   local f m = wrap $ local f $ unwrap m
 
 instance (Apply m, Apply p, Parallel p m) => Parallel (CursorT t p) (CursorT t m) where
@@ -78,19 +84,21 @@ instance (Apply m, Apply p, Parallel p m) => Parallel (CursorT t p) (CursorT t m
 -- |     e <- fetchAll -- 15..100
 -- |     pure unit
 -- | ```
-class (MonadSession m, FromRow t) <= MonadCursor m t where
+class (MonadSession m) <= MonadCursor m t where
   -- | Fetch a specified number of rows from the cursor
   fetch :: Int -> m (Array t)
   -- | Fetch all remaining rows from the cursor
   fetchAll :: m (Array t)
 
-instance (FromRow t, MonadSession m) => MonadCursor (CursorT t m) t where
+instance (MonadSession m) => MonadCursor (CursorT t m) t where
   fetch n = do
-    cur <- ask
-    query $ "fetch forward " <> show n <> " from " <> cur
+    cur /\ f <- ask
+    raw :: Array (Array Raw) <- query $ "fetch forward " <> show n <> " from " <> cur
+    liftEffect $ smash $ traverse f raw
   fetchAll = do
-    cur <- ask
-    query $ "fetch all from " <> cur
+    cur /\ f <- ask
+    raw :: Array (Array Raw) <- query $ "fetch all from " <> cur
+    liftEffect $ smash $ traverse f raw
 
 instance (MonadSession m) => MonadSession (CursorT t m) where
   query = lift <<< query
@@ -103,9 +111,14 @@ fetchOne = Array.head <$> fetch 1
 
 -- | Create a server-side cursor for a query in a transaction,
 -- | and execute a `CursorT` with a view to the new cursor.
-cursor :: forall m @t a q. AsQuery q => MonadAff m => MonadBracket Error Fiber m => MonadSession (SessionT m) => String -> q -> CursorT t (SessionT m) a -> PostgresT m a
-cursor cur q m =
+cursor :: forall m @t a q. FromRow t => AsQuery q => MonadAff m => MonadBracket Error Fiber m => MonadSession (SessionT m) => String -> q -> CursorT t (SessionT m) a -> PostgresT m a
+cursor cur q m = cursorWith cur q fromRow m
+
+-- | `cursor`, but using a custom deserialize function for the data
+-- | yielded by the cursor
+cursorWith :: forall m @t a q. AsQuery q => MonadAff m => MonadBracket Error Fiber m => MonadSession (SessionT m) => String -> q -> (Array Raw -> RepT t) -> CursorT t (SessionT m) a -> PostgresT m a
+cursorWith cur q f m =
   transaction do
     q' <- liftEffect $ asQuery q
     exec_ $ "declare " <> cur <> " cursor for (" <> (unwrap q').text <> ");"
-    runReaderT (unwrap m) cur
+    runReaderT (unwrap m) (cur /\ f)

src/Data.Postgres.Custom.Enum.purs

@@ -5,71 +5,69 @@ import Prelude
 import Control.Alt ((<|>))
 import Control.Monad.Error.Class (liftMaybe)
 import Data.Array.NonEmpty.Internal (NonEmptyArray)
-import Data.Either (hush)
+import Data.Bifunctor (lmap)
 import Data.Foldable (intercalate)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep as G
-import Data.Maybe (Maybe(..), fromJust)
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype as Newtype
-import Data.Postgres (RepT, deserialize, serialize)
-import Data.Postgres.Custom (class CustomRep, quoted, typeName)
+import Data.Postgres (class Rep, RepT, deserialize, serialize)
+import Data.Postgres.Custom (quoted)
 import Data.Postgres.Query (Query, emptyQuery)
 import Data.Postgres.Raw (Raw)
-import Data.String as String
-import Data.String.Regex (Regex)
-import Data.String.Regex as Regex
-import Data.String.Regex.Flags as Regex.Flags
 import Data.Symbol (class IsSymbol)
+import Data.Traversable (find)
+import Data.Tuple (fst, snd)
+import Data.Tuple.Nested (type (/\), (/\))
 import Foreign (ForeignError(..))
-import Partial.Unsafe (unsafePartial)
 import Type.Prelude (Proxy(..), reflectSymbol)
 
-upperRe :: Regex
-upperRe = unsafePartial fromJust $ hush $ Regex.regex "[A-Z]" Regex.Flags.global
+typeName :: forall @a ty. CustomEnum a ty => String
+typeName = reflectSymbol (Proxy @ty)
 
-leadingUnderRe :: Regex
-leadingUnderRe = unsafePartial fromJust $ hush $ Regex.regex "^_" Regex.Flags.noFlags
-
-pascalToSnake :: String -> String
-pascalToSnake = String.toLower <<< Regex.replace leadingUnderRe "" <<< Regex.replace upperRe "_$1"
-
-class CustomRep a ty <= CustomEnum a ty | a -> ty where
-  enumVariants :: NonEmptyArray a
+class (IsSymbol ty, Rep a, Eq a) <= CustomEnum a ty | a -> ty where
+  enumVariants :: NonEmptyArray (a /\ String)
   parseEnum :: String -> Maybe a
   printEnum :: a -> String
 
+defaultParseEnum :: forall a ty. CustomEnum a ty => String -> Maybe a
+defaultParseEnum s = map fst $ find (eq s <<< snd) enumVariants
+
+defaultPrintEnum :: forall a ty. CustomEnum a ty => a -> String
+defaultPrintEnum a = fromMaybe "ERROR: CustomEnum enumVariants was not exhaustive" $ map snd $ find (eq a <<< fst) enumVariants
+
+defaultDeserializeEnum :: forall @a ty. CustomEnum a ty => Raw -> RepT a
+defaultDeserializeEnum raw = do
+  s <- deserialize raw
+  let e = pure $ ForeignError $ "unsupported enum variant for " <> typeName @a <> ": " <> quoted s
+  liftMaybe e $ parseEnum s
+
+defaultSerializeEnum :: forall @a ty. CustomEnum a ty => a -> RepT Raw
+defaultSerializeEnum = serialize <<< printEnum
+
 class GenericCustomEnum a where
-  genericEnumVariants' :: NonEmptyArray a
+  genericEnumVariants' :: NonEmptyArray (a /\ String)
   genericParseEnum' :: String -> Maybe a
   genericPrintEnum' :: a -> String
 
 instance IsSymbol n => GenericCustomEnum (G.Constructor n G.NoArguments) where
-  genericEnumVariants' = pure (G.Constructor @n G.NoArguments)
+  genericEnumVariants' = pure (G.Constructor @n G.NoArguments /\ reflectSymbol (Proxy @n))
   genericParseEnum' s
     | s == reflectSymbol (Proxy @n) = Just (G.Constructor @n G.NoArguments)
     | otherwise = Nothing
   genericPrintEnum' _ = reflectSymbol (Proxy @n)
 
 instance (GenericCustomEnum a, GenericCustomEnum b) => GenericCustomEnum (G.Sum a b) where
-  genericEnumVariants' = (G.Inl <$> genericEnumVariants' @a) <> (G.Inr <$> genericEnumVariants' @b)
+  genericEnumVariants' = (lmap G.Inl <$> genericEnumVariants' @a) <> (lmap G.Inr <$> genericEnumVariants' @b)
   genericParseEnum' s = (G.Inl <$> genericParseEnum' @a s) <|> (G.Inr <$> genericParseEnum' @b s)
   genericPrintEnum' (G.Inl a) = genericPrintEnum' a
   genericPrintEnum' (G.Inr a) = genericPrintEnum' a
 
-enumDeserialize :: forall @a ty. CustomEnum a ty => Raw -> RepT a
-enumDeserialize raw = do
-  s <- deserialize raw
-  let e = pure $ ForeignError $ "unsupported enum variant for " <> typeName @a <> ": " <> quoted s
-  liftMaybe e $ parseEnum s
-
-enumSerialize :: forall @a ty. CustomEnum a ty => a -> RepT Raw
-enumSerialize = serialize <<< printEnum
-
 enumPrintExpr :: forall @a ty. CustomEnum a ty => a -> Maybe String
 enumPrintExpr = Just <<< (\s -> quoted s <> " :: " <> typeName @a) <<< printEnum
 
-genericEnumVariants :: forall a g. Generic a g => GenericCustomEnum g => NonEmptyArray a
-genericEnumVariants = G.to <$> genericEnumVariants'
+genericEnumVariants :: forall a g. Generic a g => GenericCustomEnum g => NonEmptyArray (a /\ String)
+genericEnumVariants = lmap G.to <$> genericEnumVariants'
 
 genericParseEnum :: forall a g. Generic a g => GenericCustomEnum g => String -> Maybe a
 genericParseEnum = map G.to <<< genericParseEnum'
@@ -80,9 +78,7 @@ genericPrintEnum = genericPrintEnum' <<< G.from
 create :: forall @a ty. CustomEnum a ty => Query
 create =
   let
-    variants' :: NonEmptyArray a
-    variants' = enumVariants
-    variants = intercalate ", " $ quoted <$> printEnum <$> variants'
+    variants = intercalate ", " $ quoted <$> snd <$> enumVariants @a
     q = "create type " <> typeName @a <> " as enum (" <> variants <> ");"
   in
     Newtype.modify (_ { text = q }) emptyQuery

src/Data.Postgres.Custom.purs

@@ -3,27 +3,28 @@ module Data.Postgres.Custom where
 import Prelude
 
 import Control.Monad.Except (ExceptT)
+import Data.Either (hush)
 import Data.List.NonEmpty (NonEmptyList)
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe, fromJust)
 import Data.Postgres.Raw (Raw)
+import Data.String as String
+import Data.String.Regex (Regex)
+import Data.String.Regex as Regex
+import Data.String.Regex.Flags as Regex.Flags
 import Effect (Effect)
 import Foreign (ForeignError)
+import Partial.Unsafe (unsafePartial)
 import Type.Data.Symbol (reflectSymbol)
 import Type.Prelude (class IsSymbol, Proxy(..))
 
-class (IsSymbol ty) <= CustomSerialize a ty | a -> ty where
-  customPrintExpr :: a -> Maybe String
-  customSerialize :: a -> ExceptT (NonEmptyList ForeignError) Effect Raw
-
-class (IsSymbol ty) <= CustomDeserialize a ty | a -> ty where
-  customDeserialize :: Raw -> ExceptT (NonEmptyList ForeignError) Effect a
-
-class (IsSymbol ty, CustomSerialize a ty, CustomDeserialize a ty) <= CustomRep a ty | a -> ty
-
-instance (IsSymbol ty, CustomSerialize a ty, CustomDeserialize a ty) => CustomRep a ty
-
 quoted :: String -> String
 quoted s = "'" <> s <> "'"
 
-typeName :: forall @a ty. CustomRep a ty => String
-typeName = reflectSymbol (Proxy @ty)
+upperRe :: Regex
+upperRe = unsafePartial fromJust $ hush $ Regex.regex "[A-Z]" Regex.Flags.global
+
+leadingUnderRe :: Regex
+leadingUnderRe = unsafePartial fromJust $ hush $ Regex.regex "^_" Regex.Flags.noFlags
+
+pascalToSnake :: String -> String
+pascalToSnake = String.toLower <<< Regex.replace leadingUnderRe "" <<< Regex.replace upperRe "_$1"

src/Data.Postgres.Result.purs

@@ -8,7 +8,7 @@ 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 (class Deserialize, class Rep, RepT, deserialize)
 import Data.Postgres.Raw (Raw)
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple)
@@ -79,7 +79,7 @@ class FromRow (a :: Type) where
   -- | Performs the conversion
   fromRow :: Array Raw -> RepT a
 
-instance (Rep a, FromRow b) => FromRow (a /\ b) where
+instance (Deserialize a, FromRow b) => FromRow (a /\ b) where
   minColumnCount _ = minColumnCount (Proxy @b) + 1
   fromRow r =
     let
@@ -97,7 +97,7 @@ else instance FromRow (Array Raw) where
 else instance FromRow Unit where
   minColumnCount _ = 0
   fromRow _ = pure unit
-else instance Rep a => FromRow a where
+else instance Deserialize a => FromRow a where
   minColumnCount _ = 1
   fromRow r =
     let

src/Data.Postgres.Unresult.purs

@@ -0,0 +1,27 @@
+module Data.Postgres.Unresult where
+
+import Prelude
+
+import Control.Monad.Error.Class (liftMaybe)
+import Control.Monad.State (StateT, runStateT, state)
+import Data.Array as Array
+import Data.Postgres (class Deserialize, RepT, deserialize, smash)
+import Data.Postgres.Raw (Raw)
+import Data.Tuple (fst)
+import Data.Tuple.Nested ((/\))
+import Effect.Class (liftEffect)
+import Foreign (ForeignError(..))
+
+-- | Monad used to incrementally deserialize columns from a row
+type Unresult a = StateT { ix :: Int, row :: Array Raw } RepT a
+
+-- | Run an `UnresultT`
+unresult :: forall a. Unresult a -> Array Raw -> RepT a
+unresult m row = fst <$> runStateT m { ix: 0, row }
+
+-- | Take the next column from the row, unmarshalling into `a`
+take :: forall a. Deserialize a => Unresult a
+take = do
+  raw <- state (\r -> Array.index r.row r.ix /\ r { ix = r.ix + 1 })
+  raw' <- liftMaybe (pure $ ForeignError $ "Ran out of columns!") raw
+  liftEffect $ smash $ deserialize raw'

src/Data.Postgres.purs

@@ -12,7 +12,6 @@ import Data.DateTime (DateTime)
 import Data.List.NonEmpty (NonEmptyList)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype, unwrap, wrap)
-import Data.Postgres.Custom (class CustomDeserialize, class CustomSerialize, customDeserialize, customSerialize)
 import Data.Postgres.Range (Range, __rangeFromRecord, __rangeRawFromRaw, __rangeRawFromRecord, __rangeRawToRecord, __rangeToRecord)
 import Data.Postgres.Raw (Null(..), Raw, jsNull)
 import Data.Postgres.Raw (unsafeFromForeign, asForeign) as Raw
@@ -42,7 +41,7 @@ derive newtype instance ReadForeign a => ReadForeign (JSON a)
 foreign import modifyPgTypes :: Effect Unit
 
 -- | The serialization & deserialization monad.
-type RepT a = ExceptT (NonEmptyList ForeignError) Effect a
+type RepT = ExceptT (NonEmptyList ForeignError) Effect
 
 -- | Flatten to an Effect, `show`ing errors
 smash :: forall a. RepT a -> Effect a
@@ -73,87 +72,84 @@ instance Serialize Raw where
   serialize = pure
 
 -- | `NULL`
-else instance Serialize Unit where
+instance Serialize Unit where
   serialize _ = serialize Null
 
 -- | `NULL`
-else instance Serialize Null where
+instance Serialize Null where
   serialize _ = unsafeSerializeCoerce jsNull
 
 -- | `json`, `jsonb`
-else instance WriteForeign a => Serialize (JSON a) where
+instance WriteForeign a => Serialize (JSON a) where
   serialize = serialize <<< writeJSON <<< unwrap
 
 -- | `bytea`
-else instance Serialize Buffer where
+instance Serialize Buffer where
   serialize = unsafeSerializeCoerce
 
 -- | `int2`, `int4`
-else instance Serialize Int where
+instance Serialize Int where
   serialize = unsafeSerializeCoerce
 
 -- | `int8`
-else instance Serialize BigInt where
+instance Serialize BigInt where
   serialize = serialize <<< BigInt.toString
 
 -- | `bool`
-else instance Serialize Boolean where
+instance Serialize Boolean where
   serialize = unsafeSerializeCoerce
 
 -- | `text`, `inet`, `tsquery`, `tsvector`, `uuid`, `xml`, `cidr`, `time`, `timetz`
-else instance Serialize String where
+instance Serialize String where
   serialize = unsafeSerializeCoerce
 
 -- | `float4`, `float8`
-else instance Serialize Number where
+instance Serialize Number where
   serialize = unsafeSerializeCoerce
 
 -- | `timestamp`, `timestamptz`
-else instance Serialize DateTime where
+instance Serialize DateTime where
   serialize = serialize <<< unwrap <<< DateTime.ISO.fromDateTime
 
 -- | `Just` -> `a`, `Nothing` -> `NULL`
-else instance Serialize a => Serialize (Maybe a) where
+instance Serialize a => Serialize (Maybe a) where
   serialize (Just a) = serialize a
   serialize Nothing = unsafeSerializeCoerce jsNull
 
 -- | postgres `array`
-else instance Serialize a => Serialize (Array a) where
+instance Serialize a => Serialize (Array a) where
   serialize = unsafeSerializeCoerce <=< traverse serialize
 
-else instance (Ord a, Rep a) => Serialize (Range a) where
+instance (Ord a, Rep a) => Serialize (Range a) where
   serialize =
     map (Raw.unsafeFromForeign <<< unsafeToForeign <<< __rangeRawFromRecord <<< __rangeToRecord)
       <<< traverse serialize
 
-else instance (CustomSerialize a ty) => Serialize a where
-  serialize = customSerialize
-
 instance Deserialize Raw where
   deserialize = pure
 
 -- | `NULL` (always succeeds)
-else instance Deserialize Unit where
+instance Deserialize Unit where
   deserialize _ = pure unit
 
 -- | `NULL` (fails if non-null)
-else instance Deserialize Null where
+instance Deserialize Null where
   deserialize = map (const Null) <<< F.readNullOrUndefined <<< Raw.asForeign
 
 -- | `json`, `jsonb`
-else instance ReadForeign a => Deserialize (JSON a) where
+instance ReadForeign a => Deserialize (JSON a) where
   deserialize = map wrap <<< (hoist (pure <<< unwrap) <<< readJSON') <=< deserialize @String
 
 -- | `bytea`
-else instance Deserialize Buffer where
+instance Deserialize Buffer where
   deserialize = (F.unsafeReadTagged "Buffer") <<< Raw.asForeign
 
 -- | `int2`, `int4`
-else instance Deserialize Int where
+instance Deserialize Int where
   deserialize = F.readInt <<< Raw.asForeign
 
 -- | `int8`
-else instance Deserialize BigInt where
+instance Deserialize BigInt where
   deserialize =
     let
       invalid s = pure $ ForeignError $ "Invalid bigint: " <> s
@@ -162,30 +158,30 @@ else instance Deserialize BigInt where
       fromString <=< deserialize @String
 
 -- | `bool`
-else instance Deserialize Boolean where
+instance Deserialize Boolean where
   deserialize = F.readBoolean <<< Raw.asForeign
 
 -- | `text`, `inet`, `tsquery`, `tsvector`, `uuid`, `xml`, `cidr`, `time`, `timetz`
-else instance Deserialize String where
+instance Deserialize String where
   deserialize = F.readString <<< Raw.asForeign
 
 -- | `float4`, `float8`
-else instance Deserialize Number where
+instance Deserialize Number where
   deserialize = F.readNumber <<< Raw.asForeign
 
 -- | `timestamp`, `timestamptz`
-else instance Deserialize DateTime where
+instance Deserialize DateTime where
   deserialize raw = do
     s :: String <- deserialize raw
     let invalid = pure $ ForeignError $ "Not a valid ISO8601 string: `" <> s <> "`"
     liftMaybe invalid $ DateTime.ISO.toDateTime $ wrap s
 
 -- | postgres `array`
-else instance Deserialize a => Deserialize (Array a) where
+instance Deserialize a => Deserialize (Array a) where
   deserialize = traverse (deserialize <<< Raw.unsafeFromForeign) <=< F.readArray <<< Raw.asForeign
 
 -- | non-NULL -> `Just`, NULL -> `Nothing`
-else instance Deserialize a => Deserialize (Maybe a) where
+instance Deserialize a => Deserialize (Maybe a) where
   deserialize raw =
     let
       nothing = const Nothing <$> deserialize @Null raw
@@ -193,8 +189,5 @@ else instance Deserialize a => Deserialize (Maybe a) where
     in
       just <|> nothing
 
-else instance (Ord a, Rep a) => Deserialize (Range a) where
+instance (Ord a, Rep a) => Deserialize (Range a) where
   deserialize = traverse deserialize <=< map (__rangeFromRecord <<< __rangeRawToRecord) <<< lift <<< __rangeRawFromRaw
-
-else instance (CustomDeserialize a ty) => Deserialize a where
-  deserialize = customDeserialize

test/Test.Data.Postgres.Generic.purs

@@ -9,9 +9,8 @@ import Data.DateTime (DateTime(..))
 import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)
-import Data.Postgres (deserialize, serialize, smash)
-import Data.Postgres.Custom (class CustomDeserialize, class CustomSerialize, customDeserialize)
-import Data.Postgres.Custom.Enum (class CustomEnum, create, enumDeserialize, enumPrintExpr, enumSerialize, genericEnumVariants, genericParseEnum, genericPrintEnum, parseEnum, printEnum)
+import Data.Postgres (class Deserialize, class Serialize, deserialize, serialize, smash)
+import Data.Postgres.Custom.Enum (class CustomEnum, create, defaultDeserializeEnum, defaultSerializeEnum, enumPrintExpr, genericEnumVariants, genericParseEnum, genericPrintEnum, parseEnum, printEnum)
 import Data.Show.Generic (genericShow)
 import Effect.Class (liftEffect)
 import Test.Spec (Spec, describe, it)
@@ -25,12 +24,11 @@ derive instance Eq Enum1
 instance Show Enum1 where
   show = genericShow
 
-instance CustomSerialize Enum1 "enum_1" where
-  customPrintExpr a = enumPrintExpr a
-  customSerialize a = enumSerialize a
+instance Serialize Enum1 where
+  serialize a = defaultSerializeEnum a
 
-instance CustomDeserialize Enum1 "enum_1" where
-  customDeserialize a = enumDeserialize a
+instance Deserialize Enum1 where
+  deserialize a = defaultDeserializeEnum a
 
 instance CustomEnum Enum1 "enum_1" where
   printEnum = genericPrintEnum
@@ -44,12 +42,11 @@ derive instance Eq Enum2
 instance Show Enum2 where
   show = genericShow
 
-instance CustomSerialize Enum2 "enum_2" where
-  customPrintExpr a = enumPrintExpr a
-  customSerialize a = enumSerialize a
+instance Serialize Enum2 where
+  serialize a = defaultSerializeEnum a
 
-instance CustomDeserialize Enum2 "enum_2" where
-  customDeserialize a = enumDeserialize a
+instance Deserialize Enum2 where
+  deserialize a = defaultDeserializeEnum a
 
 instance CustomEnum Enum2 "enum_2" where
   printEnum a = genericPrintEnum a
@@ -63,12 +60,11 @@ derive instance Eq Enum5
 instance Show Enum5 where
   show = genericShow
 
-instance CustomSerialize Enum5 "enum_5" where
-  customPrintExpr a = enumPrintExpr a
-  customSerialize a = enumSerialize a
+instance Serialize Enum5 where
+  serialize a = defaultSerializeEnum a
 
-instance CustomDeserialize Enum5 "enum_5" where
-  customDeserialize a = enumDeserialize a
+instance Deserialize Enum5 where
+  deserialize a = defaultDeserializeEnum a
 
 instance CustomEnum Enum5 "enum_5" where
   printEnum a = genericPrintEnum a