module Hasql.Private.Decoders.Result where

import Hasql.Private.Prelude hiding (maybe, many)
import Hasql.Private.Errors
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Hasql.Private.Decoders.Row as Row
import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec
import qualified Data.ByteString as ByteString
import qualified Hasql.Private.Prelude as Prelude
import qualified Data.Vector as Vector
import qualified Data.Vector.Mutable as MutableVector


newtype Result a =
  Result (ReaderT (Bool, LibPQ.Result) (ExceptT ResultError IO) a)
  deriving (a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor, Functor Result
a -> Result a
Functor Result
-> (forall a. a -> Result a)
-> (forall a b. Result (a -> b) -> Result a -> Result b)
-> (forall a b c.
    (a -> b -> c) -> Result a -> Result b -> Result c)
-> (forall a b. Result a -> Result b -> Result b)
-> (forall a b. Result a -> Result b -> Result a)
-> Applicative Result
Result a -> Result b -> Result b
Result a -> Result b -> Result a
Result (a -> b) -> Result a -> Result b
(a -> b -> c) -> Result a -> Result b -> Result c
forall a. a -> Result a
forall a b. Result a -> Result b -> Result a
forall a b. Result a -> Result b -> Result b
forall a b. Result (a -> b) -> Result a -> Result b
forall a b c. (a -> b -> c) -> Result a -> Result b -> Result c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Result a -> Result b -> Result a
$c<* :: forall a b. Result a -> Result b -> Result a
*> :: Result a -> Result b -> Result b
$c*> :: forall a b. Result a -> Result b -> Result b
liftA2 :: (a -> b -> c) -> Result a -> Result b -> Result c
$cliftA2 :: forall a b c. (a -> b -> c) -> Result a -> Result b -> Result c
<*> :: Result (a -> b) -> Result a -> Result b
$c<*> :: forall a b. Result (a -> b) -> Result a -> Result b
pure :: a -> Result a
$cpure :: forall a. a -> Result a
$cp1Applicative :: Functor Result
Applicative, Applicative Result
a -> Result a
Applicative Result
-> (forall a b. Result a -> (a -> Result b) -> Result b)
-> (forall a b. Result a -> Result b -> Result b)
-> (forall a. a -> Result a)
-> Monad Result
Result a -> (a -> Result b) -> Result b
Result a -> Result b -> Result b
forall a. a -> Result a
forall a b. Result a -> Result b -> Result b
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Result a
$creturn :: forall a. a -> Result a
>> :: Result a -> Result b -> Result b
$c>> :: forall a b. Result a -> Result b -> Result b
>>= :: Result a -> (a -> Result b) -> Result b
$c>>= :: forall a b. Result a -> (a -> Result b) -> Result b
$cp1Monad :: Applicative Result
Monad)

{-# INLINE run #-}
run :: Result a -> (Bool, LibPQ.Result) -> IO (Either ResultError a)
run :: Result a -> (Bool, Result) -> IO (Either ResultError a)
run (Result ReaderT (Bool, Result) (ExceptT ResultError IO) a
reader) (Bool, Result)
env =
  ExceptT ResultError IO a -> IO (Either ResultError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT (Bool, Result) (ExceptT ResultError IO) a
-> (Bool, Result) -> ExceptT ResultError IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Bool, Result) (ExceptT ResultError IO) a
reader (Bool, Result)
env)

{-# INLINE noResult #-}
noResult :: Result ()
noResult :: Result ()
noResult =
  (ExecStatus -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
    ExecStatus
LibPQ.CommandOk -> Bool
True
    ExecStatus
LibPQ.TuplesOk -> Bool
True
    ExecStatus
_ -> Bool
False

{-# INLINE rowsAffected #-}
rowsAffected :: Result Int64
rowsAffected :: Result Int64
rowsAffected =
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.CommandOk -> Bool
True
      ExecStatus
_ -> Bool
False
    ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
-> Result Int64
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
 -> Result Int64)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
-> Result Int64
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO Int64)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Bool, Result) -> ExceptT ResultError IO Int64)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) Int64)
-> ((Bool, Result) -> ExceptT ResultError IO Int64)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) Int64
forall a b. (a -> b) -> a -> b
$ \(Bool
_, Result
result) -> IO (Either ResultError Int64) -> ExceptT ResultError IO Int64
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError Int64) -> ExceptT ResultError IO Int64)
-> IO (Either ResultError Int64) -> ExceptT ResultError IO Int64
forall a b. (a -> b) -> a -> b
$
      Result -> IO (Maybe ByteString)
LibPQ.cmdTuples Result
result IO (Maybe ByteString)
-> (IO (Maybe ByteString) -> IO (Either ResultError Int64))
-> IO (Either ResultError Int64)
forall a b. a -> (a -> b) -> b
& (Maybe ByteString -> Either ResultError Int64)
-> IO (Maybe ByteString) -> IO (Either ResultError Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ByteString -> Either ResultError Int64
forall c. Integral c => Maybe ByteString -> Either ResultError c
cmdTuplesReader
  where
    cmdTuplesReader :: Maybe ByteString -> Either ResultError c
cmdTuplesReader =
      Maybe ByteString -> Either ResultError ByteString
forall b. Maybe b -> Either ResultError b
notNothing (Maybe ByteString -> Either ResultError ByteString)
-> (ByteString -> Either ResultError c)
-> Maybe ByteString
-> Either ResultError c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either ResultError ByteString
notEmpty (ByteString -> Either ResultError ByteString)
-> (ByteString -> Either ResultError c)
-> ByteString
-> Either ResultError c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either ResultError c
forall b. Integral b => ByteString -> Either ResultError b
decimal
      where
        notNothing :: Maybe b -> Either ResultError b
notNothing =
          Either ResultError b
-> (b -> Either ResultError b) -> Maybe b -> Either ResultError b
forall b a. b -> (a -> b) -> Maybe a -> b
Prelude.maybe (ResultError -> Either ResultError b
forall a b. a -> Either a b
Left (Text -> ResultError
UnexpectedResult Text
"No bytes")) b -> Either ResultError b
forall a b. b -> Either a b
Right
        notEmpty :: ByteString -> Either ResultError ByteString
notEmpty ByteString
bytes =
          if ByteString -> Bool
ByteString.null ByteString
bytes
            then ResultError -> Either ResultError ByteString
forall a b. a -> Either a b
Left (Text -> ResultError
UnexpectedResult Text
"Empty bytes")
            else ByteString -> Either ResultError ByteString
forall a b. b -> Either a b
Right ByteString
bytes
        decimal :: ByteString -> Either ResultError b
decimal ByteString
bytes =
          (String -> ResultError) -> Either String b -> Either ResultError b
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (\String
m -> Text -> ResultError
UnexpectedResult (Text
"Decimal parsing failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString String
m)) (Either String b -> Either ResultError b)
-> Either String b -> Either ResultError b
forall a b. (a -> b) -> a -> b
$
          Parser b -> ByteString -> Either String b
forall a. Parser a -> ByteString -> Either String a
Attoparsec.parseOnly (Parser b
forall a. Integral a => Parser a
Attoparsec.decimal Parser b -> Parser ByteString () -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
Attoparsec.endOfInput) ByteString
bytes

{-# INLINE checkExecStatus #-}
checkExecStatus :: (LibPQ.ExecStatus -> Bool) -> Result ()
checkExecStatus :: (ExecStatus -> Bool) -> Result ()
checkExecStatus ExecStatus -> Bool
predicate =
  {-# SCC "checkExecStatus" #-} 
  do
    ExecStatus
status <- ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
-> Result ExecStatus
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
 -> Result ExecStatus)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
-> Result ExecStatus
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO ExecStatus)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Bool, Result) -> ExceptT ResultError IO ExecStatus)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus)
-> ((Bool, Result) -> ExceptT ResultError IO ExecStatus)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ExecStatus
forall a b. (a -> b) -> a -> b
$ \(Bool
_, Result
result) -> IO ExecStatus -> ExceptT ResultError IO ExecStatus
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ExecStatus -> ExceptT ResultError IO ExecStatus)
-> IO ExecStatus -> ExceptT ResultError IO ExecStatus
forall a b. (a -> b) -> a -> b
$ Result -> IO ExecStatus
LibPQ.resultStatus Result
result
    Bool -> Result () -> Result ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExecStatus -> Bool
predicate ExecStatus
status) (Result () -> Result ()) -> Result () -> Result ()
forall a b. (a -> b) -> a -> b
$ do
      case ExecStatus
status of
        ExecStatus
LibPQ.BadResponse   -> Result ()
serverError
        ExecStatus
LibPQ.NonfatalError -> Result ()
serverError
        ExecStatus
LibPQ.FatalError    -> Result ()
serverError
        ExecStatus
_ -> ReaderT (Bool, Result) (ExceptT ResultError IO) () -> Result ()
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) () -> Result ())
-> ReaderT (Bool, Result) (ExceptT ResultError IO) () -> Result ()
forall a b. (a -> b) -> a -> b
$ ExceptT ResultError IO ()
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ResultError IO ()
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) ())
-> ExceptT ResultError IO ()
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ()
forall a b. (a -> b) -> a -> b
$ IO (Either ResultError ()) -> ExceptT ResultError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError ()) -> ExceptT ResultError IO ())
-> IO (Either ResultError ()) -> ExceptT ResultError IO ()
forall a b. (a -> b) -> a -> b
$ Either ResultError () -> IO (Either ResultError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResultError () -> IO (Either ResultError ()))
-> Either ResultError () -> IO (Either ResultError ())
forall a b. (a -> b) -> a -> b
$ ResultError -> Either ResultError ()
forall a b. a -> Either a b
Left (ResultError -> Either ResultError ())
-> ResultError -> Either ResultError ()
forall a b. (a -> b) -> a -> b
$ Text -> ResultError
UnexpectedResult (Text -> ResultError) -> Text -> ResultError
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected result status: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ExecStatus -> String
forall a. Show a => a -> String
show ExecStatus
status)

{-# INLINE serverError #-}
serverError :: Result ()
serverError :: Result ()
serverError =
  ReaderT (Bool, Result) (ExceptT ResultError IO) () -> Result ()
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) () -> Result ())
-> ReaderT (Bool, Result) (ExceptT ResultError IO) () -> Result ()
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO ())
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Bool, Result) -> ExceptT ResultError IO ())
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) ())
-> ((Bool, Result) -> ExceptT ResultError IO ())
-> ReaderT (Bool, Result) (ExceptT ResultError IO) ()
forall a b. (a -> b) -> a -> b
$ \(Bool
_, Result
result) -> IO (Either ResultError ()) -> ExceptT ResultError IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError ()) -> ExceptT ResultError IO ())
-> IO (Either ResultError ()) -> ExceptT ResultError IO ()
forall a b. (a -> b) -> a -> b
$ do
    ByteString
code <- 
      (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ByteString -> ByteString
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (IO (Maybe ByteString) -> IO ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$
      Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagSqlstate
    ByteString
message <- 
      (Maybe ByteString -> ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe ByteString -> ByteString
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (IO (Maybe ByteString) -> IO ByteString)
-> IO (Maybe ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$
      Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagMessagePrimary
    Maybe ByteString
detail <- 
      Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagMessageDetail
    Maybe ByteString
hint <- 
      Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagMessageHint
    Either ResultError () -> IO (Either ResultError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResultError () -> IO (Either ResultError ()))
-> Either ResultError () -> IO (Either ResultError ())
forall a b. (a -> b) -> a -> b
$ ResultError -> Either ResultError ()
forall a b. a -> Either a b
Left (ResultError -> Either ResultError ())
-> ResultError -> Either ResultError ()
forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> Maybe ByteString
-> Maybe ByteString
-> ResultError
ServerError ByteString
code ByteString
message Maybe ByteString
detail Maybe ByteString
hint

{-# INLINE maybe #-}
maybe :: Row.Row a -> Result (Maybe a)
maybe :: Row a -> Result (Maybe a)
maybe Row a
rowDec =
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
-> Result (Maybe a)
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
 -> Result (Maybe a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
-> Result (Maybe a)
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO (Maybe a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Bool, Result) -> ExceptT ResultError IO (Maybe a))
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a))
-> ((Bool, Result) -> ExceptT ResultError IO (Maybe a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> IO (Either ResultError (Maybe a))
-> ExceptT ResultError IO (Maybe a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError (Maybe a))
 -> ExceptT ResultError IO (Maybe a))
-> IO (Either ResultError (Maybe a))
-> ExceptT ResultError IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
      Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
      case Row
maxRows of
        Row
0 -> Either ResultError (Maybe a) -> IO (Either ResultError (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Either ResultError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing)
        Row
1 -> do
          Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
          (Either RowError a -> Either ResultError (Maybe a))
-> IO (Either RowError a) -> IO (Either ResultError (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe a)
-> Either ResultError a -> Either ResultError (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either ResultError a -> Either ResultError (Maybe a))
-> (Either RowError a -> Either ResultError a)
-> Either RowError a
-> Either ResultError (Maybe a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (RowError -> ResultError)
-> Either RowError a -> Either ResultError a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (Int -> RowError -> ResultError
RowError Int
0)) (IO (Either RowError a) -> IO (Either ResultError (Maybe a)))
-> IO (Either RowError a) -> IO (Either ResultError (Maybe a))
forall a b. (a -> b) -> a -> b
$ Row a -> (Result, Row, Column, Bool) -> IO (Either RowError a)
forall a.
Row a -> (Result, Row, Column, Bool) -> IO (Either RowError a)
Row.run Row a
rowDec (Result
result, Row
0, Column
maxCols, Bool
integerDatetimes)
        Row
_ -> Either ResultError (Maybe a) -> IO (Either ResultError (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultError -> Either ResultError (Maybe a)
forall a b. a -> Either a b
Left (Int -> ResultError
UnexpectedAmountOfRows (Row -> Int
forall b. Num b => Row -> b
rowToInt Row
maxRows)))
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row (CInt -> Row) -> (a -> CInt) -> a -> Row
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE single #-}
single :: Row.Row a -> Result a
single :: Row a -> Result a
single Row a
rowDec =
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Bool, Result) -> ExceptT ResultError IO a)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) a)
-> ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> IO (Either ResultError a) -> ExceptT ResultError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError a) -> ExceptT ResultError IO a)
-> IO (Either ResultError a) -> ExceptT ResultError IO a
forall a b. (a -> b) -> a -> b
$ do
      Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
      case Row
maxRows of
        Row
1 -> do
          Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
          (Either RowError a -> Either ResultError a)
-> IO (Either RowError a) -> IO (Either ResultError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RowError -> ResultError)
-> Either RowError a -> Either ResultError a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (Int -> RowError -> ResultError
RowError Int
0)) (IO (Either RowError a) -> IO (Either ResultError a))
-> IO (Either RowError a) -> IO (Either ResultError a)
forall a b. (a -> b) -> a -> b
$ Row a -> (Result, Row, Column, Bool) -> IO (Either RowError a)
forall a.
Row a -> (Result, Row, Column, Bool) -> IO (Either RowError a)
Row.run Row a
rowDec (Result
result, Row
0, Column
maxCols, Bool
integerDatetimes)
        Row
_ -> Either ResultError a -> IO (Either ResultError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultError -> Either ResultError a
forall a b. a -> Either a b
Left (Int -> ResultError
UnexpectedAmountOfRows (Row -> Int
forall b. Num b => Row -> b
rowToInt Row
maxRows)))
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row (CInt -> Row) -> (a -> CInt) -> a -> Row
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE vector #-}
vector :: Row.Row a -> Result (Vector a)
vector :: Row a -> Result (Vector a)
vector Row a
rowDec =
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
-> Result (Vector a)
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
 -> Result (Vector a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
-> Result (Vector a)
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO (Vector a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Bool, Result) -> ExceptT ResultError IO (Vector a))
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a))
-> ((Bool, Result) -> ExceptT ResultError IO (Vector a))
-> ReaderT (Bool, Result) (ExceptT ResultError IO) (Vector a)
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> IO (Either ResultError (Vector a))
-> ExceptT ResultError IO (Vector a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError (Vector a))
 -> ExceptT ResultError IO (Vector a))
-> IO (Either ResultError (Vector a))
-> ExceptT ResultError IO (Vector a)
forall a b. (a -> b) -> a -> b
$ do
      Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
      Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
      MVector RealWorld a
mvector <- Int -> IO (MVector (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
MutableVector.unsafeNew (Row -> Int
forall b. Num b => Row -> b
rowToInt Row
maxRows)
      IORef (Maybe ResultError)
failureRef <- Maybe ResultError -> IO (IORef (Maybe ResultError))
forall a. a -> IO (IORef a)
newIORef Maybe ResultError
forall a. Maybe a
Nothing
      Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m ()
forMFromZero_ (Row -> Int
forall b. Num b => Row -> b
rowToInt Row
maxRows) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
rowIndex -> do
        Either RowError a
rowResult <- Row a -> (Result, Row, Column, Bool) -> IO (Either RowError a)
forall a.
Row a -> (Result, Row, Column, Bool) -> IO (Either RowError a)
Row.run Row a
rowDec (Result
result, Int -> Row
forall a. Integral a => a -> Row
intToRow Int
rowIndex, Column
maxCols, Bool
integerDatetimes)
        case Either RowError a
rowResult of
          Left !RowError
x -> IORef (Maybe ResultError) -> Maybe ResultError -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ResultError)
failureRef (ResultError -> Maybe ResultError
forall a. a -> Maybe a
Just (Int -> RowError -> ResultError
RowError Int
rowIndex RowError
x))
          Right !a
x -> MVector (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
MutableVector.unsafeWrite MVector RealWorld a
MVector (PrimState IO) a
mvector Int
rowIndex a
x
      IORef (Maybe ResultError) -> IO (Maybe ResultError)
forall a. IORef a -> IO a
readIORef IORef (Maybe ResultError)
failureRef IO (Maybe ResultError)
-> (Maybe ResultError -> IO (Either ResultError (Vector a)))
-> IO (Either ResultError (Vector a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe ResultError
Nothing -> Vector a -> Either ResultError (Vector a)
forall a b. b -> Either a b
Right (Vector a -> Either ResultError (Vector a))
-> IO (Vector a) -> IO (Either ResultError (Vector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState IO) a -> IO (Vector a)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.unsafeFreeze MVector RealWorld a
MVector (PrimState IO) a
mvector
        Just ResultError
x -> Either ResultError (Vector a) -> IO (Either ResultError (Vector a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultError -> Either ResultError (Vector a)
forall a b. a -> Either a b
Left ResultError
x)
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row (CInt -> Row) -> (a -> CInt) -> a -> Row
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE foldl #-}
foldl :: (a -> b -> a) -> a -> Row.Row b -> Result a
foldl :: (a -> b -> a) -> a -> Row b -> Result a
foldl a -> b -> a
step a
init Row b
rowDec =
  {-# SCC "foldl" #-} 
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Bool, Result) -> ExceptT ResultError IO a)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) a)
-> ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> IO (Either ResultError a) -> ExceptT ResultError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError a) -> ExceptT ResultError IO a)
-> IO (Either ResultError a) -> ExceptT ResultError IO a
forall a b. (a -> b) -> a -> b
$ {-# SCC "traversal" #-} do
      Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
      Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
      IORef a
accRef <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
init
      IORef (Maybe ResultError)
failureRef <- Maybe ResultError -> IO (IORef (Maybe ResultError))
forall a. a -> IO (IORef a)
newIORef Maybe ResultError
forall a. Maybe a
Nothing
      Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m ()
forMFromZero_ (Row -> Int
forall b. Num b => Row -> b
rowToInt Row
maxRows) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
rowIndex -> do
        Either RowError b
rowResult <- Row b -> (Result, Row, Column, Bool) -> IO (Either RowError b)
forall a.
Row a -> (Result, Row, Column, Bool) -> IO (Either RowError a)
Row.run Row b
rowDec (Result
result, Int -> Row
forall a. Integral a => a -> Row
intToRow Int
rowIndex, Column
maxCols, Bool
integerDatetimes)
        case Either RowError b
rowResult of
          Left !RowError
x -> IORef (Maybe ResultError) -> Maybe ResultError -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ResultError)
failureRef (ResultError -> Maybe ResultError
forall a. a -> Maybe a
Just (Int -> RowError -> ResultError
RowError Int
rowIndex RowError
x))
          Right !b
x -> IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef a
accRef (\a
acc -> a -> b -> a
step a
acc b
x)
      IORef (Maybe ResultError) -> IO (Maybe ResultError)
forall a. IORef a -> IO a
readIORef IORef (Maybe ResultError)
failureRef IO (Maybe ResultError)
-> (Maybe ResultError -> IO (Either ResultError a))
-> IO (Either ResultError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe ResultError
Nothing -> a -> Either ResultError a
forall a b. b -> Either a b
Right (a -> Either ResultError a) -> IO a -> IO (Either ResultError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
accRef
        Just ResultError
x -> Either ResultError a -> IO (Either ResultError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultError -> Either ResultError a
forall a b. a -> Either a b
Left ResultError
x)
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row (CInt -> Row) -> (a -> CInt) -> a -> Row
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE foldr #-}
foldr :: (b -> a -> a) -> a -> Row.Row b -> Result a
foldr :: (b -> a -> a) -> a -> Row b -> Result a
foldr b -> a -> a
step a
init Row b
rowDec =
  {-# SCC "foldr" #-} 
  do
    (ExecStatus -> Bool) -> Result ()
checkExecStatus ((ExecStatus -> Bool) -> Result ())
-> (ExecStatus -> Bool) -> Result ()
forall a b. (a -> b) -> a -> b
$ \case
      ExecStatus
LibPQ.TuplesOk -> Bool
True
      ExecStatus
_ -> Bool
False
    ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a.
ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
Result (ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a -> Result a
forall a b. (a -> b) -> a -> b
$ ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((Bool, Result) -> ExceptT ResultError IO a)
 -> ReaderT (Bool, Result) (ExceptT ResultError IO) a)
-> ((Bool, Result) -> ExceptT ResultError IO a)
-> ReaderT (Bool, Result) (ExceptT ResultError IO) a
forall a b. (a -> b) -> a -> b
$ \(Bool
integerDatetimes, Result
result) -> IO (Either ResultError a) -> ExceptT ResultError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ResultError a) -> ExceptT ResultError IO a)
-> IO (Either ResultError a) -> ExceptT ResultError IO a
forall a b. (a -> b) -> a -> b
$ do
      Row
maxRows <- Result -> IO Row
LibPQ.ntuples Result
result
      Column
maxCols <- Result -> IO Column
LibPQ.nfields Result
result
      IORef a
accRef <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
init
      IORef (Maybe ResultError)
failureRef <- Maybe ResultError -> IO (IORef (Maybe ResultError))
forall a. a -> IO (IORef a)
newIORef Maybe ResultError
forall a. Maybe a
Nothing
      Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m ()
forMToZero_ (Row -> Int
forall b. Num b => Row -> b
rowToInt Row
maxRows) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
rowIndex -> do
        Either RowError b
rowResult <- Row b -> (Result, Row, Column, Bool) -> IO (Either RowError b)
forall a.
Row a -> (Result, Row, Column, Bool) -> IO (Either RowError a)
Row.run Row b
rowDec (Result
result, Int -> Row
forall a. Integral a => a -> Row
intToRow Int
rowIndex, Column
maxCols, Bool
integerDatetimes)
        case Either RowError b
rowResult of
          Left !RowError
x -> IORef (Maybe ResultError) -> Maybe ResultError -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ResultError)
failureRef (ResultError -> Maybe ResultError
forall a. a -> Maybe a
Just (Int -> RowError -> ResultError
RowError Int
rowIndex RowError
x))
          Right !b
x -> IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef a
accRef (\a
acc -> b -> a -> a
step b
x a
acc)
      IORef (Maybe ResultError) -> IO (Maybe ResultError)
forall a. IORef a -> IO a
readIORef IORef (Maybe ResultError)
failureRef IO (Maybe ResultError)
-> (Maybe ResultError -> IO (Either ResultError a))
-> IO (Either ResultError a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe ResultError
Nothing -> a -> Either ResultError a
forall a b. b -> Either a b
Right (a -> Either ResultError a) -> IO a -> IO (Either ResultError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
accRef
        Just ResultError
x -> Either ResultError a -> IO (Either ResultError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultError -> Either ResultError a
forall a b. a -> Either a b
Left ResultError
x)
  where
    rowToInt :: Row -> b
rowToInt (LibPQ.Row CInt
n) =
      CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n
    intToRow :: a -> Row
intToRow =
      CInt -> Row
LibPQ.Row (CInt -> Row) -> (a -> CInt) -> a -> Row
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral