mirror of
https://github.com/nikita-volkov/hasql.git
synced 2024-12-28 04:57:14 +03:00
Pragmas
This commit is contained in:
parent
4d9f3b90f5
commit
3dd489bc5f
@ -43,10 +43,12 @@ data Error =
|
|||||||
UnexpectedAmountOfRows !Int
|
UnexpectedAmountOfRows !Int
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
{-# INLINE run #-}
|
||||||
run :: Result a -> (Bool, LibPQ.Result) -> IO (Either Error a)
|
run :: Result a -> (Bool, LibPQ.Result) -> IO (Either Error a)
|
||||||
run (Result reader) env =
|
run (Result reader) env =
|
||||||
runEitherT (runReaderT reader env)
|
runEitherT (runReaderT reader env)
|
||||||
|
|
||||||
|
{-# INLINE unit #-}
|
||||||
unit :: Result ()
|
unit :: Result ()
|
||||||
unit =
|
unit =
|
||||||
checkExecStatus $ \case
|
checkExecStatus $ \case
|
||||||
@ -54,6 +56,7 @@ unit =
|
|||||||
LibPQ.TuplesOk -> True
|
LibPQ.TuplesOk -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
|
{-# INLINE rowsAffected #-}
|
||||||
rowsAffected :: Result Int64
|
rowsAffected :: Result Int64
|
||||||
rowsAffected =
|
rowsAffected =
|
||||||
do
|
do
|
||||||
@ -76,8 +79,10 @@ rowsAffected =
|
|||||||
mapLeft (\m -> UnexpectedResult ("Decimal parsing failure: " <> fromString m)) $
|
mapLeft (\m -> UnexpectedResult ("Decimal parsing failure: " <> fromString m)) $
|
||||||
Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) bytes
|
Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) bytes
|
||||||
|
|
||||||
|
{-# INLINE checkExecStatus #-}
|
||||||
checkExecStatus :: (LibPQ.ExecStatus -> Bool) -> Result ()
|
checkExecStatus :: (LibPQ.ExecStatus -> Bool) -> Result ()
|
||||||
checkExecStatus predicate =
|
checkExecStatus predicate =
|
||||||
|
{-# SCC "checkExecStatus" #-}
|
||||||
do
|
do
|
||||||
status <- Result $ ReaderT $ \(_, result) -> lift $ LibPQ.resultStatus result
|
status <- Result $ ReaderT $ \(_, result) -> lift $ LibPQ.resultStatus result
|
||||||
unless (predicate status) $ do
|
unless (predicate status) $ do
|
||||||
@ -87,6 +92,7 @@ checkExecStatus predicate =
|
|||||||
LibPQ.FatalError -> serverError
|
LibPQ.FatalError -> serverError
|
||||||
_ -> Result $ lift $ EitherT $ pure $ Left $ UnexpectedResult $ "Unexpected result status: " <> (fromString $ show status)
|
_ -> Result $ lift $ EitherT $ pure $ Left $ UnexpectedResult $ "Unexpected result status: " <> (fromString $ show status)
|
||||||
|
|
||||||
|
{-# INLINE serverError #-}
|
||||||
serverError :: Result ()
|
serverError :: Result ()
|
||||||
serverError =
|
serverError =
|
||||||
Result $ ReaderT $ \(_, result) -> EitherT $ do
|
Result $ ReaderT $ \(_, result) -> EitherT $ do
|
||||||
@ -102,6 +108,7 @@ serverError =
|
|||||||
LibPQ.resultErrorField result LibPQ.DiagMessageHint
|
LibPQ.resultErrorField result LibPQ.DiagMessageHint
|
||||||
pure $ Left $ ServerError code message detail hint
|
pure $ Left $ ServerError code message detail hint
|
||||||
|
|
||||||
|
{-# INLINE maybe #-}
|
||||||
maybe :: Row.Row a -> Result (Maybe a)
|
maybe :: Row.Row a -> Result (Maybe a)
|
||||||
maybe rowDes =
|
maybe rowDes =
|
||||||
do
|
do
|
||||||
@ -122,6 +129,7 @@ maybe rowDes =
|
|||||||
intToRow =
|
intToRow =
|
||||||
LibPQ.Row . fromIntegral
|
LibPQ.Row . fromIntegral
|
||||||
|
|
||||||
|
{-# INLINE single #-}
|
||||||
single :: Row.Row a -> Result a
|
single :: Row.Row a -> Result a
|
||||||
single rowDes =
|
single rowDes =
|
||||||
do
|
do
|
||||||
@ -141,8 +149,10 @@ single rowDes =
|
|||||||
intToRow =
|
intToRow =
|
||||||
LibPQ.Row . fromIntegral
|
LibPQ.Row . fromIntegral
|
||||||
|
|
||||||
|
{-# INLINE generate #-}
|
||||||
generate :: (forall m. Monad m => Int -> (Int -> m a) -> m b) -> Row.Row a -> Result b
|
generate :: (forall m. Monad m => Int -> (Int -> m a) -> m b) -> Row.Row a -> Result b
|
||||||
generate generateM rowDes =
|
generate generateM rowDes =
|
||||||
|
{-# SCC "generate" #-}
|
||||||
do
|
do
|
||||||
checkExecStatus $ \case
|
checkExecStatus $ \case
|
||||||
LibPQ.TuplesOk -> True
|
LibPQ.TuplesOk -> True
|
||||||
@ -159,8 +169,10 @@ generate generateM rowDes =
|
|||||||
intToRow =
|
intToRow =
|
||||||
LibPQ.Row . fromIntegral
|
LibPQ.Row . fromIntegral
|
||||||
|
|
||||||
|
{-# INLINE foldl #-}
|
||||||
foldl :: (a -> b -> a) -> a -> Row.Row b -> Result a
|
foldl :: (a -> b -> a) -> a -> Row.Row b -> Result a
|
||||||
foldl step init rowDes =
|
foldl step init rowDes =
|
||||||
|
{-# SCC "foldl" #-}
|
||||||
do
|
do
|
||||||
checkExecStatus $ \case
|
checkExecStatus $ \case
|
||||||
LibPQ.TuplesOk -> True
|
LibPQ.TuplesOk -> True
|
||||||
@ -181,6 +193,7 @@ foldl step init rowDes =
|
|||||||
intToRow =
|
intToRow =
|
||||||
LibPQ.Row . fromIntegral
|
LibPQ.Row . fromIntegral
|
||||||
|
|
||||||
|
{-# INLINE foldr #-}
|
||||||
foldr :: (b -> a -> a) -> a -> Row.Row b -> Result a
|
foldr :: (b -> a -> a) -> a -> Row.Row b -> Result a
|
||||||
foldr step init rowDes =
|
foldr step init rowDes =
|
||||||
do
|
do
|
||||||
|
@ -42,7 +42,7 @@ clientError =
|
|||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- Parse a single result.
|
-- Parse a single result.
|
||||||
{-# INLINABLE single #-}
|
{-# INLINE single #-}
|
||||||
single :: Result.Result a -> Results a
|
single :: Result.Result a -> Results a
|
||||||
single resultDes =
|
single resultDes =
|
||||||
Results $ ReaderT $ \(integerDatetimes, connection) -> EitherT $ do
|
Results $ ReaderT $ \(integerDatetimes, connection) -> EitherT $ do
|
||||||
|
@ -22,19 +22,23 @@ data Error =
|
|||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
|
||||||
|
{-# INLINE run #-}
|
||||||
run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either Error a)
|
run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either Error a)
|
||||||
run (Row m) env =
|
run (Row m) env =
|
||||||
flip evalStateT 0 (flip runReaderT env (runEitherT m))
|
flip evalStateT 0 (flip runReaderT env (runEitherT m))
|
||||||
|
|
||||||
|
|
||||||
|
{-# INLINE error #-}
|
||||||
error :: Error -> Row a
|
error :: Error -> Row a
|
||||||
error x =
|
error x =
|
||||||
Row (EitherT (return (Left x)))
|
Row (EitherT (return (Left x)))
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- Next value, decoded using the provided value deserializer.
|
-- Next value, decoded using the provided value deserializer.
|
||||||
|
{-# INLINE value #-}
|
||||||
value :: Value.Value a -> Row (Maybe a)
|
value :: Value.Value a -> Row (Maybe a)
|
||||||
value valueDes =
|
value valueDes =
|
||||||
|
{-# SCC "value" #-}
|
||||||
Row $ EitherT $ ReaderT $ \(result, row, maxCol, integerDatetimes) -> StateT $ \col ->
|
Row $ EitherT $ ReaderT $ \(result, row, maxCol, integerDatetimes) -> StateT $ \col ->
|
||||||
if col < maxCol
|
if col < maxCol
|
||||||
then
|
then
|
||||||
@ -45,6 +49,8 @@ value valueDes =
|
|||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- Next value, decoded using the provided value deserializer.
|
-- Next value, decoded using the provided value deserializer.
|
||||||
|
{-# INLINE nonNullValue #-}
|
||||||
nonNullValue :: Value.Value a -> Row a
|
nonNullValue :: Value.Value a -> Row a
|
||||||
nonNullValue valueDes =
|
nonNullValue valueDes =
|
||||||
|
{-# SCC "nonNullValue" #-}
|
||||||
value valueDes >>= maybe (error UnexpectedNull) pure
|
value valueDes >>= maybe (error UnexpectedNull) pure
|
||||||
|
@ -18,5 +18,6 @@ run (Value imp) integerDatetimes =
|
|||||||
{-# INLINE decoder #-}
|
{-# INLINE decoder #-}
|
||||||
decoder :: (Bool -> Decoder.Decoder a) -> Value a
|
decoder :: (Bool -> Decoder.Decoder a) -> Value a
|
||||||
decoder =
|
decoder =
|
||||||
|
{-# SCC "decoder" #-}
|
||||||
Value . ReaderT
|
Value . ReaderT
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user