fix: relax cursor constraints, fix enum test

src/Control.Monad.Postgres.Cursor.purs

@@ -8,21 +8,25 @@ import Control.Monad.Error.Class (class MonadError, class MonadThrow)
 import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class MonadKill, bracket, kill, never, uninterruptible)
 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.Reader (class MonadAsk, class MonadReader, ReaderT, ask, local, mapReader, runReaderT, withReader, withReaderT)
 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 (class Deserialize, RepT, deserialize, 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)
@@ -46,10 +50,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 +82,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
@@ -104,8 +110,13 @@ 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. 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 =
+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,6 +5,7 @@ import Prelude
 import Control.Alt ((<|>))
 import Control.Monad.Error.Class (liftMaybe)
 import Data.Array.NonEmpty.Internal (NonEmptyArray)
+import Data.Bifunctor (lmap)
 import Data.Foldable (intercalate)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep as G
@@ -17,7 +18,7 @@ import Data.Postgres.Raw (Raw)
 import Data.Symbol (class IsSymbol)
 import Data.Traversable (find)
 import Data.Tuple (fst, snd)
-import Data.Tuple.Nested (type (/\))
+import Data.Tuple.Nested (type (/\), (/\))
 import Foreign (ForeignError(..))
 import Type.Prelude (Proxy(..), reflectSymbol)
 
@@ -45,19 +46,19 @@ 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
@@ -65,8 +66,8 @@ instance (GenericCustomEnum a, GenericCustomEnum b) => GenericCustomEnum (G.Sum
 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'

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

@@ -3,14 +3,10 @@ module Data.Postgres.Unresult where
 import Prelude
 
 import Control.Monad.Error.Class (class MonadThrow, liftMaybe)
-import Control.Monad.Morph (hoist)
-import Control.Monad.State (StateT(..), runStateT, state)
-import Control.Monad.Trans.Class (lift)
+import Control.Monad.State (StateT, runStateT, state)
 import Data.Array as Array
-import Data.Maybe (fromMaybe, maybe)
-import Data.Postgres (class Deserialize, class Rep, RepT, deserialize, smash)
+import Data.Postgres (class Deserialize, deserialize, smash)
 import Data.Postgres.Raw (Raw)
-import Data.Postgres.Result (fromRow)
 import Data.Tuple (fst)
 import Data.Tuple.Nested ((/\))
 import Effect.Aff (error)

test/Test.Data.Postgres.Generic.purs

@@ -10,7 +10,7 @@ import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)
 import Data.Postgres (class Deserialize, class Serialize, deserialize, serialize, smash)
-import Data.Postgres.Custom.Enum (class CustomEnum, create, enumDeserialize, enumPrintExpr, enumSerialize, genericEnumVariants, genericParseEnum, genericPrintEnum, parseEnum, printEnum)
+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,10 +25,10 @@ instance Show Enum1 where
   show = genericShow
 
 instance Serialize Enum1 where
-  serialize a = enumSerialize a
+  serialize a = defaultSerializeEnum a
 
 instance Deserialize Enum1 where
-  deserialize a = enumDeserialize a
+  deserialize a = defaultDeserializeEnum a
 
 instance CustomEnum Enum1 "enum_1" where
   printEnum = genericPrintEnum
@@ -43,10 +43,10 @@ instance Show Enum2 where
   show = genericShow
 
 instance Serialize Enum2 where
-  serialize a = enumSerialize a
+  serialize a = defaultSerializeEnum a
 
 instance Deserialize Enum2 where
-  deserialize a = enumDeserialize a
+  deserialize a = defaultDeserializeEnum a
 
 instance CustomEnum Enum2 "enum_2" where
   printEnum a = genericPrintEnum a
@@ -61,10 +61,10 @@ instance Show Enum5 where
   show = genericShow
 
 instance Serialize Enum5 where
-  serialize a = enumSerialize a
+  serialize a = defaultSerializeEnum a
 
 instance Deserialize Enum5 where
-  deserialize a = enumDeserialize a
+  deserialize a = defaultDeserializeEnum a
 
 instance CustomEnum Enum5 "enum_5" where
   printEnum a = genericPrintEnum a