{-|
Module: Squeal.PostgreSQL.Session.Result
Description: results
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

Get values from a `Result`.
-}

{-# LANGUAGE
    FlexibleContexts
  , FlexibleInstances
  , GADTs
  , LambdaCase
  , OverloadedStrings
  , ScopedTypeVariables
  , TypeApplications
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Session.Result
  ( Result (..)
  , MonadResult (..)
  , liftResult
  , nextRow
  ) where

import Control.Exception (throw)
import Control.Monad (when, (<=<))
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Traversable (for)
import Text.Read (readMaybe)

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Text.Encoding as Text
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Generics.SOP as SOP

import Squeal.PostgreSQL.Session.Decode
import Squeal.PostgreSQL.Session.Exception

{- | `Result`s are generated by executing
`Squeal.PostgreSQL.Session.Statement`s
in a `Squeal.PostgreSQL.Session.Monad.MonadPQ`.

They contain an underlying `LibPQ.Result`
and a `DecodeRow`.
-}
data Result y where
  Result
    :: SOP.SListI row
    => DecodeRow row y
    -> LibPQ.Result
    -> Result y
instance Functor Result where
  fmap :: (a -> b) -> Result a -> Result b
fmap a -> b
f (Result DecodeRow row a
decode Result
result) = DecodeRow row b -> Result -> Result b
forall (row :: [(Symbol, NullType)]) y.
SListI row =>
DecodeRow row y -> Result -> Result y
Result ((a -> b) -> DecodeRow row a -> DecodeRow row b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f DecodeRow row a
decode) Result
result

{- | A `MonadResult` operation extracts values
from the `Result` of a `Squeal.PostgreSQL.Session.Monad.MonadPQ` operation.
There is no need to define instances of `MonadResult`.
An instance of `MonadIO` implies an instance of `MonadResult`.
However, the constraint `MonadResult`
does not imply the constraint `MonadIO`.
-}
class Monad m => MonadResult m where
  -- | Get a row corresponding to a given row number from a `LibPQ.Result`,
  -- throwing an exception if the row number is out of bounds.
  getRow :: LibPQ.Row -> Result y -> m y
  -- | Get all rows from a `LibPQ.Result`.
  getRows :: Result y -> m [y]
  -- | Get the first row if possible from a `LibPQ.Result`.
  firstRow :: Result y -> m (Maybe y)
  -- | Returns the number of rows (tuples) in the query result.
  ntuples :: Result y -> m LibPQ.Row
  -- | Returns the number of columns (fields) in the query result.
  nfields :: Result y -> m LibPQ.Column
  {- |
  Returns the command status tag from the SQL command
  that generated the `Result`.
  Commonly this is just the name of the command,
  but it might include additional data such as the number of rows processed.
  -}
  cmdStatus :: Result y -> m Text
  {- |
  Returns the number of rows affected by the SQL command.
  This function returns `Just` the number of
  rows affected by the SQL statement that generated the `Result`.
  This function can only be used following the execution of a
  SELECT, CREATE TABLE AS, INSERT, UPDATE, DELETE, MOVE, FETCH,
  or COPY statement,or an EXECUTE of a prepared query that
  contains an INSERT, UPDATE, or DELETE statement.
  If the command that generated the PGresult was anything else,
  `cmdTuples` returns `Nothing`.
  -}
  cmdTuples :: Result y -> m (Maybe LibPQ.Row)
  -- | Returns the result status of the command.
  resultStatus :: Result y -> m LibPQ.ExecStatus
  -- | Check if a `Result`'s status is either `LibPQ.CommandOk`
  -- or `LibPQ.TuplesOk` otherwise `throw` a `SQLException`.
  okResult :: Result y -> m ()
  -- | Returns the error message most recently generated by an operation
  -- on the connection.
  resultErrorMessage :: Result y -> m (Maybe ByteString)
  -- | Returns the error code most recently generated by an operation
  -- on the connection.
  --
  -- https://www.postgresql.org/docs/current/static/errcodes-appendix.html
  resultErrorCode :: Result y -> m (Maybe ByteString)

instance (Monad io, MonadIO io) => MonadResult io where
  getRow :: Row -> Result y -> io y
getRow Row
r (Result DecodeRow row y
decode Result
result) = IO y -> io y
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO y -> io y) -> IO y -> io y
forall a b. (a -> b) -> a -> b
$ do
    Row
numRows <- Result -> IO Row
LibPQ.ntuples Result
result
    Column
numCols <- Result -> IO Column
LibPQ.nfields Result
result
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Row
numRows Row -> Row -> Bool
forall a. Ord a => a -> a -> Bool
< Row
r) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SquealException -> IO ()
forall a e. Exception e => e -> a
throw (SquealException -> IO ()) -> SquealException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Row -> Row -> SquealException
RowsException Text
"getRow" Row
r Row
numRows
    [Maybe ByteString]
row' <- (Column -> IO (Maybe ByteString))
-> [Column] -> IO [Maybe ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue Result
result Row
r) [Column
0 .. Column
numCols Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
1]
    case [Maybe ByteString] -> Maybe (NP (K (Maybe ByteString)) row)
forall k (xs :: [k]) a. SListI xs => [a] -> Maybe (NP (K a) xs)
SOP.fromList [Maybe ByteString]
row' of
      Maybe (NP (K (Maybe ByteString)) row)
Nothing -> SquealException -> IO y
forall a e. Exception e => e -> a
throw (SquealException -> IO y) -> SquealException -> IO y
forall a b. (a -> b) -> a -> b
$ Text -> Column -> SquealException
ColumnsException Text
"getRow" Column
numCols
      Just NP (K (Maybe ByteString)) row
row -> case DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
forall (row :: [(Symbol, NullType)]) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
execDecodeRow DecodeRow row y
decode NP (K (Maybe ByteString)) row
row of
        Left Text
parseError -> SquealException -> IO y
forall a e. Exception e => e -> a
throw (SquealException -> IO y) -> SquealException -> IO y
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SquealException
DecodingException Text
"getRow" Text
parseError
        Right y
y -> y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return y
y

  getRows :: Result y -> io [y]
getRows (Result DecodeRow row y
decode Result
result) = IO [y] -> io [y]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [y] -> io [y]) -> IO [y] -> io [y]
forall a b. (a -> b) -> a -> b
$ do
    Column
numCols <- Result -> IO Column
LibPQ.nfields Result
result
    Row
numRows <- Result -> IO Row
LibPQ.ntuples Result
result
    [Row] -> (Row -> IO y) -> IO [y]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Row
0 .. Row
numRows Row -> Row -> Row
forall a. Num a => a -> a -> a
- Row
1] ((Row -> IO y) -> IO [y]) -> (Row -> IO y) -> IO [y]
forall a b. (a -> b) -> a -> b
$ \ Row
r -> do
      [Maybe ByteString]
row' <- (Column -> IO (Maybe ByteString))
-> [Column] -> IO [Maybe ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue Result
result Row
r) [Column
0 .. Column
numCols Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
1]
      case [Maybe ByteString] -> Maybe (NP (K (Maybe ByteString)) row)
forall k (xs :: [k]) a. SListI xs => [a] -> Maybe (NP (K a) xs)
SOP.fromList [Maybe ByteString]
row' of
        Maybe (NP (K (Maybe ByteString)) row)
Nothing -> SquealException -> IO y
forall a e. Exception e => e -> a
throw (SquealException -> IO y) -> SquealException -> IO y
forall a b. (a -> b) -> a -> b
$ Text -> Column -> SquealException
ColumnsException Text
"getRows" Column
numCols
        Just NP (K (Maybe ByteString)) row
row -> case DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
forall (row :: [(Symbol, NullType)]) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
execDecodeRow DecodeRow row y
decode NP (K (Maybe ByteString)) row
row of
          Left Text
parseError -> SquealException -> IO y
forall a e. Exception e => e -> a
throw (SquealException -> IO y) -> SquealException -> IO y
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SquealException
DecodingException Text
"getRows" Text
parseError
          Right y
y -> y -> IO y
forall (m :: * -> *) a. Monad m => a -> m a
return y
y

  firstRow :: Result y -> io (Maybe y)
firstRow (Result DecodeRow row y
decode Result
result) = IO (Maybe y) -> io (Maybe y)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe y) -> io (Maybe y)) -> IO (Maybe y) -> io (Maybe y)
forall a b. (a -> b) -> a -> b
$ do
    Row
numRows <- Result -> IO Row
LibPQ.ntuples Result
result
    Column
numCols <- Result -> IO Column
LibPQ.nfields Result
result
    if Row
numRows Row -> Row -> Bool
forall a. Ord a => a -> a -> Bool
<= Row
0 then Maybe y -> IO (Maybe y)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe y
forall a. Maybe a
Nothing else do
      [Maybe ByteString]
row' <- (Column -> IO (Maybe ByteString))
-> [Column] -> IO [Maybe ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue Result
result Row
0) [Column
0 .. Column
numCols Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
1]
      case [Maybe ByteString] -> Maybe (NP (K (Maybe ByteString)) row)
forall k (xs :: [k]) a. SListI xs => [a] -> Maybe (NP (K a) xs)
SOP.fromList [Maybe ByteString]
row' of
        Maybe (NP (K (Maybe ByteString)) row)
Nothing -> SquealException -> IO (Maybe y)
forall a e. Exception e => e -> a
throw (SquealException -> IO (Maybe y))
-> SquealException -> IO (Maybe y)
forall a b. (a -> b) -> a -> b
$ Text -> Column -> SquealException
ColumnsException Text
"firstRow" Column
numCols
        Just NP (K (Maybe ByteString)) row
row -> case DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
forall (row :: [(Symbol, NullType)]) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
execDecodeRow DecodeRow row y
decode NP (K (Maybe ByteString)) row
row of
          Left Text
parseError -> SquealException -> IO (Maybe y)
forall a e. Exception e => e -> a
throw (SquealException -> IO (Maybe y))
-> SquealException -> IO (Maybe y)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SquealException
DecodingException Text
"firstRow" Text
parseError
          Right y
y -> Maybe y -> IO (Maybe y)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe y -> IO (Maybe y)) -> Maybe y -> IO (Maybe y)
forall a b. (a -> b) -> a -> b
$ y -> Maybe y
forall a. a -> Maybe a
Just y
y

  ntuples :: Result y -> io Row
ntuples = (Result -> IO Row) -> Result y -> io Row
forall (io :: * -> *) x y.
MonadIO io =>
(Result -> IO x) -> Result y -> io x
liftResult Result -> IO Row
LibPQ.ntuples

  nfields :: Result y -> io Column
nfields = (Result -> IO Column) -> Result y -> io Column
forall (io :: * -> *) x y.
MonadIO io =>
(Result -> IO x) -> Result y -> io x
liftResult Result -> IO Column
LibPQ.nfields

  resultStatus :: Result y -> io ExecStatus
resultStatus = (Result -> IO ExecStatus) -> Result y -> io ExecStatus
forall (io :: * -> *) x y.
MonadIO io =>
(Result -> IO x) -> Result y -> io x
liftResult Result -> IO ExecStatus
LibPQ.resultStatus

  cmdStatus :: Result y -> io Text
cmdStatus = (Result -> IO Text) -> Result y -> io Text
forall (io :: * -> *) x y.
MonadIO io =>
(Result -> IO x) -> Result y -> io x
liftResult (Maybe ByteString -> IO Text
getCmdStatus (Maybe ByteString -> IO Text)
-> (Result -> IO (Maybe ByteString)) -> Result -> IO Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Result -> IO (Maybe ByteString)
LibPQ.cmdStatus)
    where
      getCmdStatus :: Maybe ByteString -> IO Text
getCmdStatus = \case
        Maybe ByteString
Nothing -> SquealException -> IO Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO Text) -> SquealException -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.cmdStatus"
        Just ByteString
bytes -> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 ByteString
bytes

  cmdTuples :: Result y -> io (Maybe Row)
cmdTuples = (Result -> IO (Maybe Row)) -> Result y -> io (Maybe Row)
forall (io :: * -> *) x y.
MonadIO io =>
(Result -> IO x) -> Result y -> io x
liftResult (Maybe ByteString -> IO (Maybe Row)
getCmdTuples (Maybe ByteString -> IO (Maybe Row))
-> (Result -> IO (Maybe ByteString)) -> Result -> IO (Maybe Row)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Result -> IO (Maybe ByteString)
LibPQ.cmdTuples)
    where
      getCmdTuples :: Maybe ByteString -> IO (Maybe Row)
getCmdTuples = \case
        Maybe ByteString
Nothing -> SquealException -> IO (Maybe Row)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO (Maybe Row))
-> SquealException -> IO (Maybe Row)
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.cmdTuples"
        Just ByteString
bytes -> Maybe Row -> IO (Maybe Row)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Row -> IO (Maybe Row)) -> Maybe Row -> IO (Maybe Row)
forall a b. (a -> b) -> a -> b
$
          if ByteString -> Bool
ByteString.null ByteString
bytes
          then Maybe Row
forall a. Maybe a
Nothing
          else Integer -> Row
forall a. Num a => Integer -> a
fromInteger (Integer -> Row) -> Maybe Integer -> Maybe Row
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (ByteString -> String
Char8.unpack ByteString
bytes)

  okResult :: Result y -> io ()
okResult = (Result -> IO ()) -> Result y -> io ()
forall (io :: * -> *) x y.
MonadIO io =>
(Result -> IO x) -> Result y -> io x
liftResult Result -> IO ()
forall (io :: * -> *). MonadIO io => Result -> io ()
okResult_ 

  resultErrorMessage :: Result y -> io (Maybe ByteString)
resultErrorMessage = (Result -> IO (Maybe ByteString))
-> Result y -> io (Maybe ByteString)
forall (io :: * -> *) x y.
MonadIO io =>
(Result -> IO x) -> Result y -> io x
liftResult Result -> IO (Maybe ByteString)
LibPQ.resultErrorMessage

  resultErrorCode :: Result y -> io (Maybe ByteString)
resultErrorCode = (Result -> IO (Maybe ByteString))
-> Result y -> io (Maybe ByteString)
forall (io :: * -> *) x y.
MonadIO io =>
(Result -> IO x) -> Result y -> io x
liftResult ((Result -> FieldCode -> IO (Maybe ByteString))
-> FieldCode -> Result -> IO (Maybe ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField FieldCode
LibPQ.DiagSqlstate)

-- | Intended to be used for unfolding in streaming libraries, `nextRow`
-- takes a total number of rows (which can be found with `ntuples`)
-- and a `LibPQ.Result` and given a row number if it's too large returns `Nothing`,
-- otherwise returning the row along with the next row number.
nextRow
  :: MonadIO io
  => LibPQ.Row -- ^ total number of rows
  -> Result y -- ^ result
  -> LibPQ.Row -- ^ row number
  -> io (Maybe (LibPQ.Row, y))
nextRow :: Row -> Result y -> Row -> io (Maybe (Row, y))
nextRow Row
total (Result DecodeRow row y
decode Result
result) Row
r
  = IO (Maybe (Row, y)) -> io (Maybe (Row, y))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Row, y)) -> io (Maybe (Row, y)))
-> IO (Maybe (Row, y)) -> io (Maybe (Row, y))
forall a b. (a -> b) -> a -> b
$ if Row
r Row -> Row -> Bool
forall a. Ord a => a -> a -> Bool
>= Row
total then Maybe (Row, y) -> IO (Maybe (Row, y))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Row, y)
forall a. Maybe a
Nothing else do
    Column
numCols <- Result -> IO Column
LibPQ.nfields Result
result
    [Maybe ByteString]
row' <- (Column -> IO (Maybe ByteString))
-> [Column] -> IO [Maybe ByteString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue Result
result Row
r) [Column
0 .. Column
numCols Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
1]
    case [Maybe ByteString] -> Maybe (NP (K (Maybe ByteString)) row)
forall k (xs :: [k]) a. SListI xs => [a] -> Maybe (NP (K a) xs)
SOP.fromList [Maybe ByteString]
row' of
      Maybe (NP (K (Maybe ByteString)) row)
Nothing -> SquealException -> IO (Maybe (Row, y))
forall a e. Exception e => e -> a
throw (SquealException -> IO (Maybe (Row, y)))
-> SquealException -> IO (Maybe (Row, y))
forall a b. (a -> b) -> a -> b
$ Text -> Column -> SquealException
ColumnsException Text
"nextRow" Column
numCols
      Just NP (K (Maybe ByteString)) row
row -> case DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
forall (row :: [(Symbol, NullType)]) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
execDecodeRow DecodeRow row y
decode NP (K (Maybe ByteString)) row
row of
        Left Text
parseError -> SquealException -> IO (Maybe (Row, y))
forall a e. Exception e => e -> a
throw (SquealException -> IO (Maybe (Row, y)))
-> SquealException -> IO (Maybe (Row, y))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SquealException
DecodingException Text
"nextRow" Text
parseError
        Right y
y -> Maybe (Row, y) -> IO (Maybe (Row, y))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Row, y) -> IO (Maybe (Row, y)))
-> Maybe (Row, y) -> IO (Maybe (Row, y))
forall a b. (a -> b) -> a -> b
$ (Row, y) -> Maybe (Row, y)
forall a. a -> Maybe a
Just (Row
rRow -> Row -> Row
forall a. Num a => a -> a -> a
+Row
1, y
y)

okResult_ :: MonadIO io => LibPQ.Result -> io ()
okResult_ :: Result -> io ()
okResult_ Result
result = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  ExecStatus
status <- Result -> IO ExecStatus
LibPQ.resultStatus Result
result
  case ExecStatus
status of
    ExecStatus
LibPQ.CommandOk -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ExecStatus
LibPQ.TuplesOk -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ExecStatus
_ -> do
      Maybe ByteString
stateCodeMaybe <- Result -> FieldCode -> IO (Maybe ByteString)
LibPQ.resultErrorField Result
result FieldCode
LibPQ.DiagSqlstate
      case Maybe ByteString
stateCodeMaybe of
        Maybe ByteString
Nothing -> SquealException -> IO ()
forall a e. Exception e => e -> a
throw (SquealException -> IO ()) -> SquealException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.resultErrorField"
        Just ByteString
stateCode -> do
          Maybe ByteString
msgMaybe <- Result -> IO (Maybe ByteString)
LibPQ.resultErrorMessage Result
result
          case Maybe ByteString
msgMaybe of
            Maybe ByteString
Nothing -> SquealException -> IO ()
forall a e. Exception e => e -> a
throw (SquealException -> IO ()) -> SquealException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
"LibPQ.resultErrorMessage"
            Just ByteString
msg -> SquealException -> IO ()
forall a e. Exception e => e -> a
throw (SquealException -> IO ())
-> (SQLState -> SquealException) -> SQLState -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLState -> SquealException
SQLException (SQLState -> IO ()) -> SQLState -> IO ()
forall a b. (a -> b) -> a -> b
$ ExecStatus -> ByteString -> ByteString -> SQLState
SQLState ExecStatus
status ByteString
stateCode ByteString
msg

-- | Lifts actions on results from @LibPQ@.
liftResult
  :: MonadIO io
  => (LibPQ.Result -> IO x)
  -> Result y -> io x
liftResult :: (Result -> IO x) -> Result y -> io x
liftResult Result -> IO x
f (Result DecodeRow row y
_ Result
result) = IO x -> io x
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO x -> io x) -> IO x -> io x
forall a b. (a -> b) -> a -> b
$ Result -> IO x
f Result
result

execDecodeRow
  :: DecodeRow row y
  -> SOP.NP (SOP.K (Maybe ByteString)) row
  -> Either Text y
execDecodeRow :: DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
execDecodeRow DecodeRow row y
decode = DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
forall (row :: [(Symbol, NullType)]) y.
DecodeRow row y -> NP (K (Maybe ByteString)) row -> Either Text y
runDecodeRow DecodeRow row y
decode