module Hasql.Private.Decoders.Row where

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


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

instance MonadFail Row where
  fail :: String -> Row a
fail = RowError -> Row a
forall a. RowError -> Row a
error (RowError -> Row a) -> (String -> RowError) -> String -> Row a
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 (Text -> RowError) -> (String -> Text) -> String -> RowError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
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 RowError a)
run :: Row a -> (Result, Row, Column, Bool) -> IO (Either RowError a)
run (Row ReaderT Env (ExceptT RowError IO) a
impl) (Result
result, Row
row, Column
columnsAmount, Bool
integerDatetimes) =
  do
    IORef Column
columnRef <- Column -> IO (IORef Column)
forall a. a -> IO (IORef a)
newIORef Column
0
    ExceptT RowError IO a -> IO (Either RowError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT Env (ExceptT RowError IO) a -> Env -> ExceptT RowError IO a
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))

{-# INLINE error #-}
error :: RowError -> Row a
error :: RowError -> Row a
error RowError
x =
  ReaderT Env (ExceptT RowError IO) a -> Row a
forall a. ReaderT Env (ExceptT RowError IO) a -> Row a
Row ((Env -> ExceptT RowError IO a)
-> ReaderT Env (ExceptT RowError IO) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (ExceptT RowError IO a -> Env -> ExceptT RowError IO a
forall a b. a -> b -> a
const (IO (Either RowError a) -> ExceptT RowError IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Either RowError a -> IO (Either RowError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RowError -> Either RowError a
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 :: Value a -> Row (Maybe a)
value Value a
valueDec =
  {-# SCC "value" #-}
  ReaderT Env (ExceptT RowError IO) (Maybe a) -> Row (Maybe a)
forall a. ReaderT Env (ExceptT RowError IO) a -> Row a
Row (ReaderT Env (ExceptT RowError IO) (Maybe a) -> Row (Maybe a))
-> ReaderT Env (ExceptT RowError IO) (Maybe a) -> Row (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Env -> ExceptT RowError IO (Maybe a))
-> ReaderT Env (ExceptT RowError IO) (Maybe a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Env -> ExceptT RowError IO (Maybe a))
 -> ReaderT Env (ExceptT RowError IO) (Maybe a))
-> (Env -> ExceptT RowError IO (Maybe a))
-> ReaderT Env (ExceptT RowError IO) (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(Env Result
result Row
row Column
columnsAmount Bool
integerDatetimes IORef Column
columnRef) -> IO (Either RowError (Maybe a)) -> ExceptT RowError IO (Maybe a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either RowError (Maybe a)) -> ExceptT RowError IO (Maybe a))
-> IO (Either RowError (Maybe a)) -> ExceptT RowError IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
    Column
col <- IORef Column -> IO Column
forall a. IORef a -> IO a
readIORef IORef Column
columnRef
    IORef Column -> Column -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Column
columnRef (Column -> Column
forall a. Enum a => a -> a
succ Column
col)
    if Column
col Column -> Column -> Bool
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
        Either RowError (Maybe a) -> IO (Either RowError (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RowError (Maybe a) -> IO (Either RowError (Maybe a)))
-> Either RowError (Maybe a) -> IO (Either RowError (Maybe a))
forall a b. (a -> b) -> a -> b
$
          case Maybe ByteString
valueMaybe of
            Maybe ByteString
Nothing ->
              Maybe a -> Either RowError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
            Just ByteString
value ->
              (a -> Maybe a) -> Either RowError a -> Either RowError (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 RowError a -> Either RowError (Maybe a))
-> Either RowError a -> Either RowError (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Text -> RowError) -> Either Text a -> Either RowError a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> RowError
ValueError (Either Text a -> Either RowError a)
-> Either Text a -> Either RowError a
forall a b. (a -> b) -> a -> b
$
              {-# SCC "decode" #-} Value a -> ByteString -> Either Text a
forall a. Value a -> ByteString -> Either Text a
A.valueParser (Value a -> Bool -> Value a
forall a. Value a -> Bool -> Value a
Value.run Value a
valueDec Bool
integerDatetimes) ByteString
value
      else Either RowError (Maybe a) -> IO (Either RowError (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RowError -> Either RowError (Maybe a)
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 :: Value a -> Row a
nonNullValue Value a
valueDec =
  {-# SCC "nonNullValue" #-}
  Value a -> Row (Maybe a)
forall a. Value a -> Row (Maybe a)
value Value a
valueDec Row (Maybe a) -> (Maybe a -> Row a) -> Row a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Row a -> (a -> Row a) -> Maybe a -> Row a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RowError -> Row a
forall a. RowError -> Row a
error RowError
UnexpectedNull) a -> Row a
forall (f :: * -> *) a. Applicative f => a -> f a
pure