{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards, FlexibleInstances, DefaultSignatures #-}


------------------------------------------------------------------------------
-- |
-- Module:      Database.PostgreSQL.Simple.FromRow
-- Copyright:   (c) 2012 Leon P Smith
-- License:     BSD3
-- Maintainer:  Leon P Smith <leon@melding-monads.com>
-- Stability:   experimental
--
-- The 'FromRow' typeclass, for converting a row of results
-- returned by a SQL query into a more useful Haskell representation.
--
-- Predefined instances are provided for tuples containing up to ten
-- elements.  The instances for 'Maybe' types return 'Nothing' if all
-- the columns that would have been otherwise consumed are null,  otherwise
-- it attempts a regular conversion.
--
------------------------------------------------------------------------------

module Database.PostgreSQL.Simple.FromRow
     ( FromRow(..)
     , RowParser
     , field
     , fieldWith
     , numFieldsRemaining
     ) where

import           Prelude hiding (null)
import           Control.Applicative (Applicative(..), (<$>), (<|>), (*>), liftA2)
import           Control.Monad (replicateM, replicateM_)
import           Control.Monad.Trans.State.Strict
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.Class
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import           Data.Vector (Vector)
import qualified Data.Vector as V
import           Database.PostgreSQL.Simple.Types (Only(..))
import qualified Database.PostgreSQL.LibPQ as PQ
import           Database.PostgreSQL.Simple.Internal
import           Database.PostgreSQL.Simple.Compat
import           Database.PostgreSQL.Simple.FromField
import           Database.PostgreSQL.Simple.Ok
import           Database.PostgreSQL.Simple.Types ((:.)(..), Null)
import           Database.PostgreSQL.Simple.TypeInfo

import           GHC.Generics


-- | A collection type that can be converted from a sequence of fields.
-- Instances are provided for tuples up to 10 elements and lists of any length.
--
-- Note that instances can be defined outside of postgresql-simple,  which is
-- often useful.   For example, here's an instance for a user-defined pair:
--
-- @
-- data User = User { name :: String, fileQuota :: Int }
--
-- instance 'FromRow' User where
--     fromRow = User \<$\> 'field' \<*\> 'field'
-- @
--
-- The number of calls to 'field' must match the number of fields returned
-- in a single row of the query result.  Otherwise,  a 'ConversionFailed'
-- exception will be thrown.
--
-- You can also derive 'FromRow' for your data type using GHC generics, like
-- this:
--
-- @
-- \{-# LANGUAGE DeriveAnyClass \#-}
-- \{-# LANGUAGE DeriveGeneric  \#-}
--
-- import "GHC.Generics" ('GHC.Generics.Generic')
-- import "Database.PostgreSQL.Simple" ('FromRow')
--
-- data User = User { name :: String, fileQuota :: Int }
--   deriving ('GHC.Generics.Generic', 'FromRow')
-- @
--
-- Note that this only works for product types (e.g. records) and does not
-- support sum types or recursive types.
--
-- Note that 'field' evaluates its result to WHNF, so the caveats listed in
-- mysql-simple and very early versions of postgresql-simple no longer apply.
-- Instead, look at the caveats associated with user-defined implementations
-- of 'fromField'.

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
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 (f :: * -> *) p. GFromRow f => RowParser (f p)
gfromRow

getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString
getvalue :: Result -> Row -> Column -> Maybe ByteString
getvalue Result
result Row
row Column
col = IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafeDupablePerformIO (Result -> Row -> Column -> IO (Maybe ByteString)
PQ.getvalue' Result
result Row
row Column
col)

nfields :: PQ.Result -> PQ.Column
nfields :: Result -> Column
nfields Result
result = IO Column -> Column
forall a. IO a -> a
unsafeDupablePerformIO (Result -> IO Column
PQ.nfields Result
result)

getTypeInfoByCol :: Row -> PQ.Column -> Conversion TypeInfo
getTypeInfoByCol :: Row -> Column -> Conversion TypeInfo
getTypeInfoByCol Row{Result
Row
rowresult :: Row -> Result
row :: Row -> Row
rowresult :: Result
row :: Row
..} Column
col =
    (Connection -> IO (Ok TypeInfo)) -> Conversion TypeInfo
forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion ((Connection -> IO (Ok TypeInfo)) -> Conversion TypeInfo)
-> (Connection -> IO (Ok TypeInfo)) -> Conversion TypeInfo
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
      Oid
oid <- Result -> Column -> IO Oid
PQ.ftype Result
rowresult Column
col
      TypeInfo -> Ok TypeInfo
forall a. a -> Ok a
Ok (TypeInfo -> Ok TypeInfo) -> IO TypeInfo -> IO (Ok TypeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Oid -> IO TypeInfo
getTypeInfo Connection
conn Oid
oid

getTypenameByCol :: Row -> PQ.Column -> Conversion ByteString
getTypenameByCol :: Row -> Column -> Conversion ByteString
getTypenameByCol Row
row Column
col = TypeInfo -> ByteString
typname (TypeInfo -> ByteString)
-> Conversion TypeInfo -> Conversion ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row -> Column -> Conversion TypeInfo
getTypeInfoByCol Row
row Column
col

fieldWith :: FieldParser a -> RowParser a
fieldWith :: FieldParser a -> RowParser a
fieldWith FieldParser a
fieldP = ReaderT Row (StateT Column Conversion) a -> RowParser a
forall a. ReaderT Row (StateT Column Conversion) a -> RowParser a
RP (ReaderT Row (StateT Column Conversion) a -> RowParser a)
-> ReaderT Row (StateT Column Conversion) a -> RowParser a
forall a b. (a -> b) -> a -> b
$ do
    let unCol :: Column -> Int
unCol (PQ.Col CInt
x) = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x :: Int
    r :: Row
r@Row{Result
Row
rowresult :: Result
row :: Row
rowresult :: Row -> Result
row :: Row -> Row
..} <- ReaderT Row (StateT Column Conversion) Row
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    Column
column <- StateT Column Conversion Column
-> ReaderT Row (StateT Column Conversion) Column
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT Column Conversion Column
forall (m :: * -> *) s. Monad m => StateT s m s
get
    StateT Column Conversion ()
-> ReaderT Row (StateT Column Conversion) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Column -> StateT Column Conversion ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Column
column Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
1))
    let ncols :: Column
ncols = Result -> Column
nfields Result
rowresult
    if (Column
column Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
>= Column
ncols)
    then StateT Column Conversion a
-> ReaderT Row (StateT Column Conversion) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Column Conversion a
 -> ReaderT Row (StateT Column Conversion) a)
-> StateT Column Conversion a
-> ReaderT Row (StateT Column Conversion) a
forall a b. (a -> b) -> a -> b
$ Conversion a -> StateT Column Conversion a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Conversion a -> StateT Column Conversion a)
-> Conversion a -> StateT Column Conversion a
forall a b. (a -> b) -> a -> b
$ do
        [ByteString]
vals <- (Column -> Conversion ByteString)
-> [Column] -> Conversion [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Row -> Column -> Conversion ByteString
getTypenameByCol Row
r) [Column
0..Column
ncolsColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
1]
        let err :: ResultError
err = String -> Maybe Oid -> String -> String -> String -> ResultError
ConversionFailed
                (Int -> String
forall a. Show a => a -> String
show (Column -> Int
unCol Column
ncols) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" values: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ByteString] -> String
forall a. Show a => a -> String
show ((ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
ellipsis [ByteString]
vals))
                Maybe Oid
forall a. Maybe a
Nothing
                String
""
                (String
"at least " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Column -> Int
unCol Column
column Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" slots in target type")
                String
"mismatch between number of columns to \
                \convert and number in target type"
        ResultError -> Conversion a
forall err a. Exception err => err -> Conversion a
conversionError ResultError
err
    else do
      let !result :: Result
result = Result
rowresult
          !typeOid :: Oid
typeOid = IO Oid -> Oid
forall a. IO a -> a
unsafeDupablePerformIO (Result -> Column -> IO Oid
PQ.ftype Result
result Column
column)
          !field' :: Field
field' = Field :: Result -> Column -> Oid -> Field
Field{Result
Oid
Column
typeOid :: Oid
column :: Column
result :: Result
typeOid :: Oid
result :: Result
column :: Column
..}
      StateT Column Conversion a
-> ReaderT Row (StateT Column Conversion) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Conversion a -> StateT Column Conversion a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FieldParser a
fieldP Field
field' (Result -> Row -> Column -> Maybe ByteString
getvalue Result
result Row
row Column
column)))

field :: FromField a => RowParser a
field :: RowParser a
field = FieldParser a -> RowParser a
forall a. FieldParser a -> RowParser a
fieldWith FieldParser a
forall a. FromField a => FieldParser a
fromField

ellipsis :: ByteString -> ByteString
ellipsis :: ByteString -> ByteString
ellipsis ByteString
bs
    | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
15 = Int -> ByteString -> ByteString
B.take Int
10 ByteString
bs ByteString -> ByteString -> ByteString
`B.append` ByteString
"[...]"
    | Bool
otherwise        = ByteString
bs

numFieldsRemaining :: RowParser Int
numFieldsRemaining :: RowParser Int
numFieldsRemaining = ReaderT Row (StateT Column Conversion) Int -> RowParser Int
forall a. ReaderT Row (StateT Column Conversion) a -> RowParser a
RP (ReaderT Row (StateT Column Conversion) Int -> RowParser Int)
-> ReaderT Row (StateT Column Conversion) Int -> RowParser Int
forall a b. (a -> b) -> a -> b
$ do
    Row{Result
Row
rowresult :: Result
row :: Row
rowresult :: Row -> Result
row :: Row -> Row
..} <- ReaderT Row (StateT Column Conversion) Row
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    Column
column <- StateT Column Conversion Column
-> ReaderT Row (StateT Column Conversion) Column
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT Column Conversion Column
forall (m :: * -> *) s. Monad m => StateT s m s
get
    Int -> ReaderT Row (StateT Column Conversion) Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ReaderT Row (StateT Column Conversion) Int)
-> Int -> ReaderT Row (StateT Column Conversion) Int
forall a b. (a -> b) -> a -> b
$! (\(PQ.Col CInt
x) -> CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
x) (Result -> Column
nfields Result
rowresult Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
column)

null :: RowParser Null
null :: RowParser Null
null =  RowParser Null
forall a. FromField a => RowParser a
field

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 (FromField a) => FromRow (Maybe (Only a)) where
    fromRow :: RowParser (Maybe (Only a))
fromRow =  (RowParser Null
null RowParser Null
-> RowParser (Maybe (Only a)) -> RowParser (Maybe (Only a))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (Only a) -> RowParser (Maybe (Only a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Only a)
forall a. Maybe a
Nothing)
           RowParser (Maybe (Only a))
-> RowParser (Maybe (Only a)) -> RowParser (Maybe (Only a))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Only a -> Maybe (Only a)
forall a. a -> Maybe a
Just (Only a -> Maybe (Only a))
-> RowParser (Only a) -> RowParser (Maybe (Only a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (Only a)
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 (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) => FromRow (Maybe (a,b)) where
    fromRow :: RowParser (Maybe (a, b))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b)) -> RowParser (Maybe (a, b))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b) -> RowParser (Maybe (a, b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b))
-> RowParser (Maybe (a, b)) -> RowParser (Maybe (a, b))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just ((a, b) -> Maybe (a, b))
-> RowParser (a, b) -> RowParser (Maybe (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b)
forall a. FromRow a => RowParser a
fromRow)

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 (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 (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) => FromRow (Maybe (a,b,c)) where
    fromRow :: RowParser (Maybe (a, b, c))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c)) -> RowParser (Maybe (a, b, c))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c) -> RowParser (Maybe (a, b, c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c))
-> RowParser (Maybe (a, b, c)) -> RowParser (Maybe (a, b, c))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c) -> Maybe (a, b, c)
forall a. a -> Maybe a
Just ((a, b, c) -> Maybe (a, b, c))
-> RowParser (a, b, c) -> RowParser (Maybe (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c)
forall a. FromRow a => RowParser a
fromRow)

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 (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 (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 (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) =>
    FromRow (Maybe (a,b,c,d)) where
    fromRow :: RowParser (Maybe (a, b, c, d))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d)) -> RowParser (Maybe (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d) -> RowParser (Maybe (a, b, c, d))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d))
-> RowParser (Maybe (a, b, c, d)) -> RowParser (Maybe (a, b, c, d))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d) -> Maybe (a, b, c, d)
forall a. a -> Maybe a
Just ((a, b, c, d) -> Maybe (a, b, c, d))
-> RowParser (a, b, c, d) -> RowParser (Maybe (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d)
forall a. FromRow a => RowParser a
fromRow)

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 (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 (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 (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 (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) =>
    FromRow (Maybe (a,b,c,d,e)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e))
-> RowParser (Maybe (a, b, c, d, e))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e) -> RowParser (Maybe (a, b, c, d, e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e))
-> RowParser (Maybe (a, b, c, d, e))
-> RowParser (Maybe (a, b, c, d, e))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e) -> Maybe (a, b, c, d, e)
forall a. a -> Maybe a
Just ((a, b, c, d, e) -> Maybe (a, b, c, d, e))
-> RowParser (a, b, c, d, e) -> RowParser (Maybe (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e)
forall a. FromRow a => RowParser a
fromRow)

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 (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 (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 (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 (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 (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) =>
    FromRow (Maybe (a,b,c,d,e,f)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f))
-> RowParser (Maybe (a, b, c, d, e, f))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f) -> RowParser (Maybe (a, b, c, d, e, f))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f))
-> RowParser (Maybe (a, b, c, d, e, f))
-> RowParser (Maybe (a, b, c, d, e, f))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f) -> Maybe (a, b, c, d, e, f)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f) -> Maybe (a, b, c, d, e, f))
-> RowParser (a, b, c, d, e, f)
-> RowParser (Maybe (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f)
forall a. FromRow a => RowParser a
fromRow)

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 (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 (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 (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 (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 (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 (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) =>
    FromRow (Maybe (a,b,c,d,e,f,g)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f, g))
-> RowParser (Maybe (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g)
-> RowParser (Maybe (a, b, c, d, e, f, g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g))
-> RowParser (Maybe (a, b, c, d, e, f, g))
-> RowParser (Maybe (a, b, c, d, e, f, g))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g) -> Maybe (a, b, c, d, e, f, g)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g) -> Maybe (a, b, c, d, e, f, g))
-> RowParser (a, b, c, d, e, f, g)
-> RowParser (Maybe (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g)
forall a. FromRow a => RowParser a
fromRow)

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 (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 (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 (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 (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 (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 (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 (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) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g, h))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f, g, h))
-> RowParser (Maybe (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h)
-> RowParser (Maybe (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g, h))
-> RowParser (Maybe (a, b, c, d, e, f, g, h))
-> RowParser (Maybe (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h) -> Maybe (a, b, c, d, e, f, g, h)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h) -> Maybe (a, b, c, d, e, f, g, h))
-> RowParser (a, b, c, d, e, f, g, h)
-> RowParser (Maybe (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h)
forall a. FromRow a => RowParser a
fromRow)

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 (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 (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 (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 (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 (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 (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 (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 (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) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g, h, i))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g, h, i))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i) -> Maybe (a, b, c, d, e, f, g, h, i)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i) -> Maybe (a, b, c, d, e, f, g, h, i))
-> RowParser (a, b, c, d, e, f, g, h, i)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i)
forall a. FromRow a => RowParser a
fromRow)

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 (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 (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 (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 (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 (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 (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 (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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
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 (Maybe (a,b,c,d,e,f,g,h,i,j)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g, h, i, j))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g, h, i, j))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j)
-> Maybe (a, b, c, d, e, f, g, h, i, j)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j)
 -> Maybe (a, b, c, d, e, f, g, h, i, j))
-> RowParser (a, b, c, d, e, f, g, h, i, j)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k) where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k)
fromRow = (,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
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
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
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
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> (a, b, c, d, e, f, g, h, i, j, k))
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
   -> k
   -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser d
-> RowParser
     (e
      -> f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
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 -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser e
-> RowParser
     (f -> g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
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 -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser f
-> RowParser
     (g -> h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
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 -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser g
-> RowParser
     (h -> i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
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 -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser h
-> RowParser (i -> j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
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 -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser i
-> RowParser (j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser (j -> k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser j
-> RowParser (k -> (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                           RowParser (k -> (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser k -> RowParser (a, b, c, d, e, f, g, h, i, j, k)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
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,
          FromField k) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k)
-> Maybe (a, b, c, d, e, f, g, h, i, j, k)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k)
 -> Maybe (a, b, c, d, e, f, g, h, i, j, k))
-> RowParser (a, b, c, d, e, f, g, h, i, j, k)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j, k)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k,l) where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k, l)
fromRow = (,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
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
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
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
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
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
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
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
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> (a, b, c, d, e, f, g, h, i, j, k, l))
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
   -> k
   -> l
   -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser f
-> RowParser
     (g
      -> h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
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 -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser g
-> RowParser
     (h -> i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
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 -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser h
-> RowParser
     (i -> j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
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 -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser i
-> RowParser (j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser (j -> k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser j
-> RowParser (k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                            RowParser (k -> l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser k
-> RowParser (l -> (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser (l -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser l -> RowParser (a, b, c, d, e, f, g, h, i, j, k, l)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
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,
          FromField k, FromField l) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k, l)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k, l)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k, l)
-> Maybe (a, b, c, d, e, f, g, h, i, j, k, l)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k, l)
 -> Maybe (a, b, c, d, e, f, g, h, i, j, k, l))
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j, k, l)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l, FromField m) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m) where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m)
fromRow = (,,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
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
   -> k
   -> l
   -> m
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
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
   -> k
   -> l
   -> m
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
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
   -> k
   -> l
   -> m
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
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
   -> k
   -> l
   -> m
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
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
   -> k
   -> l
   -> m
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser f
-> RowParser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
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
   -> k
   -> l
   -> m
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser g
-> RowParser
     (h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
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
   -> k
   -> l
   -> m
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser h
-> RowParser
     (i -> j -> k -> l -> m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
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 -> k -> l -> m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser i
-> RowParser
     (j -> k -> l -> m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser
  (j -> k -> l -> m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser j
-> RowParser
     (k -> l -> m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                             RowParser (k -> l -> m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser k
-> RowParser (l -> m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser (l -> m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser l
-> RowParser (m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
forall a. FromField a => RowParser a
field RowParser (m -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser m -> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser m
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,
          FromField k, FromField l, FromField m) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k, l, m)
-> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k, l, m)
 -> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l, FromField m, FromField n) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
fromRow = (,,,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
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
   -> k
   -> l
   -> m
   -> n
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
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
   -> k
   -> l
   -> m
   -> n
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
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
   -> k
   -> l
   -> m
   -> n
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
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
   -> k
   -> l
   -> m
   -> n
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
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
   -> k
   -> l
   -> m
   -> n
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser f
-> RowParser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
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
   -> k
   -> l
   -> m
   -> n
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser g
-> RowParser
     (h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
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
   -> k
   -> l
   -> m
   -> n
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser h
-> RowParser
     (i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
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
   -> k
   -> l
   -> m
   -> n
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser i
-> RowParser
     (j
      -> k -> l -> m -> n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser
  (j
   -> k -> l -> m -> n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser j
-> RowParser
     (k -> l -> m -> n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                              RowParser
  (k -> l -> m -> n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser k
-> RowParser
     (l -> m -> n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser
  (l -> m -> n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser l
-> RowParser (m -> n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
forall a. FromField a => RowParser a
field RowParser (m -> n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser m
-> RowParser (n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser m
forall a. FromField a => RowParser a
field RowParser (n -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser n
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser n
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,
          FromField k, FromField l, FromField m, FromField n) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k, l, m, n)
 -> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l, FromField m, FromField n, FromField o) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
fromRow = (,,,,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser f
-> RowParser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser g
-> RowParser
     (h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser h
-> RowParser
     (i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser i
-> RowParser
     (j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser
  (j
   -> k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser j
-> RowParser
     (k
      -> l
      -> m
      -> n
      -> o
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                               RowParser
  (k
   -> l
   -> m
   -> n
   -> o
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser k
-> RowParser
     (l -> m -> n -> o -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser
  (l -> m -> n -> o -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser l
-> RowParser
     (m -> n -> o -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
forall a. FromField a => RowParser a
field RowParser
  (m -> n -> o -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser m
-> RowParser
     (n -> o -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser m
forall a. FromField a => RowParser a
field RowParser (n -> o -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser n
-> RowParser (o -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser n
forall a. FromField a => RowParser a
field RowParser (o -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser o
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser o
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,
          FromField k, FromField l, FromField m, FromField n, FromField o) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
 -> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
fromRow = (,,,,,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser f
-> RowParser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser g
-> RowParser
     (h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser h
-> RowParser
     (i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser i
-> RowParser
     (j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser
  (j
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser j
-> RowParser
     (k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                                RowParser
  (k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser k
-> RowParser
     (l
      -> m
      -> n
      -> o
      -> p
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser
  (l
   -> m
   -> n
   -> o
   -> p
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser l
-> RowParser
     (m
      -> n -> o -> p -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
forall a. FromField a => RowParser a
field RowParser
  (m
   -> n -> o -> p -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser m
-> RowParser
     (n -> o -> p -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser m
forall a. FromField a => RowParser a
field RowParser
  (n -> o -> p -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser n
-> RowParser
     (o -> p -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser n
forall a. FromField a => RowParser a
field RowParser
  (o -> p -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser o
-> RowParser
     (p -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser o
forall a. FromField a => RowParser a
field
                                RowParser (p -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser p
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser p
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,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)) where
    fromRow :: RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
forall a. Maybe a
Nothing)
           RowParser (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
 -> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p, FromField q) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
fromRow = (,,,,,,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser f
-> RowParser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser g
-> RowParser
     (h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser h
-> RowParser
     (i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser i
-> RowParser
     (j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser
  (j
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser j
-> RowParser
     (k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                                  RowParser
  (k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser k
-> RowParser
     (l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser
  (l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser l
-> RowParser
     (m
      -> n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
forall a. FromField a => RowParser a
field RowParser
  (m
   -> n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser m
-> RowParser
     (n
      -> o
      -> p
      -> q
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser m
forall a. FromField a => RowParser a
field RowParser
  (n
   -> o
   -> p
   -> q
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser n
-> RowParser
     (o
      -> p -> q -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser n
forall a. FromField a => RowParser a
field RowParser
  (o
   -> p -> q -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser o
-> RowParser
     (p -> q -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser o
forall a. FromField a => RowParser a
field
                                  RowParser
  (p -> q -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser p
-> RowParser
     (q -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser p
forall a. FromField a => RowParser a
field RowParser
  (q -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser q
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser q
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,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p, FromField q) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)) where
    fromRow :: RowParser
  (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
forall a. Maybe a
Nothing)
           RowParser
  (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
-> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
 -> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p, FromField q, FromField r) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
fromRow = (,,,,,,,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser f
-> RowParser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser g
-> RowParser
     (h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser h
-> RowParser
     (i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser i
-> RowParser
     (j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser
  (j
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser j
-> RowParser
     (k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                                  RowParser
  (k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser k
-> RowParser
     (l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser
  (l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser l
-> RowParser
     (m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
forall a. FromField a => RowParser a
field RowParser
  (m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser m
-> RowParser
     (n
      -> o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser m
forall a. FromField a => RowParser a
field RowParser
  (n
   -> o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser n
-> RowParser
     (o
      -> p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser n
forall a. FromField a => RowParser a
field RowParser
  (o
   -> p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser o
-> RowParser
     (p
      -> q
      -> r
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser o
forall a. FromField a => RowParser a
field
                                  RowParser
  (p
   -> q
   -> r
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser p
-> RowParser
     (q -> r -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser p
forall a. FromField a => RowParser a
field RowParser
  (q -> r -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser q
-> RowParser
     (r -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser q
forall a. FromField a => RowParser a
field RowParser
  (r -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser r
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser r
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,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p, FromField q, FromField r) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)) where
    fromRow :: RowParser
  (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
forall a. Maybe a
Nothing)
           RowParser
  (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
-> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
 -> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p, FromField q, FromField r, FromField s) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) where
    fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
fromRow = (,,,,,,,,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser f
-> RowParser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser g
-> RowParser
     (h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser h
-> RowParser
     (i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser i
-> RowParser
     (j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser
  (j
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser j
-> RowParser
     (k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                                   RowParser
  (k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser k
-> RowParser
     (l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser
  (l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser l
-> RowParser
     (m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
forall a. FromField a => RowParser a
field RowParser
  (m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser m
-> RowParser
     (n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser m
forall a. FromField a => RowParser a
field RowParser
  (n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser n
-> RowParser
     (o
      -> p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser n
forall a. FromField a => RowParser a
field RowParser
  (o
   -> p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser o
-> RowParser
     (p
      -> q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser o
forall a. FromField a => RowParser a
field
                                   RowParser
  (p
   -> q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser p
-> RowParser
     (q
      -> r
      -> s
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser p
forall a. FromField a => RowParser a
field RowParser
  (q
   -> r
   -> s
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser q
-> RowParser
     (r
      -> s -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser q
forall a. FromField a => RowParser a
field RowParser
  (r
   -> s -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser r
-> RowParser
     (s -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser r
forall a. FromField a => RowParser a
field RowParser
  (s -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser s
-> RowParser
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser s
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,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p, FromField q, FromField r, FromField s) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)) where
    fromRow :: RowParser
  (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
forall a. Maybe a
Nothing)
           RowParser
  (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
-> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
 -> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> RowParser
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
-> RowParser
     (Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
forall a. FromRow a => RowParser a
fromRow)

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p, FromField q, FromField r, FromField s, FromField t) =>
    FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) where
    fromRow :: RowParser
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
fromRow = (,,,,,,,,,,,,,,,,,,,) (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser a
-> RowParser
     (b
      -> c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser b
-> RowParser
     (c
      -> d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser c
-> RowParser
     (d
      -> e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser d
-> RowParser
     (e
      -> f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser e
-> RowParser
     (f
      -> g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser f
-> RowParser
     (g
      -> h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser g
-> RowParser
     (h
      -> i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser h
-> RowParser
     (i
      -> j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
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
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser i
-> RowParser
     (j
      -> k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser
  (j
   -> k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser j
-> RowParser
     (k
      -> l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
                                    RowParser
  (k
   -> l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser k
-> RowParser
     (l
      -> m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser k
forall a. FromField a => RowParser a
field RowParser
  (l
   -> m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser l
-> RowParser
     (m
      -> n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser l
forall a. FromField a => RowParser a
field RowParser
  (m
   -> n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser m
-> RowParser
     (n
      -> o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser m
forall a. FromField a => RowParser a
field RowParser
  (n
   -> o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser n
-> RowParser
     (o
      -> p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser n
forall a. FromField a => RowParser a
field RowParser
  (o
   -> p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser o
-> RowParser
     (p
      -> q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser o
forall a. FromField a => RowParser a
field
                                    RowParser
  (p
   -> q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser p
-> RowParser
     (q
      -> r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser p
forall a. FromField a => RowParser a
field RowParser
  (q
   -> r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser q
-> RowParser
     (r
      -> s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser q
forall a. FromField a => RowParser a
field RowParser
  (r
   -> s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser r
-> RowParser
     (s
      -> t
      -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser r
forall a. FromField a => RowParser a
field RowParser
  (s
   -> t
   -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser s
-> RowParser
     (t -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser s
forall a. FromField a => RowParser a
field RowParser
  (t -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser t
-> RowParser
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser t
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,
          FromField k, FromField l, FromField m, FromField n, FromField o,
          FromField p, FromField q, FromField r, FromField s, FromField t) =>
    FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)) where
    fromRow :: RowParser
  (Maybe
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
fromRow =  (RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null -> RowParser Null -> RowParser Null
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RowParser Null
null RowParser Null
-> RowParser
     (Maybe
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser
     (Maybe
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
-> RowParser
     (Maybe
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
forall a. Maybe a
Nothing)
           RowParser
  (Maybe
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser
     (Maybe
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser
     (Maybe
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
-> Maybe
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
forall a. a -> Maybe a
Just ((a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
 -> Maybe
      (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> RowParser
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
-> RowParser
     (Maybe
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
forall a. FromRow a => RowParser a
fromRow)

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

instance FromField a => FromRow (Maybe [a]) where
    fromRow :: RowParser (Maybe [a])
fromRow = do
      Int
n <- RowParser Int
numFieldsRemaining
      (Int -> RowParser Null -> RowParser ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n RowParser Null
null RowParser () -> RowParser (Maybe [a]) -> RowParser (Maybe [a])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe [a] -> RowParser (Maybe [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [a]
forall a. Maybe a
Nothing) RowParser (Maybe [a])
-> RowParser (Maybe [a]) -> RowParser (Maybe [a])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> RowParser [a] -> RowParser (Maybe [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RowParser a -> RowParser [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n RowParser a
forall a. FromField a => RowParser a
field)

instance FromField a => FromRow (Vector a) where
    fromRow :: RowParser (Vector a)
fromRow = do
      Int
n <- RowParser Int
numFieldsRemaining
      Int -> RowParser a -> RowParser (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
n RowParser a
forall a. FromField a => RowParser a
field

instance FromField a => FromRow (Maybe (Vector a)) where
    fromRow :: RowParser (Maybe (Vector a))
fromRow = do
      Int
n <- RowParser Int
numFieldsRemaining
      (Int -> RowParser Null -> RowParser ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n RowParser Null
null RowParser ()
-> RowParser (Maybe (Vector a)) -> RowParser (Maybe (Vector a))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe (Vector a) -> RowParser (Maybe (Vector a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Vector a)
forall a. Maybe a
Nothing) RowParser (Maybe (Vector a))
-> RowParser (Maybe (Vector a)) -> RowParser (Maybe (Vector a))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Vector a -> Maybe (Vector a)
forall a. a -> Maybe a
Just (Vector a -> Maybe (Vector a))
-> RowParser (Vector a) -> RowParser (Maybe (Vector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RowParser a -> RowParser (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
n 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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromRow a => RowParser a
fromRow



-- Type class for default implementation of FromRow using generics
class GFromRow f where
    gfromRow :: RowParser (f p)

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

instance (GFromRow f, GFromRow g) => GFromRow (f :*: g) where
    gfromRow :: RowParser ((:*:) f g p)
gfromRow = (f p -> g p -> (:*:) f g p)
-> RowParser (f p) -> RowParser (g p) -> RowParser ((:*:) f g p)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) RowParser (f p)
forall (f :: * -> *) p. GFromRow f => RowParser (f p)
gfromRow RowParser (g p)
forall (f :: * -> *) p. GFromRow f => RowParser (f p)
gfromRow

instance (FromField a) => GFromRow (K1 R a) where
    gfromRow :: RowParser (K1 R a p)
gfromRow = a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 R a p) -> RowParser a -> RowParser (K1 R 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 U1 where
    gfromRow :: RowParser (U1 p)
gfromRow = U1 p -> RowParser (U1 p)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1