{-# 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 = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = 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 = 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 =
    forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
      Oid
oid <- Result -> Column -> IO Oid
PQ.ftype Result
rowresult Column
col
      forall a. a -> Ok a
Ok 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 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 :: forall a. FieldParser a -> RowParser a
fieldWith FieldParser a
fieldP = forall a. ReaderT Row (StateT Column Conversion) a -> RowParser a
RP forall a b. (a -> b) -> a -> b
$ do
    let unCol :: Column -> Int
unCol (PQ.Col CInt
x) = 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
..} <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    Column
column <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Column
column forall a. Num a => a -> a -> a
+ Column
1))
    let ncols :: Column
ncols = Result -> Column
nfields Result
rowresult
    if (Column
column forall a. Ord a => a -> a -> Bool
>= Column
ncols)
    then forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
        [ByteString]
vals <- 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
ncolsforall a. Num a => a -> a -> a
-Column
1]
        let err :: ResultError
err = [Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError
ConversionFailed
                (forall a. Show a => a -> [Char]
show (Column -> Int
unCol Column
ncols) forall a. [a] -> [a] -> [a]
++ [Char]
" values: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
ellipsis [ByteString]
vals))
                forall a. Maybe a
Nothing
                [Char]
""
                ([Char]
"at least " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Column -> Int
unCol Column
column forall a. Num a => a -> a -> a
+ Int
1)
                  forall a. [a] -> [a] -> [a]
++ [Char]
" slots in target type")
                [Char]
"mismatch between number of columns to \
                \convert and number in target type"
        forall err a. Exception err => err -> Conversion a
conversionError ResultError
err
    else do
      let !result :: Result
result = Result
rowresult
          !typeOid :: Oid
typeOid = forall a. IO a -> a
unsafeDupablePerformIO (Result -> Column -> IO Oid
PQ.ftype Result
result Column
column)
          !field' :: Field
field' = Field{Result
Oid
Column
typeOid :: Oid
column :: Column
result :: Result
typeOid :: Oid
result :: Result
column :: Column
..}
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (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 :: forall a. FromField a => RowParser a
field = forall a. FieldParser a -> RowParser a
fieldWith forall a. FromField a => FieldParser a
fromField

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

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

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

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

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

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

instance (FromRow a, FromRow b) => FromRow (a :. b) where
    fromRow :: RowParser (a :. b)
fromRow = forall h t. h -> t -> h :. t
(:.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromRow a => RowParser a
fromRow forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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 :: forall p. RowParser (M1 c i f p)
gfromRow = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) p. GFromRow f => RowParser (f p)
gfromRow

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

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

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