module Hasql.Private.Decoders.Row where

import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Hasql.Private.Decoders.Value as Value
import Hasql.Private.Errors
import Hasql.Private.Prelude hiding (error)
import qualified PostgreSQL.Binary.Decoding as A

newtype Row a
  = Row (ReaderT Env (ExceptT RowError IO) a)
  deriving (forall a b. a -> Row b -> Row a
forall a b. (a -> b) -> Row a -> Row b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Row b -> Row a
$c<$ :: forall a b. a -> Row b -> Row a
fmap :: forall a b. (a -> b) -> Row a -> Row b
$cfmap :: forall a b. (a -> b) -> Row a -> Row b
Functor, Functor Row
forall a. a -> Row a
forall a b. Row a -> Row b -> Row a
forall a b. Row a -> Row b -> Row b
forall a b. Row (a -> b) -> Row a -> Row b
forall a b c. (a -> b -> c) -> Row a -> Row b -> Row 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
<* :: forall a b. Row a -> Row b -> Row a
$c<* :: forall a b. Row a -> Row b -> Row a
*> :: forall a b. Row a -> Row b -> Row b
$c*> :: forall a b. Row a -> Row b -> Row b
liftA2 :: forall a b c. (a -> b -> c) -> Row a -> Row b -> Row c
$cliftA2 :: forall a b c. (a -> b -> c) -> Row a -> Row b -> Row c
<*> :: forall a b. Row (a -> b) -> Row a -> Row b
$c<*> :: forall a b. Row (a -> b) -> Row a -> Row b
pure :: forall a. a -> Row a
$cpure :: forall a. a -> Row a
Applicative, Applicative Row
forall a. a -> Row a
forall a b. Row a -> Row b -> Row b
forall a b. Row a -> (a -> Row b) -> Row 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 :: forall a. a -> Row a
$creturn :: forall a. a -> Row a
>> :: forall a b. Row a -> Row b -> Row b
$c>> :: forall a b. Row a -> Row b -> Row b
>>= :: forall a b. Row a -> (a -> Row b) -> Row b
$c>>= :: forall a b. Row a -> (a -> Row b) -> Row b
Monad)

instance MonadFail Row where
  fail :: forall a. String -> Row a
fail = forall a. RowError -> Row a
error forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> RowError
ValueError forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. IsString a => String -> a
fromString

data Env
  = Env !LibPQ.Result !LibPQ.Row !LibPQ.Column !Bool !(IORef LibPQ.Column)

-- * Functions

{-# INLINE run #-}
run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either (Int, RowError) a)
run :: forall a.
Row a
-> (Result, Row, Column, Bool) -> IO (Either (Int, RowError) a)
run (Row ReaderT Env (ExceptT RowError IO) a
impl) (Result
result, Row
row, Column
columnsAmount, Bool
integerDatetimes) =
  do
    IORef Column
columnRef <- forall a. a -> IO (IORef a)
newIORef Column
0
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Env (ExceptT RowError IO) a
impl (Result -> Row -> Column -> Bool -> IORef Column -> Env
Env Result
result Row
row Column
columnsAmount Bool
integerDatetimes IORef Column
columnRef)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left RowError
e -> do
        LibPQ.Col CInt
col <- forall a. IORef a -> IO a
readIORef IORef Column
columnRef
        -- -1 because succ is applied before the error is returned
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
col forall a. Num a => a -> a -> a
- Int
1, RowError
e)
      Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
x

{-# INLINE error #-}
error :: RowError -> Row a
error :: forall a. RowError -> Row a
error RowError
x =
  forall a. ReaderT Env (ExceptT RowError IO) a -> Row a
Row (forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (forall a b. a -> b -> a
const (forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left RowError
x)))))

-- |
-- Next value, decoded using the provided value decoder.
{-# INLINE value #-}
value :: Value.Value a -> Row (Maybe a)
value :: forall a. Value a -> Row (Maybe a)
value Value a
valueDec =
  {-# SCC "value" #-}
  forall a. ReaderT Env (ExceptT RowError IO) a -> Row a
Row
    forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
    forall a b. (a -> b) -> a -> b
$ \(Env Result
result Row
row Column
columnsAmount Bool
integerDatetimes IORef Column
columnRef) -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
      Column
col <- forall a. IORef a -> IO a
readIORef IORef Column
columnRef
      forall a. IORef a -> a -> IO ()
writeIORef IORef Column
columnRef (forall a. Enum a => a -> a
succ Column
col)
      if Column
col forall a. Ord a => a -> a -> Bool
< Column
columnsAmount
        then do
          Maybe ByteString
valueMaybe <- {-# SCC "getvalue'" #-} Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue' Result
result Row
row Column
col
          forall (f :: * -> *) a. Applicative f => a -> f a
pure
            forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
valueMaybe of
              Maybe ByteString
Nothing ->
                forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
              Just ByteString
value ->
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just
                  forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> RowError
ValueError
                  forall a b. (a -> b) -> a -> b
$ {-# SCC "decode" #-} forall a. Value a -> ByteString -> Either Text a
A.valueParser (forall a. Value a -> Bool -> Value a
Value.run Value a
valueDec Bool
integerDatetimes) ByteString
value
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left RowError
EndOfInput)

-- |
-- Next value, decoded using the provided value decoder.
{-# INLINE nonNullValue #-}
nonNullValue :: Value.Value a -> Row a
nonNullValue :: forall a. Value a -> Row a
nonNullValue Value a
valueDec =
  {-# SCC "nonNullValue" #-}
  forall a. Value a -> Row (Maybe a)
value Value a
valueDec forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. RowError -> Row a
error RowError
UnexpectedNull) forall (f :: * -> *) a. Applicative f => a -> f a
pure