Compare commits

...

7 Commits

8 changed files with 264 additions and 124 deletions

View File

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

View File

@ -1,7 +1,7 @@
package:
name: postgresql
publish:
version: '2.0.11'
version: '2.0.15'
license: 'GPL-3.0-or-later'
location:
githubOwner: 'cakekindel'

View File

@ -3,7 +3,6 @@ module Control.Monad.Postgres.Session where
import Prelude hiding (join)
import Control.Monad.Error.Class (class MonadError, catchError, throwError)
import Control.Monad.Fork.Class (class MonadBracket)
import Control.Monad.Morph (hoist)
import Control.Monad.Reader (ask)
import Control.Monad.Trans.Class (lift)
@ -17,9 +16,7 @@ import Effect.Aff.Postgres.Client (Client)
import Effect.Aff.Postgres.Client as Client
import Effect.Aff.Postgres.Pool (Pool)
import Effect.Aff.Postgres.Pool as Pool
import Effect.Aff.Unlift (class MonadUnliftAff)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception as Effect
import Effect.Postgres.Error (RE)
import Effect.Postgres.Error as E
import Effect.Postgres.Error.Except as X

View File

@ -4,6 +4,7 @@ import Prelude
import Control.Monad.Error.Class (class MonadError, class MonadThrow, liftEither, try)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.Morph (hoist)
import Data.Bifunctor (lmap)
import Data.Either (Either)
import Data.Postgres (RepT)
@ -29,11 +30,15 @@ withEither e m = ExceptT $ map (lmap $ pure <<< e) $ m
exception :: forall m a. MonadError Effect.Error m => m a -> Except m a
exception = with Other
parsing :: forall m a. MonadEffect m => Query -> RepT a -> Except m a
parsing q = withEither (Deserializing q) <<< liftEffect <<< runExceptT
printing :: forall m a. MonadEffect m => RepT a -> Except m a
printing = withEither Serializing <<< liftEffect <<< runExceptT
executing :: forall m a. MonadError Effect.Error m => Query -> m a -> Except m a
executing q = with (Executing q)
parsing :: forall m a. MonadEffect m => Query -> RepT a -> Except m a
parsing q m = do
e <- hoist liftEffect $ exception $ runExceptT m
withEither (Deserializing q) (pure e)
printing :: forall m a. MonadEffect m => RepT a -> Except m a
printing m = do
e <- hoist liftEffect $ exception $ runExceptT m
withEither Serializing (pure e)

View File

@ -5,26 +5,32 @@ import Prelude hiding (join)
import Control.Alt (class Alt)
import Control.Alternative (class Alternative, class Plus)
import Control.Monad.Base (class MonadBase)
import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError, liftEither, throwError)
import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError, liftEither, liftMaybe, throwError)
import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class MonadKill, BracketCondition, bracket, fork, join, kill, never, suspend, uninterruptible)
import Control.Monad.Fork.Class (class MonadBracket, class MonadFork, class MonadKill, bracket, fork, join, kill, never, suspend, uninterruptible)
import Control.Monad.Fork.Class as Bracket
import Control.Monad.Morph (class MFunctor, class MMonad, embed, hoist)
import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT(..), runReaderT)
import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT(..), ask, runReaderT)
import Control.Monad.Rec.Class (class MonadRec)
import Control.Monad.Trans.Class (class MonadTrans, lift)
import Control.Monad.Unlift (class MonadUnlift, withRunInBase)
import Control.Monad.Unlift (class MonadUnlift)
import Control.Parallel (class Parallel, parallel, sequential)
import Data.Array.NonEmpty as Array.NonEmpty
import Data.Bifunctor (lmap)
import Data.Either (Either)
import Data.Functor.Compose (Compose)
import Data.Either (Either, blush, hush)
import Data.Functor.Compose (Compose(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype, unwrap, wrap)
import Effect.Aff.Class (class MonadAff)
import Data.Traversable (for_, traverse_)
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Aff.Unlift (class MonadUnliftAff, withRunInAff)
import Effect.Class (class MonadEffect)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception as Effect
import Effect.Exception as Exception
import Effect.Postgres.Error.Common (E, Error(..), toException)
import Effect.Postgres.Error.Except (Except)
import Effect.Postgres.Error.Except as E
import Effect.Ref as Ref
import Effect.Unlift (class MonadUnliftEffect, withRunInEffect)
-- | `ReaderT` with `ExceptT E`
@ -67,10 +73,14 @@ derive newtype instance Monad m => Bind (RE r m)
derive newtype instance Monad m => Monad (RE r m)
derive newtype instance Monad m => MonadError E (RE r m)
derive newtype instance Monad m => MonadThrow E (RE r m)
derive newtype instance MonadEffect m => MonadEffect (RE r m)
derive newtype instance MonadAff m => MonadAff (RE r m)
derive newtype instance MonadRec m => MonadRec (RE r m)
instance MonadEffect m => MonadEffect (RE r m) where
liftEffect m = hoist liftEffect $ liftExcept $ E.exception m
instance MonadAff m => MonadAff (RE r m) where
liftAff m = hoist liftAff $ liftExcept $ E.exception m
instance (Monad m, Parallel p m) => Parallel (ParRE r p) (RE r m) where
parallel = wrap <<< parallel <<< unwrap
sequential = wrap <<< sequential <<< unwrap
@ -101,20 +111,47 @@ instance (MonadBase m (RE r m), MonadThrow Effect.Error m) => MonadUnlift m (RE
instance Monad m => MonadBase m (RE r m) where
liftBase = lift
instance (MonadThrow Effect.Error m, MonadFork f m) => MonadFork f (RE r m) where
fork m = withRunInBase \f -> fork $ f m
suspend m = withRunInBase \f -> suspend $ f m
join f = lift $ join f
instance (MonadThrow Effect.Error m, MonadFork f m) => MonadFork (Compose f (Either E)) (RE r m) where
fork m = RE $ ReaderT \r -> lift $ Compose <$> fork (toEither m r)
suspend m = RE $ ReaderT \r -> lift $ Compose <$> suspend (toEither m r)
join f = liftEither =<< lift (join $ unwrap f)
instance (MonadKill Effect.Error f m) => MonadKill E f (RE r m) where
kill e f = lift $ kill (toException e) f
instance (MonadKill Effect.Error f m) => MonadKill E (Compose f (Either E)) (RE r m) where
kill e f = lift $ kill (toException e) (unwrap f)
instance (MonadBracket Effect.Error f m) => MonadBracket E f (RE r m) where
bracket acq rel m = withRunInBase \f -> bracket (f acq) (\c r -> f $ rel ((bracketCondError (pure <<< Other)) c) r) (f <<< m)
instance (MonadEffect m, MonadBracket Effect.Error f m) => MonadBracket E (Compose f (Either E)) (RE r m) where
bracket acq rel go = do
r <- ask
errs <- liftEffect $ Ref.new []
let
eErrsEmpty = pure $ Other $ Exception.error "no errors"
appendErrs = liftEffect <<< flip Ref.modify_ errs <<< (<>) <<< Array.NonEmpty.toArray
readErrs = liftEffect $ Array.NonEmpty.fromArray <$> Ref.read errs
run' :: forall a. RE r m a -> m (Maybe a)
run' m = do
either <- toEither m r
traverse_ appendErrs $ blush either
pure $ hush either
rel' _ Nothing = pure unit
rel' (Bracket.Failed e) (Just a) = void $ run' $ rel (Bracket.Failed $ pure $ Other e) a
rel' (Bracket.Killed e) (Just a) = void $ run' $ rel (Bracket.Killed $ pure $ Other e) a
rel' (Bracket.Completed (Just ret)) (Just a) = void $ run' $ rel (Bracket.Completed ret) a
rel' (Bracket.Completed Nothing) (Just a) = void $ run' do
errs' <- fromMaybe eErrsEmpty <$> readErrs
rel (Bracket.Failed errs') a
acq' = run' acq
go' (Just a) = run' $ go a
go' Nothing = pure Nothing
ret <- lift $ bracket acq' rel' go'
errs' <- readErrs
for_ errs' throwError
liftMaybe eErrsEmpty ret
uninterruptible = hoist uninterruptible
never = lift never
bracketCondError :: forall ea eb a. (ea -> eb) -> BracketCondition ea a -> BracketCondition eb a
bracketCondError _ (Bracket.Completed a) = Bracket.Completed a
bracketCondError f (Bracket.Failed a) = Bracket.Failed $ f a
bracketCondError f (Bracket.Killed a) = Bracket.Killed $ f a

View File

@ -3,63 +3,27 @@ module Pipes.Postgres where
import Prelude
import Control.Monad.Cont (lift)
import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError, throwError)
import Control.Monad.Morph (hoist)
import Control.Monad.Postgres (PostgresT)
import Control.Monad.Postgres (SessionT)
import Control.Monad.Reader (ask)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe)
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Aff.Postgres.Client as Client
import Effect.Aff.Postgres.Pool as Pool
import Effect.Class (liftEffect)
import Effect.Exception (Error)
import Effect.Postgres.Error.RE as RE
import Node.Buffer (Buffer)
import Node.Stream.Object as O
import Pipes ((>->))
import Node.Stream.Object as Node.Stream.Object
import Pipes.Core (Consumer, Producer)
import Pipes.Node.Stream (fromReadable, fromWritable)
import Pipes.Prelude as Pipes
import Pipes.Node.Stream as Pipe.Node
stdin
:: forall m
. MonadAff m
=> MonadError Error m
=> String
-> Consumer (Maybe Buffer) (PostgresT m) Unit
stdin :: forall m. MonadAff m => String -> Consumer (Maybe Buffer) (SessionT m) Unit
stdin q = do
pool <- lift ask
client <- lift $ RE.liftExcept $ hoist liftAff $ Pool.connect pool
client <- lift ask
stream <- lift $ RE.liftExcept $ hoist liftEffect $ Client.execWithStdin q client
lift $ RE.liftExcept $ hoist liftAff $ void $ Client.exec "begin" client
let
releaseOnEOS Nothing = do
RE.liftExcept $ hoist liftAff $ void $ Client.exec "commit" client
RE.liftExcept $ hoist liftEffect $ Pool.release pool client
pure Nothing
releaseOnEOS (Just a) = pure (Just a)
hoist liftAff $ Pipe.Node.fromWritable $ Node.Stream.Object.unsafeFromBufferWritable stream
pipe = Pipes.mapM releaseOnEOS >-> hoist lift (fromWritable $ O.unsafeFromBufferWritable stream)
err e = lift do
RE.liftExcept $ hoist liftAff $ void $ Client.exec "rollback" client
RE.liftExcept $ hoist liftEffect $ Pool.release pool client
throwError e
catchError pipe err
stdout
:: forall m
. MonadAff m
=> MonadThrow Error m
=> String
-> Producer (Maybe Buffer) (PostgresT m) Unit
stdout :: forall m. MonadAff m => String -> Producer (Maybe Buffer) (SessionT m) Unit
stdout q = do
pool <- lift ask
client <- lift $ RE.liftExcept $ hoist liftAff $ Pool.connect pool
client <- lift ask
stream <- lift $ RE.liftExcept $ hoist liftEffect $ Client.queryWithStdout q client
let
releaseOnEOS :: Maybe Buffer -> PostgresT m (Maybe Buffer)
releaseOnEOS Nothing = RE.liftExcept $ hoist liftEffect $ Pool.release pool client $> Nothing
releaseOnEOS (Just a) = pure (Just a)
hoist lift (fromReadable (O.unsafeFromBufferReadable stream))
>-> Pipes.mapM releaseOnEOS
hoist liftAff $ Pipe.Node.fromReadable $ Node.Stream.Object.unsafeFromBufferReadable stream

View File

@ -0,0 +1,135 @@
module Test.Effect.Postgres.Error where
import Prelude hiding (join)
import Control.Monad.Cont (lift)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Fork.Class (bracket, fork, join)
import Control.Parallel (parOneOf, parSequence)
import Data.Either (isLeft)
import Data.Newtype (wrap)
import Data.Postgres (deserialize)
import Data.Postgres.Query (stringQuery)
import Data.Postgres.Raw (Raw)
import Effect.Aff (Aff, delay)
import Effect.Aff.Class (liftAff)
import Effect.Class (liftEffect)
import Effect.Exception as Exn
import Effect.Postgres.Error (Error(..))
import Effect.Postgres.Error.Except as E
import Effect.Postgres.Error.RE (RE)
import Effect.Postgres.Error.RE as RE
import Test.Common (withPoolClient)
import Test.Spec (Spec, around, describe, it)
import Test.Spec.Assertions (shouldEqual)
import Unsafe.Coerce (unsafeCoerce)
spec :: Spec Unit
spec =
around withPoolClient $ describe "Effect.Postgres.Error" do
describe "Except" do
it "catches Aff" $ const do
either <- E.toEither $ E.exception (throwError $ Exn.error "foo")
isLeft either `shouldEqual` true
it "catches Effect" $ const do
either <- liftEffect $ E.toEither $ E.exception (throwError $ Exn.error "foo")
isLeft either `shouldEqual` true
it "catches RepT" $ const do
let
parse = deserialize @Int (unsafeCoerce "foo" :: Raw)
either <- liftEffect $ E.toEither $ E.parsing (stringQuery "select 'foo'") parse
isLeft either `shouldEqual` true
it "catches Effect exception in RepT" $ const do
let
parse = lift $ throwError $ Exn.error "foo"
either <- liftEffect $ E.toEither $ E.parsing (stringQuery "select 'foo'") parse
isLeft either `shouldEqual` true
describe "RE" do
it "liftAff catches exceptions" $ const do
either <- RE.toEither (liftAff $ throwError $ Exn.error "foo") unit
isLeft either `shouldEqual` true
it "liftEffect catches exceptions" $ const do
either <- RE.toEither (liftEffect $ throwError $ Exn.error "foo") unit
isLeft either `shouldEqual` true
it "liftExcept catches exceptions" $ const do
either <- RE.toEither (throwError $ pure $ Other $ Exn.error "foo") unit
isLeft either `shouldEqual` true
it "fork > join catches Fiber exceptions" $ const do
either <- flip RE.toEither unit do
fiber <- fork (liftAff $ throwError $ Exn.error "foo") :: RE Unit Aff _
liftAff $ delay $ wrap 1.0
join fiber
isLeft either `shouldEqual` true
it "bracket catches error in acq" $ const do
either <-
flip RE.toEither unit
$ bracket
(liftAff $ throwError $ Exn.error "foo")
(const $ const $ pure unit)
(const $ pure unit)
isLeft either `shouldEqual` true
it "bracket catches error in rel" $ const do
either <-
flip RE.toEither unit
$ bracket
(pure unit)
(const $ const $ liftAff $ throwError $ Exn.error "foo")
(const $ pure unit)
isLeft either `shouldEqual` true
it "bracket catches error in go" $ const do
either <-
flip RE.toEither unit
$ bracket
(pure unit)
(const $ const $ pure unit)
(const $ liftAff $ throwError $ Exn.error "foo")
isLeft either `shouldEqual` true
it "forked bracket catches error in acq" $ const do
either <- flip RE.toEither unit do
fiber <-
fork
$ bracket
(liftAff $ throwError $ Exn.error "foo")
(const $ const $ pure unit)
(const $ pure unit)
liftAff $ delay $ wrap 1.0
join fiber
isLeft either `shouldEqual` true
it "forked bracket catches error in rel" $ const do
either <- flip RE.toEither unit do
fiber <-
fork
$ bracket
(pure unit)
(const $ const $ liftAff $ throwError $ Exn.error "foo")
(const $ pure unit)
liftAff $ delay $ wrap 1.0
join fiber
isLeft either `shouldEqual` true
it "forked bracket catches error in go" $ const do
either <- flip RE.toEither unit do
fiber <-
fork
$ bracket
(pure unit)
(const $ const $ pure unit)
(const $ liftAff $ throwError $ Exn.error "foo")
liftAff $ delay $ wrap 1.0
join fiber
isLeft either `shouldEqual` true
it "catches errors in `parSequence`" $ const do
either <-
flip RE.toEither unit
$ parSequence
$ [ liftAff $ throwError $ Exn.error "a"
, pure "a"
]
isLeft either `shouldEqual` true
it "catches errors in `parOneOf`" $ const do
either <-
flip RE.toEither unit
$ parOneOf
$ [ liftAff $ throwError $ Exn.error "a"
, liftAff $ throwError $ Exn.error "b"
]
isLeft either `shouldEqual` true

View File

@ -25,6 +25,7 @@ import Test.Data.Postgres as Test.Data.Postgres
import Test.Data.Postgres.Custom as Test.Data.Postgres.Custom
import Test.Data.Postgres.Interval as Test.Data.Postgres.Interval
import Test.Effect.Postgres.Client as Test.Effect.Postgres.Client
import Test.Effect.Postgres.Error as Test.Effect.Postgres.Error
import Test.Effect.Postgres.Pool as Test.Effect.Postgres.Pool
import Test.Spec.Reporter (specReporter)
import Test.Spec.Runner (runSpec)
@ -64,6 +65,7 @@ main = launchAff_ do
bracket spawnDb killDb
$ const
$ runSpec [ specReporter ] do
Test.Effect.Postgres.Error.spec
Test.Data.Postgres.Custom.spec
Test.Data.Postgres.spec
Test.Data.Postgres.Interval.spec