{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Database.DuckDB.Simple.FromRow
Description : Convert rows of 'Field's into Haskell values using a parser-style interface.
-}
module Database.DuckDB.Simple.FromRow (
    -- * Row parsing
    RowParser (..),
    field,
    fieldWith,
    numFieldsRemaining,
    parseRow,

    -- * Generic derivation
    GFromRow (..),
    FromRow (..),

    -- * Error conversion
    resultErrorToSqlError,
    rowErrorsToSqlError,
) where

import Control.Applicative (Alternative (..))
import Control.Exception (Exception, SomeException (SomeException), fromException, toException)
import Control.Monad (MonadPlus, replicateM)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
import Control.Monad.Trans.State.Strict (StateT, get, put, runStateT)
import Data.Maybe (listToMaybe, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics

import Database.DuckDB.Simple.FromField
import Database.DuckDB.Simple.Internal (SQLError (..))
import Database.DuckDB.Simple.Ok (Ok (..))
import Database.DuckDB.Simple.Types (Only (..), Query, (:.) (..))

-- | Row parsing environment (read-only data available to the parser).
newtype RowParseRO = RowParseRO
    { RowParseRO -> Int
rowParseColumnCount :: Int
    }

-- | Column-out-of-bounds sentinel used internally to map parser failures.
newtype ColumnOutOfBounds = ColumnOutOfBounds {ColumnOutOfBounds -> Int
columnOutOfBoundsIndex :: Int}
    deriving stock (ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
(ColumnOutOfBounds -> ColumnOutOfBounds -> Bool)
-> (ColumnOutOfBounds -> ColumnOutOfBounds -> Bool)
-> Eq ColumnOutOfBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
== :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
$c/= :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
/= :: ColumnOutOfBounds -> ColumnOutOfBounds -> Bool
Eq, Int -> ColumnOutOfBounds -> ShowS
[ColumnOutOfBounds] -> ShowS
ColumnOutOfBounds -> String
(Int -> ColumnOutOfBounds -> ShowS)
-> (ColumnOutOfBounds -> String)
-> ([ColumnOutOfBounds] -> ShowS)
-> Show ColumnOutOfBounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnOutOfBounds -> ShowS
showsPrec :: Int -> ColumnOutOfBounds -> ShowS
$cshow :: ColumnOutOfBounds -> String
show :: ColumnOutOfBounds -> String
$cshowList :: [ColumnOutOfBounds] -> ShowS
showList :: [ColumnOutOfBounds] -> ShowS
Show)

instance Exception ColumnOutOfBounds

-- | Parser used by 'FromRow' implementations.
newtype RowParser a = RowParser
    { forall a.
RowParser a -> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
runRowParser :: ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
    }
    deriving stock ((forall a b. (a -> b) -> RowParser a -> RowParser b)
-> (forall a b. a -> RowParser b -> RowParser a)
-> Functor RowParser
forall a b. a -> RowParser b -> RowParser a
forall a b. (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RowParser a -> RowParser b
fmap :: forall a b. (a -> b) -> RowParser a -> RowParser b
$c<$ :: forall a b. a -> RowParser b -> RowParser a
<$ :: forall a b. a -> RowParser b -> RowParser a
Functor)
    deriving newtype (Functor RowParser
Functor RowParser =>
(forall a. a -> RowParser a)
-> (forall a b. RowParser (a -> b) -> RowParser a -> RowParser b)
-> (forall a b c.
    (a -> b -> c) -> RowParser a -> RowParser b -> RowParser c)
-> (forall a b. RowParser a -> RowParser b -> RowParser b)
-> (forall a b. RowParser a -> RowParser b -> RowParser a)
-> Applicative RowParser
forall a. a -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser b
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser 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
$cpure :: forall a. a -> RowParser a
pure :: forall a. a -> RowParser a
$c<*> :: forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
<*> :: forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
$cliftA2 :: forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
liftA2 :: forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
$c*> :: forall a b. RowParser a -> RowParser b -> RowParser b
*> :: forall a b. RowParser a -> RowParser b -> RowParser b
$c<* :: forall a b. RowParser a -> RowParser b -> RowParser a
<* :: forall a b. RowParser a -> RowParser b -> RowParser a
Applicative, Applicative RowParser
Applicative RowParser =>
(forall a. RowParser a)
-> (forall a. RowParser a -> RowParser a -> RowParser a)
-> (forall a. RowParser a -> RowParser [a])
-> (forall a. RowParser a -> RowParser [a])
-> Alternative RowParser
forall a. RowParser a
forall a. RowParser a -> RowParser [a]
forall a. RowParser a -> RowParser a -> RowParser a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall a. RowParser a
empty :: forall a. RowParser a
$c<|> :: forall a. RowParser a -> RowParser a -> RowParser a
<|> :: forall a. RowParser a -> RowParser a -> RowParser a
$csome :: forall a. RowParser a -> RowParser [a]
some :: forall a. RowParser a -> RowParser [a]
$cmany :: forall a. RowParser a -> RowParser [a]
many :: forall a. RowParser a -> RowParser [a]
Alternative, Applicative RowParser
Applicative RowParser =>
(forall a b. RowParser a -> (a -> RowParser b) -> RowParser b)
-> (forall a b. RowParser a -> RowParser b -> RowParser b)
-> (forall a. a -> RowParser a)
-> Monad RowParser
forall a. a -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser b
forall a b. RowParser a -> (a -> RowParser b) -> RowParser 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
$c>>= :: forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
>>= :: forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
$c>> :: forall a b. RowParser a -> RowParser b -> RowParser b
>> :: forall a b. RowParser a -> RowParser b -> RowParser b
$creturn :: forall a. a -> RowParser a
return :: forall a. a -> RowParser a
Monad, Monad RowParser
Alternative RowParser
(Alternative RowParser, Monad RowParser) =>
(forall a. RowParser a)
-> (forall a. RowParser a -> RowParser a -> RowParser a)
-> MonadPlus RowParser
forall a. RowParser a
forall a. RowParser a -> RowParser a -> RowParser a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall a. RowParser a
mzero :: forall a. RowParser a
$cmplus :: forall a. RowParser a -> RowParser a -> RowParser a
mplus :: forall a. RowParser a -> RowParser a -> RowParser a
MonadPlus)

-- | Generic derivation helper mirroring @sqlite-simple@.
class GFromRow f where
    gFromRow :: RowParser (f p)

instance GFromRow U1 where
    gFromRow :: forall p. RowParser (U1 p)
gFromRow = U1 p -> RowParser (U1 p)
forall a. a -> RowParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1

instance (GFromRow a) => GFromRow (M1 i c a) where
    gFromRow :: forall p. RowParser (M1 i c a p)
gFromRow = a p -> M1 i c a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a p -> M1 i c a p) -> RowParser (a p) -> RowParser (M1 i c a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a p)
forall p. RowParser (a p)
forall (f :: * -> *) p. GFromRow f => RowParser (f p)
gFromRow

instance (FromField a) => GFromRow (K1 i a) where
    gFromRow :: forall p. RowParser (K1 i a p)
gFromRow = a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a p) -> RowParser a -> RowParser (K1 i a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field

instance (GFromRow a, GFromRow b) => GFromRow (a :*: b) where
    gFromRow :: forall p. RowParser ((:*:) a b p)
gFromRow = a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a p -> b p -> (:*:) a b p)
-> RowParser (a p) -> RowParser (b p -> (:*:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a p)
forall p. RowParser (a p)
forall (f :: * -> *) p. GFromRow f => RowParser (f p)
gFromRow RowParser (b p -> (:*:) a b p)
-> RowParser (b p) -> RowParser ((:*:) a b p)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (b p)
forall p. RowParser (b p)
forall (f :: * -> *) p. GFromRow f => RowParser (f p)
gFromRow

-- | Types that can be constructed from database rows.
class FromRow a where
    fromRow :: RowParser a
    default fromRow :: (Generic a, GFromRow (Rep a)) => RowParser a
    fromRow = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> RowParser (Rep a Any) -> RowParser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (Rep a Any)
forall p. RowParser (Rep a p)
forall (f :: * -> *) p. GFromRow f => RowParser (f p)
gFromRow

-- | Pull the next field using the provided 'FieldParser'.
fieldWith :: FieldParser a -> RowParser a
fieldWith :: forall a. FieldParser a -> RowParser a
fieldWith FieldParser a
fieldParser = ReaderT RowParseRO (StateT (Int, [Field]) Ok) a -> RowParser a
forall a.
ReaderT RowParseRO (StateT (Int, [Field]) Ok) a -> RowParser a
RowParser (ReaderT RowParseRO (StateT (Int, [Field]) Ok) a -> RowParser a)
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a -> RowParser a
forall a b. (a -> b) -> a -> b
$ do
    RowParseRO{Int
rowParseColumnCount :: RowParseRO -> Int
rowParseColumnCount :: Int
rowParseColumnCount} <- ReaderT RowParseRO (StateT (Int, [Field]) Ok) RowParseRO
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    (Int
columnIndex, [Field]
remaining) <- StateT (Int, [Field]) Ok (Int, [Field])
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) (Int, [Field])
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Int, [Field]) Ok (Int, [Field])
forall (m :: * -> *) s. Monad m => StateT s m s
get
    case [Field]
remaining of
        [] -> do
            StateT (Int, [Field]) Ok ()
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Int, [Field]) -> StateT (Int, [Field]) Ok ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
columnIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, []))
            StateT (Int, [Field]) Ok a
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ok a -> StateT (Int, [Field]) Ok a
forall (m :: * -> *) a. Monad m => m a -> StateT (Int, [Field]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors [ColumnOutOfBounds -> SomeException
forall e. Exception e => e -> SomeException
toException (Int -> ColumnOutOfBounds
ColumnOutOfBounds (Int
columnIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))]))
        (Field
f : [Field]
rest) -> do
            StateT (Int, [Field]) Ok ()
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Int, [Field]) -> StateT (Int, [Field]) Ok ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
columnIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [Field]
rest))
            if Int
columnIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rowParseColumnCount
                then StateT (Int, [Field]) Ok a
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ok a -> StateT (Int, [Field]) Ok a
forall (m :: * -> *) a. Monad m => m a -> StateT (Int, [Field]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors [ColumnOutOfBounds -> SomeException
forall e. Exception e => e -> SomeException
toException (Int -> ColumnOutOfBounds
ColumnOutOfBounds (Int
columnIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))]))
                else case FieldParser a
fieldParser Field
f of
                    Errors [SomeException]
err -> StateT (Int, [Field]) Ok a
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Int, [Field]) Ok a
 -> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a)
-> StateT (Int, [Field]) Ok a
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
forall a b. (a -> b) -> a -> b
$ Ok a -> StateT (Int, [Field]) Ok a
forall (m :: * -> *) a. Monad m => m a -> StateT (Int, [Field]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ok a -> StateT (Int, [Field]) Ok a)
-> Ok a -> StateT (Int, [Field]) Ok a
forall a b. (a -> b) -> a -> b
$ [SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors [SomeException]
err
                    Ok a
value -> a -> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
forall a. a -> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value

-- | Pull the next field and parse it using its 'FromField' instance.
field :: (FromField a) => RowParser a
field :: forall a. FromField a => RowParser a
field = FieldParser a -> RowParser a
forall a. FieldParser a -> RowParser a
fieldWith FieldParser a
forall a. FromField a => FieldParser a
fromField

-- | Report how many columns remain unread in the current row.
numFieldsRemaining :: RowParser Int
numFieldsRemaining :: RowParser Int
numFieldsRemaining = ReaderT RowParseRO (StateT (Int, [Field]) Ok) Int -> RowParser Int
forall a.
ReaderT RowParseRO (StateT (Int, [Field]) Ok) a -> RowParser a
RowParser (ReaderT RowParseRO (StateT (Int, [Field]) Ok) Int
 -> RowParser Int)
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) Int
-> RowParser Int
forall a b. (a -> b) -> a -> b
$ do
    RowParseRO{Int
rowParseColumnCount :: RowParseRO -> Int
rowParseColumnCount :: Int
rowParseColumnCount} <- ReaderT RowParseRO (StateT (Int, [Field]) Ok) RowParseRO
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    (Int
columnIndex, [Field]
_) <- StateT (Int, [Field]) Ok (Int, [Field])
-> ReaderT RowParseRO (StateT (Int, [Field]) Ok) (Int, [Field])
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Int, [Field]) Ok (Int, [Field])
forall (m :: * -> *) s. Monad m => StateT s m s
get
    Int -> ReaderT RowParseRO (StateT (Int, [Field]) Ok) Int
forall a. a -> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
rowParseColumnCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
columnIndex)

-- | Execute a 'RowParser' against the provided row.
parseRow :: RowParser a -> [Field] -> Ok a
parseRow :: forall a. RowParser a -> [Field] -> Ok a
parseRow RowParser a
parser [Field]
fields =
    let context :: RowParseRO
context = Int -> RowParseRO
RowParseRO ([Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Field]
fields)
        initialState :: (Int, [Field])
initialState = (Int
0, [Field]
fields)
     in case StateT (Int, [Field]) Ok a
-> (Int, [Field]) -> Ok (a, (Int, [Field]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
-> RowParseRO -> StateT (Int, [Field]) Ok a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (RowParser a -> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
forall a.
RowParser a -> ReaderT RowParseRO (StateT (Int, [Field]) Ok) a
runRowParser RowParser a
parser) RowParseRO
context) (Int, [Field])
initialState of
            Ok (a
value, (Int
columnCount, [Field]
_))
                | Int
columnCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Field] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Field]
fields -> a -> Ok a
forall a. a -> Ok a
Ok a
value
                | Bool
otherwise -> [SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors [ColumnOutOfBounds -> SomeException
forall e. Exception e => e -> SomeException
SomeException (ColumnOutOfBounds -> SomeException)
-> ColumnOutOfBounds -> SomeException
forall a b. (a -> b) -> a -> b
$ Int -> ColumnOutOfBounds
ColumnOutOfBounds (Int
columnCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)]
            Errors [SomeException]
errs ->  [SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors [SomeException]
errs

instance FromRow () where
    fromRow :: RowParser ()
fromRow = () -> RowParser ()
forall a. a -> RowParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance (FromField a) => FromRow (Only a) where
    fromRow :: RowParser (Only a)
fromRow = a -> Only a
forall a. a -> Only a
Only (a -> Only a) -> RowParser a -> RowParser (Only a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field

instance (FromRow a, FromRow b) => FromRow (a :. b) where
    fromRow :: RowParser (a :. b)
fromRow = a -> b -> a :. b
forall h t. h -> t -> h :. t
(:.) (a -> b -> a :. b) -> RowParser a -> RowParser (b -> a :. b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromRow a => RowParser a
fromRow RowParser (b -> a :. b) -> RowParser b -> RowParser (a :. b)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromRow a => RowParser a
fromRow

instance (FromField a, FromField b) => FromRow (a, b) where
    fromRow :: RowParser (a, b)
fromRow = (,) (a -> b -> (a, b)) -> RowParser a -> RowParser (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> (a, b)) -> RowParser b -> RowParser (a, b)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field

instance (FromField a, FromField b, FromField c) => FromRow (a, b, c) where
    fromRow :: RowParser (a, b, c)
fromRow = (,,) (a -> b -> c -> (a, b, c))
-> RowParser a -> RowParser (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> (a, b, c))
-> RowParser b -> RowParser (c -> (a, b, c))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> (a, b, c)) -> RowParser c -> RowParser (a, b, c)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field

instance (FromField a, FromField b, FromField c, FromField d) => FromRow (a, b, c, d) where
    fromRow :: RowParser (a, b, c, d)
fromRow = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> RowParser a -> RowParser (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> d -> (a, b, c, d))
-> RowParser b -> RowParser (c -> d -> (a, b, c, d))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> (a, b, c, d))
-> RowParser c -> RowParser (d -> (a, b, c, d))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> (a, b, c, d))
-> RowParser d -> RowParser (a, b, c, d)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field

instance (FromField a, FromField b, FromField c, FromField d, FromField e) => FromRow (a, b, c, d, e) where
    fromRow :: RowParser (a, b, c, d, e)
fromRow = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> RowParser a -> RowParser (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> d -> e -> (a, b, c, d, e))
-> RowParser b -> RowParser (c -> d -> e -> (a, b, c, d, e))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> e -> (a, b, c, d, e))
-> RowParser c -> RowParser (d -> e -> (a, b, c, d, e))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> e -> (a, b, c, d, e))
-> RowParser d -> RowParser (e -> (a, b, c, d, e))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser (e -> (a, b, c, d, e))
-> RowParser e -> RowParser (a, b, c, d, e)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field

instance (FromField a, FromField b, FromField c, FromField d, FromField e, FromField f) => FromRow (a, b, c, d, e, f) where
    fromRow :: RowParser (a, b, c, d, e, f)
fromRow = (,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> RowParser a
-> RowParser (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> RowParser b
-> RowParser (c -> d -> e -> f -> (a, b, c, d, e, f))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> e -> f -> (a, b, c, d, e, f))
-> RowParser c -> RowParser (d -> e -> f -> (a, b, c, d, e, f))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> e -> f -> (a, b, c, d, e, f))
-> RowParser d -> RowParser (e -> f -> (a, b, c, d, e, f))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser (e -> f -> (a, b, c, d, e, f))
-> RowParser e -> RowParser (f -> (a, b, c, d, e, f))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field RowParser (f -> (a, b, c, d, e, f))
-> RowParser f -> RowParser (a, b, c, d, e, f)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field

instance
    (FromField a, FromField b, FromField c, FromField d, FromField e, FromField f, FromField g) =>
    FromRow (a, b, c, d, e, f, g)
    where
    fromRow :: RowParser (a, b, c, d, e, f, g)
fromRow = (,,,,,,) (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser a
-> RowParser (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser b
-> RowParser (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser c
-> RowParser (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser d -> RowParser (e -> f -> g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser (e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser e -> RowParser (f -> g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field RowParser (f -> g -> (a, b, c, d, e, f, g))
-> RowParser f -> RowParser (g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field RowParser (g -> (a, b, c, d, e, f, g))
-> RowParser g -> RowParser (a, b, c, d, e, f, g)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field

instance
    (FromField a, FromField b, FromField c, FromField d, FromField e, FromField f, FromField g, FromField h) =>
    FromRow (a, b, c, d, e, f, g, h)
    where
    fromRow :: RowParser (a, b, c, d, e, f, g, h)
fromRow = (,,,,,,,) (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser a
-> RowParser
     (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser
  (b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser b
-> RowParser
     (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser c
-> RowParser (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser d
-> RowParser (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser e
-> RowParser (f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field RowParser (f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser f -> RowParser (g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field RowParser (g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser g -> RowParser (h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field RowParser (h -> (a, b, c, d, e, f, g, h))
-> RowParser h -> RowParser (a, b, c, d, e, f, g, h)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser h
forall a. FromField a => RowParser a
field

instance
    ( FromField a
    , FromField b
    , FromField c
    , FromField d
    , FromField e
    , FromField f
    , FromField g
    , FromField h
    , FromField i
    ) =>
    FromRow (a, b, c, d, e, f, g, h, i)
    where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i)
fromRow =
        (,,,,,,,,)
            (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> (a, b, c, d, e, f, g, h, i))
-> RowParser a
-> RowParser
     (b
      -> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field
            RowParser
  (b
   -> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser b
-> RowParser
     (c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field
            RowParser
  (c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser c
-> RowParser
     (d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field
            RowParser
  (d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser d
-> RowParser (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field
            RowParser (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser e
-> RowParser (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
            RowParser (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser f
-> RowParser (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field
            RowParser (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser g -> RowParser (h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field
            RowParser (h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser h -> RowParser (i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser h
forall a. FromField a => RowParser a
field
            RowParser (i -> (a, b, c, d, e, f, g, h, i))
-> RowParser i -> RowParser (a, b, c, d, e, f, g, h, i)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field

instance
    ( FromField a
    , FromField b
    , FromField c
    , FromField d
    , FromField e
    , FromField f
    , FromField g
    , FromField h
    , FromField i
    , FromField j
    ) =>
    FromRow (a, b, c, d, e, f, g, h, i, j)
    where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j)
fromRow =
        (,,,,,,,,,)
            (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field
            RowParser
  (b
   -> c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field
            RowParser
  (c
   -> d
   -> e
   -> f
   -> g
   -> h
   -> i
   -> j
   -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser c
-> RowParser
     (d -> e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field
            RowParser
  (d -> e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser d
-> RowParser
     (e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field
            RowParser
  (e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser e
-> RowParser
     (f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
            RowParser (f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser f
-> RowParser (g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field
            RowParser (g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser g
-> RowParser (h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field
            RowParser (h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser h
-> RowParser (i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser h
forall a. FromField a => RowParser a
field
            RowParser (i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser i -> RowParser (j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field
            RowParser (j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser j -> RowParser (a, b, c, d, e, f, g, h, i, j)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field

instance (FromField a) => FromRow [a] where
    fromRow :: RowParser [a]
fromRow = do
        Int
remaining <- RowParser Int
numFieldsRemaining
        Int -> RowParser a -> RowParser [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
remaining RowParser a
forall a. FromField a => RowParser a
field

-- | Convert a 'ResultError' into a user-facing 'SQLError'.
resultErrorToSqlError :: Query -> ResultError -> SQLError
resultErrorToSqlError :: Query -> ResultError -> SQLError
resultErrorToSqlError Query
query ResultError
err =
    SQLError
        { sqlErrorMessage :: Text
sqlErrorMessage = ResultError -> Text
renderError ResultError
err
        , sqlErrorType :: Maybe DuckDBErrorType
sqlErrorType = Maybe DuckDBErrorType
forall a. Maybe a
Nothing
        , sqlErrorQuery :: Maybe Query
sqlErrorQuery = Query -> Maybe Query
forall a. a -> Maybe a
Just Query
query
        }

-- | Collapse parser failure diagnostics into an 'SQLError' while preserving the query.
rowErrorsToSqlError :: Query -> [SomeException] -> SQLError
rowErrorsToSqlError :: Query -> [SomeException] -> SQLError
rowErrorsToSqlError Query
query [SomeException]
errs =
    case [ResultError] -> Maybe ResultError
forall a. [a] -> Maybe a
listToMaybe ((SomeException -> Maybe ResultError)
-> [SomeException] -> [ResultError]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SomeException -> Maybe ResultError
forall e. Exception e => SomeException -> Maybe e
fromException :: SomeException -> Maybe ResultError) [SomeException]
errs) of
        Just ResultError
resultErr -> Query -> ResultError -> SQLError
resultErrorToSqlError Query
query ResultError
resultErr
        Maybe ResultError
Nothing ->
            case [ColumnOutOfBounds] -> Maybe ColumnOutOfBounds
forall a. [a] -> Maybe a
listToMaybe ((SomeException -> Maybe ColumnOutOfBounds)
-> [SomeException] -> [ColumnOutOfBounds]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SomeException -> Maybe ColumnOutOfBounds
forall e. Exception e => SomeException -> Maybe e
fromException :: SomeException -> Maybe ColumnOutOfBounds) [SomeException]
errs) of
                Just (ColumnOutOfBounds Int
idx) ->
                    SQLError
                        { sqlErrorMessage :: Text
sqlErrorMessage =
                            [Text] -> Text
Text.concat
                                [ Text
"duckdb-simple: column index "
                                , String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
idx)
                                , Text
" out of bounds"
                                ]
                        , sqlErrorType :: Maybe DuckDBErrorType
sqlErrorType = Maybe DuckDBErrorType
forall a. Maybe a
Nothing
                        , sqlErrorQuery :: Maybe Query
sqlErrorQuery = Query -> Maybe Query
forall a. a -> Maybe a
Just Query
query
                        }
                Maybe ColumnOutOfBounds
Nothing ->
                    SQLError
                        { sqlErrorMessage :: Text
sqlErrorMessage =
                            String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"duckdb-simple: row-parsing failed:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SomeException] -> String
forall a. Show a => a -> String
show [SomeException]
errs
                        , sqlErrorType :: Maybe DuckDBErrorType
sqlErrorType = Maybe DuckDBErrorType
forall a. Maybe a
Nothing
                        , sqlErrorQuery :: Maybe Query
sqlErrorQuery = Query -> Maybe Query
forall a. a -> Maybe a
Just Query
query
                        }

renderError :: ResultError -> Text
renderError :: ResultError -> Text
renderError = \case
    Incompatible{Text
errSQLType :: Text
errSQLType :: ResultError -> Text
errSQLType, Text
errSQLField :: Text
errSQLField :: ResultError -> Text
errSQLField, Text
errHaskellType :: Text
errHaskellType :: ResultError -> Text
errHaskellType, Text
errMessage :: Text
errMessage :: ResultError -> Text
errMessage} ->
            [Text] -> Text
Text.concat
                [ Text
"duckdb-simple: column "
                , Text
errSQLField
                , Text
" has type "
                , Text
errSQLType
                , Text
" but expected "
                , Text
errHaskellType
                , if Text -> Bool
Text.null Text
errMessage
                  then Text
""
                  else Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errMessage
                ]
    UnexpectedNull{Text
errHaskellType :: ResultError -> Text
errHaskellType :: Text
errHaskellType, Text
errSQLField :: ResultError -> Text
errSQLField :: Text
errSQLField, Text
errMessage :: ResultError -> Text
errMessage :: Text
errMessage} ->
            [Text] -> Text
Text.concat
                [ Text
"duckdb-simple: column "
                , Text
errSQLField
                , Text
" is NULL but expected "
                , Text
errHaskellType
                , if Text -> Bool
Text.null Text
errMessage
                  then Text
""
                  else Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errMessage
                ]
    ConversionFailed{Text
errMessage :: ResultError -> Text
errMessage :: Text
errMessage} ->
        Text
errMessage