{-# LANGUAGE DefaultSignatures, FlexibleContexts #-}
module Database.SQLite.Simple.FromRow
( GFromRow(..)
, FromRow(..)
, RowParser
, field
, fieldWith
, numFieldsRemaining
) where
import Control.Exception (SomeException(..))
import Control.Monad (replicateM)
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import GHC.Generics
import Database.SQLite.Simple.FromField
import Database.SQLite.Simple.Internal
import Database.SQLite.Simple.Ok
import Database.SQLite.Simple.Types
class GFromRow f where
gfromRow :: RowParser (f a)
instance GFromRow U1 where
gfromRow :: forall a. RowParser (U1 a)
gfromRow = U1 a -> RowParser (U1 a)
forall a. a -> RowParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
instance FromField a => GFromRow (K1 i a) where
gfromRow :: forall a. RowParser (K1 i a a)
gfromRow = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> RowParser a -> RowParser (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field
instance GFromRow a => GFromRow (M1 i c a) where
gfromRow :: forall a. RowParser (M1 i c a a)
gfromRow = a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> RowParser (a a) -> RowParser (M1 i c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a a)
forall a. RowParser (a a)
forall (f :: * -> *) a. GFromRow f => RowParser (f a)
gfromRow
instance (GFromRow a, GFromRow b) => GFromRow (a :*: b) where
gfromRow :: forall a. RowParser ((:*:) a b a)
gfromRow = a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a a -> b a -> (:*:) a b a)
-> RowParser (a a) -> RowParser (b a -> (:*:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (a a)
forall a. RowParser (a a)
forall (f :: * -> *) a. GFromRow f => RowParser (f a)
gfromRow RowParser (b a -> (:*:) a b a)
-> RowParser (b a) -> RowParser ((:*:) a b a)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (b a)
forall a. RowParser (b a)
forall (f :: * -> *) a. GFromRow f => RowParser (f a)
gfromRow
class FromRow a where
fromRow :: RowParser a
default fromRow :: Generic a => GFromRow (Rep a) => RowParser a
fromRow = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> RowParser (Rep a Any) -> RowParser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser (Rep a Any)
forall a. RowParser (Rep a a)
forall (f :: * -> *) a. GFromRow f => RowParser (f a)
gfromRow
fieldWith :: FieldParser a -> RowParser a
fieldWith :: forall a. FieldParser a -> RowParser a
fieldWith FieldParser a
fieldP = ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a -> RowParser a
forall a.
ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a -> RowParser a
RP (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a -> RowParser a)
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a -> RowParser a
forall a b. (a -> b) -> a -> b
$ do
Int
ncols <- (RowParseRO -> Int)
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) Int
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RowParseRO -> Int
nColumns
(Int
column, [SQLData]
remaining) <- StateT (Int, [SQLData]) Ok (Int, [SQLData])
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) (Int, [SQLData])
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Int, [SQLData]) Ok (Int, [SQLData])
forall (m :: * -> *) s. Monad m => StateT s m s
get
StateT (Int, [SQLData]) Ok ()
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Int, [SQLData]) -> StateT (Int, [SQLData]) Ok ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
column Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [SQLData] -> [SQLData]
forall a. HasCallStack => [a] -> [a]
tail [SQLData]
remaining))
if Int
column Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ncols
then
StateT (Int, [SQLData]) Ok a
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ok a -> StateT (Int, [SQLData]) Ok a
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Int, [SQLData]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([SomeException] -> Ok a
forall a. [SomeException] -> Ok a
Errors [ColumnOutOfBounds -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Int -> ColumnOutOfBounds
ColumnOutOfBounds (Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))]))
else do
let r :: SQLData
r = [SQLData] -> SQLData
forall a. HasCallStack => [a] -> a
head [SQLData]
remaining
field :: Field
field = SQLData -> Int -> Field
Field SQLData
r Int
column
StateT (Int, [SQLData]) Ok a
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ok a -> StateT (Int, [SQLData]) Ok a
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Int, [SQLData]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FieldParser a
fieldP Field
field))
field :: FromField a => RowParser a
field :: forall a. FromField a => RowParser a
field = FieldParser a -> RowParser a
forall a. FieldParser a -> RowParser a
fieldWith FieldParser a
forall a. FromField a => FieldParser a
fromField
numFieldsRemaining :: RowParser Int
numFieldsRemaining :: RowParser Int
numFieldsRemaining = ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) Int
-> RowParser Int
forall a.
ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a -> RowParser a
RP (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) Int
-> RowParser Int)
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) Int
-> RowParser Int
forall a b. (a -> b) -> a -> b
$ do
Int
ncols <- (RowParseRO -> Int)
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) Int
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks RowParseRO -> Int
nColumns
(Int
columnIdx,[SQLData]
_) <- StateT (Int, [SQLData]) Ok (Int, [SQLData])
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) (Int, [SQLData])
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Int, [SQLData]) Ok (Int, [SQLData])
forall (m :: * -> *) s. Monad m => StateT s m s
get
Int -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) Int
forall a. a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) Int)
-> Int -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) Int
forall a b. (a -> b) -> a -> b
$! Int
ncols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
columnIdx
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, FromField b) => FromRow (a,b) where
fromRow :: RowParser (a, b)
fromRow = (,) (a -> b -> (a, b)) -> RowParser a -> RowParser (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> (a, b)) -> RowParser b -> RowParser (a, b)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field
instance (FromField a, FromField b, FromField c) => FromRow (a,b,c) where
fromRow :: RowParser (a, b, c)
fromRow = (,,) (a -> b -> c -> (a, b, c))
-> RowParser a -> RowParser (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> (a, b, c))
-> RowParser b -> RowParser (c -> (a, b, c))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> (a, b, c)) -> RowParser c -> RowParser (a, b, c)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field
instance (FromField a, FromField b, FromField c, FromField d) =>
FromRow (a,b,c,d) where
fromRow :: RowParser (a, b, c, d)
fromRow = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> RowParser a -> RowParser (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> d -> (a, b, c, d))
-> RowParser b -> RowParser (c -> d -> (a, b, c, d))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> (a, b, c, d))
-> RowParser c -> RowParser (d -> (a, b, c, d))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> (a, b, c, d))
-> RowParser d -> RowParser (a, b, c, d)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field
instance (FromField a, FromField b, FromField c, FromField d, FromField e) =>
FromRow (a,b,c,d,e) where
fromRow :: RowParser (a, b, c, d, e)
fromRow = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> RowParser a -> RowParser (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> d -> e -> (a, b, c, d, e))
-> RowParser b -> RowParser (c -> d -> e -> (a, b, c, d, e))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> e -> (a, b, c, d, e))
-> RowParser c -> RowParser (d -> e -> (a, b, c, d, e))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> e -> (a, b, c, d, e))
-> RowParser d -> RowParser (e -> (a, b, c, d, e))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser (e -> (a, b, c, d, e))
-> RowParser e -> RowParser (a, b, c, d, e)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
instance (FromField a, FromField b, FromField c, FromField d, FromField e,
FromField f) =>
FromRow (a,b,c,d,e,f) where
fromRow :: RowParser (a, b, c, d, e, f)
fromRow = (,,,,,) (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> RowParser a
-> RowParser (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> RowParser b
-> RowParser (c -> d -> e -> f -> (a, b, c, d, e, f))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> e -> f -> (a, b, c, d, e, f))
-> RowParser c -> RowParser (d -> e -> f -> (a, b, c, d, e, f))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> e -> f -> (a, b, c, d, e, f))
-> RowParser d -> RowParser (e -> f -> (a, b, c, d, e, f))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser (e -> f -> (a, b, c, d, e, f))
-> RowParser e -> RowParser (f -> (a, b, c, d, e, f))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
RowParser (f -> (a, b, c, d, e, f))
-> RowParser f -> RowParser (a, b, c, d, e, f)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field
instance (FromField a, FromField b, FromField c, FromField d, FromField e,
FromField f, FromField g) =>
FromRow (a,b,c,d,e,f,g) where
fromRow :: RowParser (a, b, c, d, e, f, g)
fromRow = (,,,,,,) (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser a
-> RowParser (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser (b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser b
-> RowParser (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser c
-> RowParser (d -> e -> f -> g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser d -> RowParser (e -> f -> g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser (e -> f -> g -> (a, b, c, d, e, f, g))
-> RowParser e -> RowParser (f -> g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
RowParser (f -> g -> (a, b, c, d, e, f, g))
-> RowParser f -> RowParser (g -> (a, b, c, d, e, f, g))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field RowParser (g -> (a, b, c, d, e, f, g))
-> RowParser g -> RowParser (a, b, c, d, e, f, g)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field
instance (FromField a, FromField b, FromField c, FromField d, FromField e,
FromField f, FromField g, FromField h) =>
FromRow (a,b,c,d,e,f,g,h) where
fromRow :: RowParser (a, b, c, d, e, f, g, h)
fromRow = (,,,,,,,) (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser a
-> RowParser
(b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser
(b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser b
-> RowParser
(c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser (c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser c
-> RowParser (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser (d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser d
-> RowParser (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser (e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser e
-> RowParser (f -> g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
RowParser (f -> g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser f -> RowParser (g -> h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field RowParser (g -> h -> (a, b, c, d, e, f, g, h))
-> RowParser g -> RowParser (h -> (a, b, c, d, e, f, g, h))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field RowParser (h -> (a, b, c, d, e, f, g, h))
-> RowParser h -> RowParser (a, b, c, d, e, f, g, h)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser h
forall a. FromField a => RowParser a
field
instance (FromField a, FromField b, FromField c, FromField d, FromField e,
FromField f, FromField g, FromField h, FromField i) =>
FromRow (a,b,c,d,e,f,g,h,i) where
fromRow :: RowParser (a, b, c, d, e, f, g, h, i)
fromRow = (,,,,,,,,) (a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> (a, b, c, d, e, f, g, h, i))
-> RowParser a
-> RowParser
(b
-> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser
(b
-> c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser b
-> RowParser
(c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser
(c -> d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser c
-> RowParser
(d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser
(d -> e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser d
-> RowParser (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser (e -> f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser e
-> RowParser (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
RowParser (f -> g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser f
-> RowParser (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field RowParser (g -> h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser g -> RowParser (h -> i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field RowParser (h -> i -> (a, b, c, d, e, f, g, h, i))
-> RowParser h -> RowParser (i -> (a, b, c, d, e, f, g, h, i))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser h
forall a. FromField a => RowParser a
field RowParser (i -> (a, b, c, d, e, f, g, h, i))
-> RowParser i -> RowParser (a, b, c, d, e, f, g, h, i)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field
instance (FromField a, FromField b, FromField c, FromField d, FromField e,
FromField f, FromField g, FromField h, FromField i, FromField j) =>
FromRow (a,b,c,d,e,f,g,h,i,j) where
fromRow :: RowParser (a, b, c, d, e, f, g, h, i, j)
fromRow = (,,,,,,,,,) (a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> (a, b, c, d, e, f, g, h, i, j))
-> RowParser a
-> RowParser
(b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> (a, b, c, d, e, f, g, h, i, j))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromField a => RowParser a
field RowParser
(b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> (a, b, c, d, e, f, g, h, i, j))
-> RowParser b
-> RowParser
(c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromField a => RowParser a
field RowParser
(c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> (a, b, c, d, e, f, g, h, i, j))
-> RowParser c
-> RowParser
(d -> e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser c
forall a. FromField a => RowParser a
field RowParser
(d -> e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser d
-> RowParser
(e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser d
forall a. FromField a => RowParser a
field RowParser
(e -> f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser e
-> RowParser
(f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser e
forall a. FromField a => RowParser a
field
RowParser (f -> g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser f
-> RowParser (g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser f
forall a. FromField a => RowParser a
field RowParser (g -> h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser g
-> RowParser (h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser g
forall a. FromField a => RowParser a
field RowParser (h -> i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser h
-> RowParser (i -> j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser h
forall a. FromField a => RowParser a
field RowParser (i -> j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser i -> RowParser (j -> (a, b, c, d, e, f, g, h, i, j))
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser i
forall a. FromField a => RowParser a
field RowParser (j -> (a, b, c, d, e, f, g, h, i, j))
-> RowParser j -> RowParser (a, b, c, d, e, f, g, h, i, j)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser j
forall a. FromField a => RowParser a
field
instance FromField a => FromRow [a] where
fromRow :: RowParser [a]
fromRow = do
Int
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 (FromRow a, FromRow b) => FromRow (a :. b) where
fromRow :: RowParser (a :. b)
fromRow = a -> b -> a :. b
forall h t. h -> t -> h :. t
(:.) (a -> b -> a :. b) -> RowParser a -> RowParser (b -> a :. b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser a
forall a. FromRow a => RowParser a
fromRow RowParser (b -> a :. b) -> RowParser b -> RowParser (a :. b)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser b
forall a. FromRow a => RowParser a
fromRow