From 87614611dd32a3ba18e65e3045977c55649f8a95 Mon Sep 17 00:00:00 2001 From: Orion Kindel Date: Fri, 5 Apr 2024 22:11:44 -0500 Subject: [PATCH] fix: relax cursor constraints, fix enum test --- src/Control.Monad.Postgres.Cursor.purs | 37 +++++++++++++++++--------- src/Data.Postgres.Custom.Enum.purs | 13 ++++----- src/Data.Postgres.Result.purs | 6 ++--- src/Data.Postgres.Unresult.purs | 8 ++---- test/Test.Data.Postgres.Generic.purs | 14 +++++----- 5 files changed, 43 insertions(+), 35 deletions(-) diff --git a/src/Control.Monad.Postgres.Cursor.purs b/src/Control.Monad.Postgres.Cursor.purs index 1e12589..ba2142b 100644 --- a/src/Control.Monad.Postgres.Cursor.purs +++ b/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) diff --git a/src/Data.Postgres.Custom.Enum.purs b/src/Data.Postgres.Custom.Enum.purs index f9fdbed..8ca8fab 100644 --- a/src/Data.Postgres.Custom.Enum.purs +++ b/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' diff --git a/src/Data.Postgres.Result.purs b/src/Data.Postgres.Result.purs index 732b69f..6637c23 100644 --- a/src/Data.Postgres.Result.purs +++ b/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 diff --git a/src/Data.Postgres.Unresult.purs b/src/Data.Postgres.Unresult.purs index ba80f53..2595cdb 100644 --- a/src/Data.Postgres.Unresult.purs +++ b/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) diff --git a/test/Test.Data.Postgres.Generic.purs b/test/Test.Data.Postgres.Generic.purs index 6f3b657..11cc6c1 100644 --- a/test/Test.Data.Postgres.Generic.purs +++ b/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