{-# LANGUAGE
    BangPatterns,
    CPP,
    DefaultSignatures,
    FlexibleContexts,
    FlexibleInstances,
    KindSignatures,
    MultiParamTypeClasses,
    OverloadedStrings,
    Rank2Types,
    ScopedTypeVariables,
    TypeOperators,
    UndecidableInstances
    #-}

#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
#endif

#if !MIN_VERSION_bytestring(0,10,4)
# define MIN_VERSION_text_short(a,b,c) 0
#endif

#if !defined(MIN_VERSION_text_short)
# error **INVARIANT BROKEN** Detected invalid combination of `text-short` and `bytestring` versions. Please verify the `pre-bytestring-0.10-4` flag-logic in the .cabal file wasn't elided.
#endif

module Data.Csv.Conversion
    (
    -- * Type conversion
      Only(..)
    , FromRecord(..)
    , FromNamedRecord(..)
    , ToNamedRecord(..)
    , DefaultOrdered(..)
    , FromField(..)
    , ToRecord(..)
    , ToField(..)

    -- ** Generic type conversion
    , genericParseRecord
    , genericToRecord
    , genericParseNamedRecord
    , genericToNamedRecord
    , genericHeaderOrder

    -- *** Generic type conversion options
    , Options
    , defaultOptions
    , fieldLabelModifier

    -- *** Generic type conversion class names
    , GFromRecord
    , GToRecord
    , GFromNamedRecord
    , GToNamedRecordHeader

    -- * Parser
    , Parser
    , runParser

    -- * Accessors
    , index
    , (.!)
    , unsafeIndex
    , lookup
    , (.:)
    , namedField
    , (.=)
    , record
    , namedRecord
    , header
    ) where

import Control.Applicative (Alternative, (<|>), empty, Const(..))
import Control.Monad (MonadPlus, mplus, mzero)
import qualified Control.Monad.Fail as Fail
import Data.Attoparsec.ByteString.Char8 (double)
import qualified Data.Attoparsec.ByteString.Char8 as A8
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as L
#if MIN_VERSION_bytestring(0,10,4)
import qualified Data.ByteString.Short as SBS
#endif
import Data.Functor.Identity
import Data.List (intercalate)
import Data.Hashable (Hashable)
import qualified Data.HashMap.Lazy as HM
import Data.Int (Int8, Int16, Int32, Int64)
import qualified Data.IntMap as IM
import qualified Data.Map as M
import Data.Scientific (Scientific)
import Data.Semigroup as Semi (Semigroup, (<>))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
#if MIN_VERSION_text_short(0,1,0)
import qualified Data.Text.Short as T.S
#endif
import Data.Tuple.Only (Only(..))
import Data.Vector (Vector, (!))
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import Data.Word (Word8, Word16, Word32, Word64)
import GHC.Float (double2Float)
import GHC.Generics
import Numeric.Natural
import Prelude hiding (lookup, takeWhile)

import Data.Csv.Conversion.Internal
import Data.Csv.Types

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative, (<$>), (<*>), (<*), (*>), pure)
import Data.Monoid (Monoid, mappend, mempty)
import Data.Traversable (traverse)
import Data.Word (Word)
#endif

------------------------------------------------------------------------
-- bytestring compatibility

toStrict   :: L.ByteString -> B.ByteString
fromStrict :: B.ByteString -> L.ByteString
#if MIN_VERSION_bytestring(0,10,0)
toStrict :: ByteString -> ByteString
toStrict   = ByteString -> ByteString
L.toStrict
fromStrict :: ByteString -> ByteString
fromStrict = ByteString -> ByteString
L.fromStrict
#else
toStrict   = B.concat . L.toChunks
fromStrict = L.fromChunks . (:[])
#endif
{-# INLINE toStrict #-}
{-# INLINE fromStrict #-}

------------------------------------------------------------------------
-- Type conversion

------------------------------------------------------------------------
-- Index-based conversion

-- | Options to customise how to generically encode\/decode your
--   datatype to\/from CSV.
--
--   @since 0.5.1.0
newtype Options = Options
  { Options -> String -> String
fieldLabelModifier :: String -> String
    -- ^ How to convert Haskell field labels to CSV fields.
    --
    --   @since 0.5.1.0
  }

instance Show Options where
  show :: Options -> String
show (Options String -> String
fld) =
    String
"Options {"
      forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
","
         [ String
"fieldLabelModifier =~ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
sampleField forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (String -> String
fld String
sampleField)
         ]
      forall a. [a] -> [a] -> [a]
++ String
"}"
    where
      sampleField :: String
sampleField = String
"_column_A"

-- | Default conversion options.
--
--   @
--   Options
--   { 'fieldLabelModifier' = id
--   }
--   @
--
--   @since 0.5.1.0
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
  { fieldLabelModifier :: String -> String
fieldLabelModifier = forall a. a -> a
id
  }

-- | A type that can be converted from a single CSV record, with the
-- possibility of failure.
--
-- When writing an instance, use 'empty', 'mzero', or 'fail' to make a
-- conversion fail, e.g. if a 'Record' has the wrong number of
-- columns.
--
-- Given this example data:
--
-- > John,56
-- > Jane,55
--
-- here's an example type and instance:
--
-- > data Person = Person { name :: !Text, age :: !Int }
-- >
-- > instance FromRecord Person where
-- >     parseRecord v
-- >         | length v == 2 = Person <$>
-- >                           v .! 0 <*>
-- >                           v .! 1
-- >         | otherwise     = mzero
class FromRecord a where
    parseRecord :: Record -> Parser a

    default parseRecord :: (Generic a, GFromRecord (Rep a)) => Record -> Parser a
    parseRecord = forall a.
(Generic a, GFromRecord (Rep a)) =>
Options -> Record -> Parser a
genericParseRecord Options
defaultOptions

-- | A configurable CSV record parser.  This function applied to
--   'defaultOptions' is used as the default for 'parseRecord' when the
--   type is an instance of 'Generic'.
--
--   @since 0.5.1.0
genericParseRecord :: (Generic a, GFromRecord (Rep a)) => Options -> Record -> Parser a
genericParseRecord :: forall a.
(Generic a, GFromRecord (Rep a)) =>
Options -> Record -> Parser a
genericParseRecord Options
opts Record
r = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (p :: k).
GFromRecord f =>
Options -> Record -> Parser (f p)
gparseRecord Options
opts Record
r

-- | A type that can be converted to a single CSV record.
--
-- An example type and instance:
--
-- > data Person = Person { name :: !Text, age :: !Int }
-- >
-- > instance ToRecord Person where
-- >     toRecord (Person name age) = record [
-- >         toField name, toField age]
--
-- Outputs data on this form:
--
-- > John,56
-- > Jane,55
class ToRecord a where
    -- | Convert a value to a record.
    toRecord :: a -> Record

    default toRecord :: (Generic a, GToRecord (Rep a) Field) => a -> Record
    toRecord = forall a.
(Generic a, GToRecord (Rep a) ByteString) =>
Options -> a -> Record
genericToRecord Options
defaultOptions

-- | A configurable CSV record creator.  This function applied to
--   'defaultOptions' is used as the default for 'toRecord' when the
--   type is an instance of 'Generic'.
--
--   @since 0.5.1.0
genericToRecord :: (Generic a, GToRecord (Rep a) Field) => Options -> a -> Record
genericToRecord :: forall a.
(Generic a, GToRecord (Rep a) ByteString) =>
Options -> a -> Record
genericToRecord Options
opts = forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k -> *) f (p :: k).
GToRecord a f =>
Options -> a p -> [f]
gtoRecord Options
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

instance FromField a => FromRecord (Only a) where
    parseRecord :: Record -> Parser (Only a)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
1    = forall a. a -> Only a
Only forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
1 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

-- TODO: Check if we want all toRecord conversions to be stricter.

instance ToField a => ToRecord (Only a) where
    toRecord :: Only a -> Record
toRecord = forall a. a -> Vector a
V.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToField a => a -> ByteString
toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Only a -> a
fromOnly

instance (FromField a, FromField b) => FromRecord (a, b) where
    parseRecord :: Record -> Parser (a, b)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
2    = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
2 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b) => ToRecord (a, b) where
    toRecord :: (a, b) -> Record
toRecord (a
a, b
b) = forall a. [a] -> Vector a
V.fromList [forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b]

instance (FromField a, FromField b, FromField c) => FromRecord (a, b, c) where
    parseRecord :: Record -> Parser (a, b, c)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
3    = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
3 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c) =>
         ToRecord (a, b, c) where
    toRecord :: (a, b, c) -> Record
toRecord (a
a, b
b, c
c) = forall a. [a] -> Vector a
V.fromList [forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c]

instance (FromField a, FromField b, FromField c, FromField d) =>
         FromRecord (a, b, c, d) where
    parseRecord :: Record -> Parser (a, b, c, d)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
4    = (,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
4 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d) =>
         ToRecord (a, b, c, d) where
    toRecord :: (a, b, c, d) -> Record
toRecord (a
a, b
b, c
c, d
d) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d]

instance (FromField a, FromField b, FromField c, FromField d, FromField e) =>
         FromRecord (a, b, c, d, e) where
    parseRecord :: Record -> Parser (a, b, c, d, e)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
5    = (,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
5 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e) =>
         ToRecord (a, b, c, d, e) where
    toRecord :: (a, b, c, d, e) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e]

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f) =>
         FromRecord (a, b, c, d, e, f) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
6    = (,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
6 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) =>
         ToRecord (a, b, c, d, e, f) where
    toRecord :: (a, b, c, d, e, f) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f]

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g) =>
         FromRecord (a, b, c, d, e, f, g) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f, g)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
7    = (,,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
6
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
7 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g) =>
         ToRecord (a, b, c, d, e, f, g) where
    toRecord :: (a, b, c, d, e, f, g) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f,
        forall a. ToField a => a -> ByteString
toField g
g]

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h) =>
         FromRecord (a, b, c, d, e, f, g, h) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f, g, h)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
8    = (,,,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
6
                                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
7
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
8 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g, ToField h) =>
         ToRecord (a, b, c, d, e, f, g, h) where
    toRecord :: (a, b, c, d, e, f, g, h) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f,
        forall a. ToField a => a -> ByteString
toField g
g, forall a. ToField a => a -> ByteString
toField h
h]

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i) =>
         FromRecord (a, b, c, d, e, f, g, h, i) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f, g, h, i)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
9    = (,,,,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
6
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
7
                                 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
8
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
9 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g, ToField h, ToField i) =>
         ToRecord (a, b, c, d, e, f, g, h, i) where
    toRecord :: (a, b, c, d, e, f, g, h, i) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f,
        forall a. ToField a => a -> ByteString
toField g
g, forall a. ToField a => a -> ByteString
toField h
h, forall a. ToField a => a -> ByteString
toField i
i]

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j) =>
         FromRecord (a, b, c, d, e, f, g, h, i, j) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f, g, h, i, j)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
10    = (,,,,,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
6
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
7
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
8
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
9
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
10 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g, ToField h, ToField i, ToField j) =>
         ToRecord (a, b, c, d, e, f, g, h, i, j) where
    toRecord :: (a, b, c, d, e, f, g, h, i, j) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f,
        forall a. ToField a => a -> ByteString
toField g
g, forall a. ToField a => a -> ByteString
toField h
h, forall a. ToField a => a -> ByteString
toField i
i, forall a. ToField a => a -> ByteString
toField j
j]

instance (FromField a, FromField b, FromField c, FromField d, FromField e,
          FromField f, FromField g, FromField h, FromField i, FromField j,
          FromField k) =>
         FromRecord (a, b, c, d, e, f, g, h, i, j, k) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f, g, h, i, j, k)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
11    = (,,,,,,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
6
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
7
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
8
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
9
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
10
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
11 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g, ToField h, ToField i, ToField j, ToField k) =>
         ToRecord (a, b, c, d, e, f, g, h, i, j, k) where
    toRecord :: (a, b, c, d, e, f, g, h, i, j, k) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f,
        forall a. ToField a => a -> ByteString
toField g
g, forall a. ToField a => a -> ByteString
toField h
h, forall a. ToField a => a -> ByteString
toField i
i, forall a. ToField a => a -> ByteString
toField j
j, forall a. ToField a => a -> ByteString
toField k
k]

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) =>
         FromRecord (a, b, c, d, e, f, g, h, i, j, k, l) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f, g, h, i, j, k, l)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
12    = (,,,,,,,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
6
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
7
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
8
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
9
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
10
                                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
11
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
12 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g, ToField h, ToField i, ToField j, ToField k, ToField l) =>
         ToRecord (a, b, c, d, e, f, g, h, i, j, k, l) where
    toRecord :: (a, b, c, d, e, f, g, h, i, j, k, l) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f,
        forall a. ToField a => a -> ByteString
toField g
g, forall a. ToField a => a -> ByteString
toField h
h, forall a. ToField a => a -> ByteString
toField i
i, forall a. ToField a => a -> ByteString
toField j
j, forall a. ToField a => a -> ByteString
toField k
k, forall a. ToField a => a -> ByteString
toField l
l]

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) =>
         FromRecord (a, b, c, d, e, f, g, h, i, j, k, l, m) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
13    = (,,,,,,,,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
6
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
7
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
8
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
9
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
10
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
11
                                      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
12
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
13 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
          ToField m) =>
         ToRecord (a, b, c, d, e, f, g, h, i, j, k, l, m) where
    toRecord :: (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f,
        forall a. ToField a => a -> ByteString
toField g
g, forall a. ToField a => a -> ByteString
toField h
h, forall a. ToField a => a -> ByteString
toField i
i, forall a. ToField a => a -> ByteString
toField j
j, forall a. ToField a => a -> ByteString
toField k
k, forall a. ToField a => a -> ByteString
toField l
l,
        forall a. ToField a => a -> ByteString
toField m
m]

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) =>
         FromRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
14    = (,,,,,,,,,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
6
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
7
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
8
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
9
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
10
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
11
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
12
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
13
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
14 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
          ToField m, ToField n) =>
         ToRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
    toRecord :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f,
        forall a. ToField a => a -> ByteString
toField g
g, forall a. ToField a => a -> ByteString
toField h
h, forall a. ToField a => a -> ByteString
toField i
i, forall a. ToField a => a -> ByteString
toField j
j, forall a. ToField a => a -> ByteString
toField k
k, forall a. ToField a => a -> ByteString
toField l
l,
        forall a. ToField a => a -> ByteString
toField m
m, forall a. ToField a => a -> ByteString
toField n
n]

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) =>
         FromRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
    parseRecord :: Record -> Parser (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
parseRecord Record
v
        | Int
n forall a. Eq a => a -> a -> Bool
== Int
15    = (,,,,,,,,,,,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
0
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
1
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
2
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
3
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
4
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
5
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
6
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
7
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
8
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
9
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
10
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
11
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
12
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
13
                                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
14
        | Bool
otherwise = forall a. Int -> Record -> Parser a
lengthMismatch Int
15 Record
v
          where
            n :: Int
n = forall a. Vector a -> Int
V.length Record
v

instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
          ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
          ToField m, ToField n, ToField o) =>
         ToRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
    toRecord :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Record
toRecord (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l, m
m, n
n, o
o) = forall a. [a] -> Vector a
V.fromList [
        forall a. ToField a => a -> ByteString
toField a
a, forall a. ToField a => a -> ByteString
toField b
b, forall a. ToField a => a -> ByteString
toField c
c, forall a. ToField a => a -> ByteString
toField d
d, forall a. ToField a => a -> ByteString
toField e
e, forall a. ToField a => a -> ByteString
toField f
f,
        forall a. ToField a => a -> ByteString
toField g
g, forall a. ToField a => a -> ByteString
toField h
h, forall a. ToField a => a -> ByteString
toField i
i, forall a. ToField a => a -> ByteString
toField j
j, forall a. ToField a => a -> ByteString
toField k
k, forall a. ToField a => a -> ByteString
toField l
l,
        forall a. ToField a => a -> ByteString
toField m
m, forall a. ToField a => a -> ByteString
toField n
n, forall a. ToField a => a -> ByteString
toField o
o]

lengthMismatch :: Int -> Record -> Parser a
lengthMismatch :: forall a. Int -> Record -> Parser a
lengthMismatch Int
expected Record
v =
    forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"cannot unpack array of length " forall a. [a] -> [a] -> [a]
++
    forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" into a " forall a. [a] -> [a] -> [a]
++ String
desired forall a. [a] -> [a] -> [a]
++ String
". Input record: " forall a. [a] -> [a] -> [a]
++
    forall a. Show a => a -> String
show Record
v
  where
    n :: Int
n = forall a. Vector a -> Int
V.length Record
v
    desired :: String
desired | Int
expected forall a. Eq a => a -> a -> Bool
== Int
1 = String
"Only"
            | Int
expected forall a. Eq a => a -> a -> Bool
== Int
2 = String
"pair"
            | Bool
otherwise     = forall a. Show a => a -> String
show Int
expected forall a. [a] -> [a] -> [a]
++ String
"-tuple"

instance FromField a => FromRecord [a] where
    parseRecord :: Record -> Parser [a]
parseRecord = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromField a => ByteString -> Parser a
parseField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList

instance ToField a => ToRecord [a] where
    toRecord :: [a] -> Record
toRecord = forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToField a => a -> ByteString
toField

instance FromField a => FromRecord (V.Vector a) where
    parseRecord :: Record -> Parser (Vector a)
parseRecord = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromField a => ByteString -> Parser a
parseField

instance ToField a => ToRecord (Vector a) where
    toRecord :: Vector a -> Record
toRecord = forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. ToField a => a -> ByteString
toField

instance (FromField a, U.Unbox a) => FromRecord (U.Vector a) where
    parseRecord :: Record -> Parser (Vector a)
parseRecord = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
U.convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromField a => ByteString -> Parser a
parseField

instance (ToField a, U.Unbox a) => ToRecord (U.Vector a) where
    toRecord :: Vector a -> Record
toRecord = forall a b. (a -> b) -> Vector a -> Vector b
V.map forall a. ToField a => a -> ByteString
toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
U.convert

------------------------------------------------------------------------
-- Name-based conversion

-- | A type that can be converted from a single CSV record, with the
-- possibility of failure.
--
-- When writing an instance, use 'empty', 'mzero', or 'fail' to make a
-- conversion fail, e.g. if a 'Record' has the wrong number of
-- columns.
--
-- Given this example data:
--
-- > name,age
-- > John,56
-- > Jane,55
--
-- here's an example type and instance:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > data Person = Person { name :: !Text, age :: !Int }
-- >
-- > instance FromNamedRecord Person where
-- >     parseNamedRecord m = Person <$>
-- >                          m .: "name" <*>
-- >                          m .: "age"
--
-- Note the use of the @OverloadedStrings@ language extension which
-- enables 'B8.ByteString' values to be written as string literals.
class FromNamedRecord a where
    parseNamedRecord :: NamedRecord -> Parser a

    default parseNamedRecord :: (Generic a, GFromNamedRecord (Rep a)) => NamedRecord -> Parser a
    parseNamedRecord = forall a.
(Generic a, GFromNamedRecord (Rep a)) =>
Options -> NamedRecord -> Parser a
genericParseNamedRecord Options
defaultOptions

-- | A configurable CSV named record parser.  This function applied to
--   'defaultOptions' is used as the default for 'parseNamedRecord'
--   when the type is an instance of 'Generic'.
--
--   @since 0.5.1.0
genericParseNamedRecord :: (Generic a, GFromNamedRecord (Rep a)) => Options -> NamedRecord -> Parser a
genericParseNamedRecord :: forall a.
(Generic a, GFromNamedRecord (Rep a)) =>
Options -> NamedRecord -> Parser a
genericParseNamedRecord Options
opts NamedRecord
r = forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) (p :: k).
GFromNamedRecord f =>
Options -> NamedRecord -> Parser (f p)
gparseNamedRecord Options
opts NamedRecord
r

-- | A type that can be converted to a single CSV record.
--
-- An example type and instance:
--
-- > data Person = Person { name :: !Text, age :: !Int }
-- >
-- > instance ToNamedRecord Person where
-- >     toNamedRecord (Person name age) = namedRecord [
-- >         "name" .= name, "age" .= age]
class ToNamedRecord a where
    -- | Convert a value to a named record.
    toNamedRecord :: a -> NamedRecord

    default toNamedRecord ::
        (Generic a, GToRecord (Rep a) (B.ByteString, B.ByteString)) =>
        a -> NamedRecord
    toNamedRecord = forall a.
(Generic a, GToRecord (Rep a) (ByteString, ByteString)) =>
Options -> a -> NamedRecord
genericToNamedRecord Options
defaultOptions

-- | A configurable CSV named record creator.  This function applied
--   to 'defaultOptions' is used as the default for 'toNamedRecord' when
--   the type is an instance of 'Generic'.
--
--   @since 0.5.1.0
genericToNamedRecord :: (Generic a, GToRecord (Rep a) (B.ByteString, B.ByteString))
                        => Options -> a -> NamedRecord
genericToNamedRecord :: forall a.
(Generic a, GToRecord (Rep a) (ByteString, ByteString)) =>
Options -> a -> NamedRecord
genericToNamedRecord Options
opts = [(ByteString, ByteString)] -> NamedRecord
namedRecord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k -> *) f (p :: k).
GToRecord a f =>
Options -> a p -> [f]
gtoRecord Options
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

-- | A type that has a default field order when converted to CSV. This
-- class lets you specify how to get the headers to use for a record
-- type that's an instance of 'ToNamedRecord'.
--
-- To derive an instance, the type is required to only have one
-- constructor and that constructor must have named fields (also known
-- as selectors) for all fields.
--
-- Right: @data Foo = Foo { foo :: !Int }@
--
-- Wrong: @data Bar = Bar Int@
--
-- If you try to derive an instance using GHC generics and your type
-- doesn't have named fields, you will get an error along the lines
-- of:
--
-- > <interactive>:9:10:
-- >     No instance for (DefaultOrdered (M1 S NoSelector (K1 R Char) ()))
-- >       arising from a use of ‘Data.Csv.Conversion.$gdmheader’
-- >     In the expression: Data.Csv.Conversion.$gdmheader
-- >     In an equation for ‘header’:
-- >         header = Data.Csv.Conversion.$gdmheader
-- >     In the instance declaration for ‘DefaultOrdered Foo’
--
class DefaultOrdered a where
    -- | The header order for this record. Should include the names
    -- used in the 'NamedRecord' returned by 'toNamedRecord'. Pass
    -- 'undefined' as the argument, together with a type annotation
    -- e.g. @'headerOrder' ('undefined' :: MyRecord)@.
    headerOrder :: a -> Header  -- TODO: Add Generic implementation

    default headerOrder ::
        (Generic a, GToNamedRecordHeader (Rep a)) =>
        a -> Header
    headerOrder = forall a.
(Generic a, GToNamedRecordHeader (Rep a)) =>
Options -> a -> Record
genericHeaderOrder Options
defaultOptions

-- | A configurable CSV header record generator.  This function
--   applied to 'defaultOptions' is used as the default for
--   'headerOrder' when the type is an instance of 'Generic'.
--
--   @since 0.5.1.0
genericHeaderOrder :: (Generic a, GToNamedRecordHeader (Rep a))
                      => Options -> a -> Header
genericHeaderOrder :: forall a.
(Generic a, GToNamedRecordHeader (Rep a)) =>
Options -> a -> Record
genericHeaderOrder Options
opts = forall a. [a] -> Vector a
V.fromListforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k -> *) (p :: k).
GToNamedRecordHeader a =>
Options -> a p -> [ByteString]
gtoNamedRecordHeader Options
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

instance (FromField a, FromField b, Ord a) => FromNamedRecord (M.Map a b) where
    parseNamedRecord :: NamedRecord -> Parser (Map a b)
parseNamedRecord NamedRecord
m = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b.
(FromField a, FromField b) =>
(ByteString, ByteString) -> Parser (a, b)
parseBoth forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HM.toList NamedRecord
m)

instance (ToField a, ToField b, Ord a) => ToNamedRecord (M.Map a b) where
    toNamedRecord :: Map a b -> NamedRecord
toNamedRecord = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ (a
k, b
v) -> (forall a. ToField a => a -> ByteString
toField a
k, forall a. ToField a => a -> ByteString
toField b
v)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList

instance (Eq a, FromField a, FromField b, Hashable a) => FromNamedRecord (HM.HashMap a b) where
    parseNamedRecord :: NamedRecord -> Parser (HashMap a b)
parseNamedRecord NamedRecord
m = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b.
(FromField a, FromField b) =>
(ByteString, ByteString) -> Parser (a, b)
parseBoth forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HM.toList NamedRecord
m)

instance (Eq a, ToField a, ToField b, Hashable a) => ToNamedRecord (HM.HashMap a b) where
    toNamedRecord :: HashMap a b -> NamedRecord
toNamedRecord = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ (a
k, b
v) -> (forall a. ToField a => a -> ByteString
toField a
k, forall a. ToField a => a -> ByteString
toField b
v)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HM.toList

parseBoth :: (FromField a, FromField b) => (Field, Field) -> Parser (a, b)
parseBoth :: forall a b.
(FromField a, FromField b) =>
(ByteString, ByteString) -> Parser (a, b)
parseBoth (ByteString
k, ByteString
v) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => ByteString -> Parser a
parseField ByteString
k forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromField a => ByteString -> Parser a
parseField ByteString
v

------------------------------------------------------------------------
-- Individual field conversion

-- | A type that can be converted from a single CSV field, with the
-- possibility of failure.
--
-- When writing an instance, use 'empty', 'mzero', or 'fail' to make a
-- conversion fail, e.g. if a 'Field' can't be converted to the given
-- type.
--
-- Example type and instance:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > data Color = Red | Green | Blue
-- >
-- > instance FromField Color where
-- >     parseField s
-- >         | s == "R"  = pure Red
-- >         | s == "G"  = pure Green
-- >         | s == "B"  = pure Blue
-- >         | otherwise = mzero
class FromField a where
    parseField :: Field -> Parser a

-- | A type that can be converted to a single CSV field.
--
-- Example type and instance:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > data Color = Red | Green | Blue
-- >
-- > instance ToField Color where
-- >     toField Red   = "R"
-- >     toField Green = "G"
-- >     toField Blue  = "B"
class ToField a where
    toField :: a -> Field

-- | 'Nothing' if the 'Field' is 'B.empty', 'Just' otherwise.
instance FromField a => FromField (Maybe a) where
    parseField :: ByteString -> Parser (Maybe a)
parseField ByteString
s
        | ByteString -> Bool
B.null ByteString
s  = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => ByteString -> Parser a
parseField ByteString
s
    {-# INLINE parseField #-}

-- | 'Nothing' is encoded as an 'B.empty' field.
instance ToField a => ToField (Maybe a) where
    toField :: Maybe a -> ByteString
toField = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
B.empty forall a. ToField a => a -> ByteString
toField
    {-# INLINE toField #-}

-- | @'Left' field@ if conversion failed, 'Right' otherwise.
instance FromField a => FromField (Either Field a) where
    parseField :: ByteString -> Parser (Either ByteString a)
parseField ByteString
s = case forall a. Parser a -> Either String a
runParser (forall a. FromField a => ByteString -> Parser a
parseField ByteString
s) of
        Left String
_  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ByteString
s
        Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
a
    {-# INLINE parseField #-}

-- | Ignores the 'Field'. Always succeeds.
instance FromField () where
    parseField :: ByteString -> Parser ()
parseField ByteString
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    {-# INLINE parseField #-}

-- | @since 0.5.2.0
instance FromField a => FromField (Identity a) where
    parseField :: ByteString -> Parser (Identity a)
parseField = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromField a => ByteString -> Parser a
parseField
    {-# INLINE parseField #-}

-- | @since 0.5.2.0
instance ToField a => ToField (Identity a) where
    toField :: Identity a -> ByteString
toField = forall a. ToField a => a -> ByteString
toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity
    {-# INLINE toField #-}

-- | @since 0.5.2.0
instance FromField a => FromField (Const a b) where
    parseField :: ByteString -> Parser (Const a b)
parseField = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromField a => ByteString -> Parser a
parseField
    {-# INLINE parseField #-}

-- | @since 0.5.2.0
instance ToField a => ToField (Const a b) where
    toField :: Const a b -> ByteString
toField = forall a. ToField a => a -> ByteString
toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst
    {-# INLINE toField #-}

-- | Assumes UTF-8 encoding.
instance FromField Char where
    parseField :: ByteString -> Parser Char
parseField ByteString
s =
        case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
s of
          Left UnicodeException
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show UnicodeException
e
          Right Text
t
            | Text -> Int -> Ordering
T.compareLength Text
t Int
1 forall a. Eq a => a -> a -> Bool
== Ordering
EQ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Char
T.head Text
t)
            | Bool
otherwise -> forall a. String -> ByteString -> Maybe String -> Parser a
typeError String
"Char" ByteString
s forall a. Maybe a
Nothing
    {-# INLINE parseField #-}

-- | Uses UTF-8 encoding.
instance ToField Char where
    toField :: Char -> ByteString
toField = forall a. ToField a => a -> ByteString
toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton
    {-# INLINE toField #-}

-- | Accepts the same syntax as 'rational'. Ignores whitespace.
--
-- @since 0.5.1.0
instance FromField Scientific where
  parseField :: ByteString -> Parser Scientific
parseField ByteString
s = case forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ()
ws forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Scientific
A8.scientific forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws) ByteString
s of
                   Left String
err -> forall a. String -> ByteString -> Maybe String -> Parser a
typeError String
"Scientific" ByteString
s (forall a. a -> Maybe a
Just String
err)
                   Right Scientific
n  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
n
  {-# INLINE parseField #-}

-- | Uses decimal notation or scientific notation, depending on the number.
--
-- @since 0.5.1.0
instance ToField Scientific where
  toField :: Scientific -> ByteString
toField = Scientific -> ByteString
scientific
  {-# INLINE toField #-}

-- | Accepts same syntax as 'rational'. Ignores whitespace.
instance FromField Double where
    parseField :: ByteString -> Parser Double
parseField = ByteString -> Parser Double
parseDouble
    {-# INLINE parseField #-}

-- | Uses decimal notation or scientific notation, depending on the
-- number.
instance ToField Double where
    toField :: Double -> ByteString
toField = forall a. RealFloat a => a -> ByteString
realFloat
    {-# INLINE toField #-}

-- | Accepts same syntax as 'rational'. Ignores whitespace.
instance FromField Float where
    parseField :: ByteString -> Parser Float
parseField ByteString
s = Double -> Float
double2Float forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Parser Double
parseDouble ByteString
s
    {-# INLINE parseField #-}

-- | Uses decimal notation or scientific notation, depending on the
-- number.
instance ToField Float where
    toField :: Float -> ByteString
toField = forall a. RealFloat a => a -> ByteString
realFloat
    {-# INLINE toField #-}

parseDouble :: B.ByteString -> Parser Double
parseDouble :: ByteString -> Parser Double
parseDouble ByteString
s = case forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ()
ws forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Double
double forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws) ByteString
s of
    Left String
err -> forall a. String -> ByteString -> Maybe String -> Parser a
typeError String
"Double" ByteString
s (forall a. a -> Maybe a
Just String
err)
    Right Double
n  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
n
{-# INLINE parseDouble #-}

-- | Accepts a signed decimal number. Ignores whitespace.
instance FromField Int where
    parseField :: ByteString -> Parser Int
parseField = forall a. (Integral a, Num a) => String -> ByteString -> Parser a
parseSigned String
"Int"
    {-# INLINE parseField #-}

-- | Uses decimal encoding with optional sign.
instance ToField Int where
    toField :: Int -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts a signed decimal number. Ignores whitespace.
instance FromField Integer where
    parseField :: ByteString -> Parser Integer
parseField = forall a. (Integral a, Num a) => String -> ByteString -> Parser a
parseSigned String
"Integer"
    {-# INLINE parseField #-}

-- | Uses decimal encoding with optional sign.
instance ToField Integer where
    toField :: Integer -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts a signed decimal number. Ignores whitespace.
instance FromField Int8 where
    parseField :: ByteString -> Parser Int8
parseField = forall a. (Integral a, Num a) => String -> ByteString -> Parser a
parseSigned String
"Int8"
    {-# INLINE parseField #-}

-- | Uses decimal encoding with optional sign.
instance ToField Int8 where
    toField :: Int8 -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts a signed decimal number. Ignores whitespace.
instance FromField Int16 where
    parseField :: ByteString -> Parser Int16
parseField = forall a. (Integral a, Num a) => String -> ByteString -> Parser a
parseSigned String
"Int16"
    {-# INLINE parseField #-}

-- | Uses decimal encoding with optional sign.
instance ToField Int16 where
    toField :: Int16 -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts a signed decimal number. Ignores whitespace.
instance FromField Int32 where
    parseField :: ByteString -> Parser Int32
parseField = forall a. (Integral a, Num a) => String -> ByteString -> Parser a
parseSigned String
"Int32"
    {-# INLINE parseField #-}

-- | Uses decimal encoding with optional sign.
instance ToField Int32 where
    toField :: Int32 -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts a signed decimal number. Ignores whitespace.
instance FromField Int64 where
    parseField :: ByteString -> Parser Int64
parseField = forall a. (Integral a, Num a) => String -> ByteString -> Parser a
parseSigned String
"Int64"
    {-# INLINE parseField #-}

-- | Uses decimal encoding with optional sign.
instance ToField Int64 where
    toField :: Int64 -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts an unsigned decimal number. Ignores whitespace.
instance FromField Word where
    parseField :: ByteString -> Parser Word
parseField = forall a. Integral a => String -> ByteString -> Parser a
parseUnsigned String
"Word"
    {-# INLINE parseField #-}

-- | Uses decimal encoding.
instance ToField Word where
    toField :: Word -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts an unsigned decimal number. Ignores whitespace.
--
-- @since 0.5.1.0
instance FromField Natural where
    parseField :: ByteString -> Parser Natural
parseField = forall a. Integral a => String -> ByteString -> Parser a
parseUnsigned String
"Natural"
    {-# INLINE parseField #-}

-- | Uses decimal encoding.
--
-- @since 0.5.1.0
instance ToField Natural where
    toField :: Natural -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts an unsigned decimal number. Ignores whitespace.
instance FromField Word8 where
    parseField :: ByteString -> Parser Word8
parseField = forall a. Integral a => String -> ByteString -> Parser a
parseUnsigned String
"Word8"
    {-# INLINE parseField #-}

-- | Uses decimal encoding.
instance ToField Word8 where
    toField :: Word8 -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts an unsigned decimal number. Ignores whitespace.
instance FromField Word16 where
    parseField :: ByteString -> Parser Word16
parseField = forall a. Integral a => String -> ByteString -> Parser a
parseUnsigned String
"Word16"
    {-# INLINE parseField #-}

-- | Uses decimal encoding.
instance ToField Word16 where
    toField :: Word16 -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts an unsigned decimal number. Ignores whitespace.
instance FromField Word32 where
    parseField :: ByteString -> Parser Word32
parseField = forall a. Integral a => String -> ByteString -> Parser a
parseUnsigned String
"Word32"
    {-# INLINE parseField #-}

-- | Uses decimal encoding.
instance ToField Word32 where
    toField :: Word32 -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

-- | Accepts an unsigned decimal number. Ignores whitespace.
instance FromField Word64 where
    parseField :: ByteString -> Parser Word64
parseField = forall a. Integral a => String -> ByteString -> Parser a
parseUnsigned String
"Word64"
    {-# INLINE parseField #-}

-- | Uses decimal encoding.
instance ToField Word64 where
    toField :: Word64 -> ByteString
toField = forall a. Integral a => a -> ByteString
decimal
    {-# INLINE toField #-}

instance FromField B.ByteString where
    parseField :: ByteString -> Parser ByteString
parseField = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE parseField #-}

instance ToField B.ByteString where
    toField :: ByteString -> ByteString
toField = forall a. a -> a
id
    {-# INLINE toField #-}

instance FromField L.ByteString where
    parseField :: ByteString -> Parser ByteString
parseField = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
    {-# INLINE parseField #-}

instance ToField L.ByteString where
    toField :: ByteString -> ByteString
toField = ByteString -> ByteString
toStrict
    {-# INLINE toField #-}

#if MIN_VERSION_bytestring(0,10,4)
instance FromField SBS.ShortByteString where
    parseField :: ByteString -> Parser ShortByteString
parseField = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
SBS.toShort
    {-# INLINE parseField #-}

instance ToField SBS.ShortByteString where
    toField :: ShortByteString -> ByteString
toField = ShortByteString -> ByteString
SBS.fromShort
    {-# INLINE toField #-}
#endif

#if MIN_VERSION_text_short(0,1,0)
-- | Assumes UTF-8 encoding. Fails on invalid byte sequences.
--
-- @since 0.5.0.0
instance FromField T.S.ShortText where
    parseField :: ByteString -> Parser ShortText
parseField = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid UTF-8 stream") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ShortText
T.S.fromByteString
    {-# INLINE parseField #-}

-- | Uses UTF-8 encoding.
--
-- @since 0.5.0.0
instance ToField T.S.ShortText where
    toField :: ShortText -> ByteString
toField = ShortText -> ByteString
T.S.toByteString
    {-# INLINE toField #-}
#endif

-- | Assumes UTF-8 encoding. Fails on invalid byte sequences.
instance FromField T.Text where
    parseField :: ByteString -> Parser Text
parseField = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8'
    {-# INLINE parseField #-}

-- | Uses UTF-8 encoding.
instance ToField T.Text where
    toField :: Text -> ByteString
toField = forall a. ToField a => a -> ByteString
toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
    {-# INLINE toField #-}

-- | Assumes UTF-8 encoding. Fails on invalid byte sequences.
instance FromField LT.Text where
    parseField :: ByteString -> Parser Text
parseField = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8'
    {-# INLINE parseField #-}

-- | Uses UTF-8 encoding.
instance ToField LT.Text where
    toField :: Text -> ByteString
toField = forall a. ToField a => a -> ByteString
toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
LT.encodeUtf8
    {-# INLINE toField #-}

-- | Assumes UTF-8 encoding. Fails on invalid byte sequences.
instance FromField [Char] where
    parseField :: ByteString -> Parser String
parseField = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromField a => ByteString -> Parser a
parseField
    {-# INLINE parseField #-}

-- | Uses UTF-8 encoding.
instance ToField [Char] where
    toField :: String -> ByteString
toField = forall a. ToField a => a -> ByteString
toField forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    {-# INLINE toField #-}

parseSigned :: (Integral a, Num a) => String -> B.ByteString -> Parser a
parseSigned :: forall a. (Integral a, Num a) => String -> ByteString -> Parser a
parseSigned String
typ ByteString
s = case forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ()
ws forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Num a => Parser a -> Parser a
A8.signed forall a. Integral a => Parser a
A8.decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws) ByteString
s of
    Left String
err -> forall a. String -> ByteString -> Maybe String -> Parser a
typeError String
typ ByteString
s (forall a. a -> Maybe a
Just String
err)
    Right a
n  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n
{-# INLINE parseSigned #-}

parseUnsigned :: Integral a => String -> B.ByteString -> Parser a
parseUnsigned :: forall a. Integral a => String -> ByteString -> Parser a
parseUnsigned String
typ ByteString
s = case forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ()
ws forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Integral a => Parser a
A8.decimal forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws) ByteString
s of
    Left String
err -> forall a. String -> ByteString -> Maybe String -> Parser a
typeError String
typ ByteString
s (forall a. a -> Maybe a
Just String
err)
    Right a
n  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n
{-# INLINE parseUnsigned #-}

ws :: A8.Parser ()
ws :: Parser ()
ws = (Char -> Bool) -> Parser ()
A8.skipWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t')



------------------------------------------------------------------------
-- Custom version of attoparsec @parseOnly@ function which fails if
-- there is leftover content after parsing a field.
parseOnly :: A8.Parser a -> B.ByteString -> Either String a
parseOnly :: forall a. Parser a -> ByteString -> Either String a
parseOnly Parser a
parser ByteString
input = forall {b}. IResult ByteString b -> Either String b
go (forall a. Parser a -> ByteString -> Result a
A8.parse Parser a
parser ByteString
input) where
  go :: IResult ByteString b -> Either String b
go (A8.Fail ByteString
_ [String]
_ String
err) = forall a b. a -> Either a b
Left String
err
  go (A8.Partial ByteString -> IResult ByteString b
f)    = forall {b}. IResult ByteString b -> Either String b
go2 (ByteString -> IResult ByteString b
f ByteString
B.empty)
  go (A8.Done ByteString
leftover b
result)
    | ByteString -> Bool
B.null ByteString
leftover = forall a b. b -> Either a b
Right b
result
    | Bool
otherwise = forall a b. a -> Either a b
Left (String
"incomplete field parse, leftover: "
                        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteString -> [Word8]
B.unpack ByteString
leftover))

  go2 :: IResult ByteString b -> Either String b
go2 (A8.Fail ByteString
_ [String]
_ String
err) = forall a b. a -> Either a b
Left String
err
  go2 (A8.Partial ByteString -> IResult ByteString b
_)    = forall a. HasCallStack => String -> a
error String
"parseOnly: impossible error!"
  go2 (A8.Done ByteString
leftover b
result)
    | ByteString -> Bool
B.null ByteString
leftover = forall a b. b -> Either a b
Right b
result
    | Bool
otherwise = forall a b. a -> Either a b
Left (String
"incomplete field parse, leftover: "
                        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteString -> [Word8]
B.unpack ByteString
leftover))
{-# INLINE parseOnly #-}

typeError :: String -> B.ByteString -> Maybe String -> Parser a
typeError :: forall a. String -> ByteString -> Maybe String -> Parser a
typeError String
typ ByteString
s Maybe String
mmsg =
    forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"expected " forall a. [a] -> [a] -> [a]
++ String
typ forall a. [a] -> [a] -> [a]
++ String
", got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteString -> String
B8.unpack ByteString
s) forall a. [a] -> [a] -> [a]
++ String
cause
  where
    cause :: String
cause = case Maybe String
mmsg of
        Just String
msg -> String
" (" forall a. [a] -> [a] -> [a]
++ String
msg forall a. [a] -> [a] -> [a]
++ String
")"
        Maybe String
Nothing  -> String
""

------------------------------------------------------------------------
-- Constructors and accessors

-- | Retrieve the /n/th field in the given record. The result is
-- 'empty' if the value cannot be converted to the desired type.
-- Raises an exception if the index is out of bounds.
--
-- 'index' is a simple convenience function that is equivalent to
-- @'parseField' (v '!' idx)@. If you're certain that the index is not
-- out of bounds, using 'unsafeIndex' is somewhat faster.
index :: FromField a => Record -> Int -> Parser a
index :: forall a. FromField a => Record -> Int -> Parser a
index Record
v Int
idx = forall a. FromField a => ByteString -> Parser a
parseField (Record
v forall a. Vector a -> Int -> a
! Int
idx)
{-# INLINE index #-}

-- | Alias for 'index'.
(.!) :: FromField a => Record -> Int -> Parser a
.! :: forall a. FromField a => Record -> Int -> Parser a
(.!) = forall a. FromField a => Record -> Int -> Parser a
index
{-# INLINE (.!) #-}
infixl 9 .!

-- | Like 'index' but without bounds checking.
unsafeIndex :: FromField a => Record -> Int -> Parser a
unsafeIndex :: forall a. FromField a => Record -> Int -> Parser a
unsafeIndex Record
v Int
idx = forall a. FromField a => ByteString -> Parser a
parseField (forall a. Vector a -> Int -> a
V.unsafeIndex Record
v Int
idx)
{-# INLINE unsafeIndex #-}

-- | Retrieve a field in the given record by name.  The result is
-- 'empty' if the field is missing or if the value cannot be converted
-- to the desired type.
lookup :: FromField a => NamedRecord -> B.ByteString -> Parser a
lookup :: forall a. FromField a => NamedRecord -> ByteString -> Parser a
lookup NamedRecord
m ByteString
name = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) forall {a} {m :: * -> *}.
(FromField a, MonadFail m) =>
ByteString -> m a
parseField' forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ByteString
name NamedRecord
m
  where err :: String
err = String
"no field named " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteString -> String
B8.unpack ByteString
name)
        parseField' :: ByteString -> m a
parseField' ByteString
fld = case forall a. Parser a -> Either String a
runParser (forall a. FromField a => ByteString -> Parser a
parseField ByteString
fld) of
          Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"in named field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ByteString -> String
B8.unpack ByteString
name) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
e
          Right a
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
{-# INLINE lookup #-}

-- | Alias for 'lookup'.
(.:) :: FromField a => NamedRecord -> B.ByteString -> Parser a
.: :: forall a. FromField a => NamedRecord -> ByteString -> Parser a
(.:) = forall a. FromField a => NamedRecord -> ByteString -> Parser a
lookup
{-# INLINE (.:) #-}

-- | Construct a pair from a name and a value.  For use with
-- 'namedRecord'.
namedField :: ToField a => B.ByteString -> a -> (B.ByteString, B.ByteString)
namedField :: forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
namedField ByteString
name a
val = (ByteString
name, forall a. ToField a => a -> ByteString
toField a
val)
{-# INLINE namedField #-}

-- | Alias for 'namedField'.
(.=) :: ToField a => B.ByteString -> a -> (B.ByteString, B.ByteString)
.= :: forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
(.=) = forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
namedField
{-# INLINE (.=) #-}

-- | Construct a record from a list of 'B.ByteString's.  Use 'toField'
-- to convert values to 'B.ByteString's for use with 'record'.
record :: [B.ByteString] -> Record
record :: [ByteString] -> Record
record = forall a. [a] -> Vector a
V.fromList

-- | Construct a named record from a list of name-value 'B.ByteString'
-- pairs.  Use '.=' to construct such a pair from a name and a value.
namedRecord :: [(B.ByteString, B.ByteString)] -> NamedRecord
namedRecord :: [(ByteString, ByteString)] -> NamedRecord
namedRecord = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList

-- | Construct a header from a list of 'B.ByteString's.
header :: [B.ByteString] -> Header
header :: [ByteString] -> Record
header = forall a. [a] -> Vector a
V.fromList

------------------------------------------------------------------------
-- Parser for converting records to data types

-- | Failure continuation.
type Failure f r   = String -> f r
-- | Success continuation.
type Success a f r = a -> f r

-- | Conversion of a field to a value might fail e.g. if the field is
-- malformed. This possibility is captured by the 'Parser' type, which
-- lets you compose several field conversions together in such a way
-- that if any of them fail, the whole record conversion fails.
newtype Parser a = Parser {
      forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
unParser :: forall (f :: * -> *) (r :: *).
                  Failure f r
               -> Success a f r
               -> f r
    }

instance Monad Parser where
    Parser a
m >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
g = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
kf Success b f r
ks -> let ks' :: a -> f r
ks' a
a = forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
unParser (a -> Parser b
g a
a) Failure f r
kf Success b f r
ks
                                 in forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
unParser Parser a
m Failure f r
kf a -> f r
ks'
    {-# INLINE (>>=) #-}
    >> :: forall a b. Parser a -> Parser b -> Parser b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    {-# INLINE (>>) #-}
    return :: forall a. a -> Parser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}

#if !MIN_VERSION_base(4,13,0)
    fail = Fail.fail
    {-# INLINE fail #-}
#endif

-- | @since 0.5.0.0
instance Fail.MonadFail Parser where
    fail :: forall a. String -> Parser a
fail String
msg = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
kf Success a f r
_ks -> Failure f r
kf String
msg
    {-# INLINE fail #-}

instance Functor Parser where
    fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f Parser a
m = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
kf Success b f r
ks -> let ks' :: a -> f r
ks' a
a = Success b f r
ks (a -> b
f a
a)
                                  in forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
unParser Parser a
m Failure f r
kf a -> f r
ks'
    {-# INLINE fmap #-}

instance Applicative Parser where
    pure :: forall a. a -> Parser a
pure a
a = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
_kf Success a f r
ks -> Success a f r
ks a
a
    {-# INLINE pure #-}
    <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) = forall a b. Parser (a -> b) -> Parser a -> Parser b
apP
    {-# INLINE (<*>) #-}

instance Alternative Parser where
    empty :: forall a. Parser a
empty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"
    {-# INLINE empty #-}
    <|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
    {-# INLINE (<|>) #-}

instance MonadPlus Parser where
    mzero :: forall a. Parser a
mzero = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
    {-# INLINE mzero #-}
    mplus :: forall a. Parser a -> Parser a -> Parser a
mplus Parser a
a Parser a
b = forall a.
(forall (f :: * -> *) r. Failure f r -> Success a f r -> f r)
-> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Failure f r
kf Success a f r
ks -> let kf' :: p -> f r
kf' p
_ = forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
unParser Parser a
b Failure f r
kf Success a f r
ks
                                   in forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
unParser Parser a
a forall {p}. p -> f r
kf' Success a f r
ks
    {-# INLINE mplus #-}

-- | @since 0.5.0.0
instance Semi.Semigroup (Parser a) where
    <> :: Parser a -> Parser a -> Parser a
(<>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
    {-# INLINE (<>) #-}

instance Monoid (Parser a) where
    mempty :: Parser a
mempty  = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mempty"
    {-# INLINE mempty #-}
    mappend :: Parser a -> Parser a -> Parser a
mappend = forall a. Semigroup a => a -> a -> a
(Semi.<>)
    {-# INLINE mappend #-}

apP :: Parser (a -> b) -> Parser a -> Parser b
apP :: forall a b. Parser (a -> b) -> Parser a -> Parser b
apP Parser (a -> b)
d Parser a
e = do
  a -> b
b <- Parser (a -> b)
d
  a
a <- Parser a
e
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
b a
a)
{-# INLINE apP #-}

-- | Run a 'Parser', returning either @'Left' errMsg@ or @'Right'
-- result@. Forces the value in the 'Left' or 'Right' constructors to
-- weak head normal form.
--
-- You most likely won't need to use this function directly, but it's
-- included for completeness.
runParser :: Parser a -> Either String a
runParser :: forall a. Parser a -> Either String a
runParser Parser a
p = forall a.
Parser a
-> forall (f :: * -> *) r. Failure f r -> Success a f r -> f r
unParser Parser a
p forall a b. a -> Either a b
left forall {b} {a}. b -> Either a b
right
  where
    left :: a -> Either a b
left !a
errMsg = forall a b. a -> Either a b
Left a
errMsg
    right :: b -> Either a b
right !b
x = forall a b. b -> Either a b
Right b
x
{-# INLINE runParser #-}

------------------------------------------------------------------------
-- Generics

class GFromRecord f where
    gparseRecord :: Options -> Record -> Parser (f p)

instance GFromRecordSum f Record => GFromRecord (M1 i n f) where
    gparseRecord :: forall (p :: k). Options -> Record -> Parser (M1 i n f p)
gparseRecord Options
opts Record
v =
        case forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
n (forall {k} (f :: k -> *) r (p :: k).
GFromRecordSum f r =>
Options -> IntMap (r -> Parser (f p))
gparseRecordSum Options
opts) of
            Maybe (Record -> Parser (f p))
Nothing -> forall a. Int -> Record -> Parser a
lengthMismatch Int
n Record
v
            Just Record -> Parser (f p)
p -> 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
<$> Record -> Parser (f p)
p Record
v
      where
        n :: Int
n = forall a. Vector a -> Int
V.length Record
v

class GFromNamedRecord f where
    gparseNamedRecord :: Options -> NamedRecord -> Parser (f p)

instance GFromRecordSum f NamedRecord => GFromNamedRecord (M1 i n f) where
    gparseNamedRecord :: forall (p :: k). Options -> NamedRecord -> Parser (M1 i n f p)
gparseNamedRecord Options
opts NamedRecord
v =
        forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\NamedRecord -> Parser (f p)
f Parser (M1 i n f p)
p -> Parser (M1 i n f p)
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
<$> NamedRecord -> Parser (f p)
f NamedRecord
v) forall (f :: * -> *) a. Alternative f => f a
empty (forall a. IntMap a -> [a]
IM.elems (forall {k} (f :: k -> *) r (p :: k).
GFromRecordSum f r =>
Options -> IntMap (r -> Parser (f p))
gparseRecordSum Options
opts))

class GFromRecordSum f r where
    gparseRecordSum :: Options -> IM.IntMap (r -> Parser (f p))

instance (GFromRecordSum a r, GFromRecordSum b r) => GFromRecordSum (a :+: b) r where
    gparseRecordSum :: forall (p :: k). Options -> IntMap (r -> Parser ((:+:) a b p))
gparseRecordSum Options
opts =
        forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith (\r -> Parser ((:+:) a b p)
a r -> Parser ((:+:) a b p)
b r
r -> r -> Parser ((:+:) a b p)
a r
r forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> r -> Parser ((:+:) a b p)
b r
r)
            (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) r (p :: k).
GFromRecordSum f r =>
Options -> IntMap (r -> Parser (f p))
gparseRecordSum Options
opts)
            (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) r (p :: k).
GFromRecordSum f r =>
Options -> IntMap (r -> Parser (f p))
gparseRecordSum Options
opts)

instance GFromRecordProd f r => GFromRecordSum (M1 i n f) r where
    gparseRecordSum :: forall (p :: k). Options -> IntMap (r -> Parser (M1 i n f p))
gparseRecordSum Options
opts = forall a. Int -> a -> IntMap a
IM.singleton Int
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 {p :: k}. r -> Parser (f p)
f)
      where
        (Int
n, r -> Parser (f p)
f) = forall {k} (f :: k -> *) r (p :: k).
GFromRecordProd f r =>
Options -> Int -> (Int, r -> Parser (f p))
gparseRecordProd Options
opts Int
0

class GFromRecordProd f r where
    gparseRecordProd :: Options -> Int -> (Int, r -> Parser (f p))

instance GFromRecordProd U1 r where
    gparseRecordProd :: forall (p :: k). Options -> Int -> (Int, r -> Parser (U1 p))
gparseRecordProd Options
_ Int
n = (Int
n, forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
U1))

instance (GFromRecordProd a r, GFromRecordProd b r) => GFromRecordProd (a :*: b) r where
    gparseRecordProd :: forall (p :: k). Options -> Int -> (Int, r -> Parser ((:*:) a b p))
gparseRecordProd Options
opts Int
n0 = (Int
n2, forall {p :: k}. r -> Parser ((:*:) a b p)
f)
      where
        f :: r -> Parser ((:*:) a b p)
f r
r = forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {p :: k}. r -> Parser (a p)
fa r
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {p :: k}. r -> Parser (b p)
fb r
r
        (Int
n1, r -> Parser (a p)
fa) = forall {k} (f :: k -> *) r (p :: k).
GFromRecordProd f r =>
Options -> Int -> (Int, r -> Parser (f p))
gparseRecordProd Options
opts Int
n0
        (Int
n2, r -> Parser (b p)
fb) = forall {k} (f :: k -> *) r (p :: k).
GFromRecordProd f r =>
Options -> Int -> (Int, r -> Parser (f p))
gparseRecordProd Options
opts Int
n1

instance GFromRecordProd f Record => GFromRecordProd (M1 i n f) Record where
    gparseRecordProd :: forall (p :: k).
Options -> Int -> (Int, Record -> Parser (M1 i n f p))
gparseRecordProd Options
opts Int
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} (f :: k -> *) r (p :: k).
GFromRecordProd f r =>
Options -> Int -> (Int, r -> Parser (f p))
gparseRecordProd Options
opts Int
n

instance FromField a => GFromRecordProd (K1 i a) Record where
    gparseRecordProd :: forall (p :: k).
Options -> Int -> (Int, Record -> Parser (K1 i a p))
gparseRecordProd Options
_ Int
n = (Int
n forall a. Num a => a -> a -> a
+ Int
1, \Record
v -> 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 => ByteString -> Parser a
parseField (forall a. Vector a -> Int -> a
V.unsafeIndex Record
v Int
n))

data Proxy s (f :: * -> *) a = Proxy

instance (FromField a, Selector s) => GFromRecordProd (M1 S s (K1 i a)) NamedRecord where
    gparseRecordProd :: forall (p :: k).
Options -> Int -> (Int, NamedRecord -> Parser (M1 S s (K1 i a) p))
gparseRecordProd Options
opts Int
n = (Int
n forall a. Num a => a -> a -> a
+ Int
1, \NamedRecord
v -> (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedRecord
v forall a. FromField a => NamedRecord -> ByteString -> Parser a
.: ByteString
name)
      where
        name :: ByteString
name = Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (Options -> String -> String
fieldLabelModifier Options
opts (forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall {k} {k} (s :: k) (f :: * -> *) (a :: k). Proxy s f a
Proxy :: Proxy s f a))))


class GToRecord a f where
    gtoRecord :: Options -> a p -> [f]

instance GToRecord U1 f where
    gtoRecord :: forall (p :: k). Options -> U1 p -> [f]
gtoRecord Options
_ U1 p
U1 = []

instance (GToRecord a f, GToRecord b f) => GToRecord (a :*: b) f where
    gtoRecord :: forall (p :: k). Options -> (:*:) a b p -> [f]
gtoRecord Options
opts (a p
a :*: b p
b) = forall {k} (a :: k -> *) f (p :: k).
GToRecord a f =>
Options -> a p -> [f]
gtoRecord Options
opts a p
a forall a. [a] -> [a] -> [a]
++ forall {k} (a :: k -> *) f (p :: k).
GToRecord a f =>
Options -> a p -> [f]
gtoRecord Options
opts b p
b

instance (GToRecord a f, GToRecord b f) => GToRecord (a :+: b) f where
    gtoRecord :: forall (p :: k). Options -> (:+:) a b p -> [f]
gtoRecord Options
opts (L1 a p
a) = forall {k} (a :: k -> *) f (p :: k).
GToRecord a f =>
Options -> a p -> [f]
gtoRecord Options
opts a p
a
    gtoRecord Options
opts (R1 b p
b) = forall {k} (a :: k -> *) f (p :: k).
GToRecord a f =>
Options -> a p -> [f]
gtoRecord Options
opts b p
b

instance GToRecord a f => GToRecord (M1 D c a) f where
    gtoRecord :: forall (p :: k). Options -> M1 D c a p -> [f]
gtoRecord Options
opts (M1 a p
a) = forall {k} (a :: k -> *) f (p :: k).
GToRecord a f =>
Options -> a p -> [f]
gtoRecord Options
opts a p
a

instance GToRecord a f => GToRecord (M1 C c a) f where
    gtoRecord :: forall (p :: k). Options -> M1 C c a p -> [f]
gtoRecord Options
opts (M1 a p
a) = forall {k} (a :: k -> *) f (p :: k).
GToRecord a f =>
Options -> a p -> [f]
gtoRecord Options
opts a p
a

instance GToRecord a Field => GToRecord (M1 S c a) Field where
    gtoRecord :: forall (p :: k). Options -> M1 S c a p -> [ByteString]
gtoRecord Options
opts (M1 a p
a) = forall {k} (a :: k -> *) f (p :: k).
GToRecord a f =>
Options -> a p -> [f]
gtoRecord Options
opts a p
a

instance ToField a => GToRecord (K1 i a) Field where
    gtoRecord :: forall (p :: k). Options -> K1 i a p -> [ByteString]
gtoRecord Options
_ (K1 a
a) = [forall a. ToField a => a -> ByteString
toField a
a]

instance (ToField a, Selector s) => GToRecord (M1 S s (K1 i a)) (B.ByteString, B.ByteString) where
    gtoRecord :: forall (p :: k).
Options -> M1 S s (K1 i a) p -> [(ByteString, ByteString)]
gtoRecord Options
opts m :: M1 S s (K1 i a) p
m@(M1 (K1 a
a)) = [ByteString
name forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= forall a. ToField a => a -> ByteString
toField a
a]
      where
        name :: ByteString
name = Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (Options -> String -> String
fieldLabelModifier Options
opts (forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s (K1 i a) p
m)))

-- We statically fail on sum types and product types without selectors
-- (field names).

class GToNamedRecordHeader a
  where
    gtoNamedRecordHeader :: Options -> a p -> [Name]

instance GToNamedRecordHeader U1
  where
    gtoNamedRecordHeader :: forall (p :: k). Options -> U1 p -> [ByteString]
gtoNamedRecordHeader Options
_ U1 p
_ = []

instance (GToNamedRecordHeader a, GToNamedRecordHeader b) =>
         GToNamedRecordHeader (a :*: b)
  where
    gtoNamedRecordHeader :: forall (p :: k). Options -> (:*:) a b p -> [ByteString]
gtoNamedRecordHeader Options
opts (:*:) a b p
_ = forall {k} (a :: k -> *) (p :: k).
GToNamedRecordHeader a =>
Options -> a p -> [ByteString]
gtoNamedRecordHeader Options
opts (forall a. HasCallStack => a
undefined :: a p) forall a. [a] -> [a] -> [a]
++
                                  forall {k} (a :: k -> *) (p :: k).
GToNamedRecordHeader a =>
Options -> a p -> [ByteString]
gtoNamedRecordHeader Options
opts (forall a. HasCallStack => a
undefined :: b p)

instance GToNamedRecordHeader a => GToNamedRecordHeader (M1 D c a)
  where
    gtoNamedRecordHeader :: forall (p :: k). Options -> M1 D c a p -> [ByteString]
gtoNamedRecordHeader Options
opts M1 D c a p
_ = forall {k} (a :: k -> *) (p :: k).
GToNamedRecordHeader a =>
Options -> a p -> [ByteString]
gtoNamedRecordHeader Options
opts (forall a. HasCallStack => a
undefined :: a p)

instance GToNamedRecordHeader a => GToNamedRecordHeader (M1 C c a)
  where
    gtoNamedRecordHeader :: forall (p :: k). Options -> M1 C c a p -> [ByteString]
gtoNamedRecordHeader Options
opts M1 C c a p
_ = forall {k} (a :: k -> *) (p :: k).
GToNamedRecordHeader a =>
Options -> a p -> [ByteString]
gtoNamedRecordHeader Options
opts (forall a. HasCallStack => a
undefined :: a p)

-- | Instance to ensure that you cannot derive DefaultOrdered for
-- constructors without selectors.
#if MIN_VERSION_base(4,9,0)
instance DefaultOrdered (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a ())
         => GToNamedRecordHeader (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a)
#else
instance DefaultOrdered (M1 S NoSelector a ()) => GToNamedRecordHeader (M1 S NoSelector a)
#endif
  where
    gtoNamedRecordHeader :: forall p.
Options
-> M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a p -> [ByteString]
gtoNamedRecordHeader Options
_ M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a p
_ =
        forall a. HasCallStack => String -> a
error String
"You cannot derive DefaultOrdered for constructors without selectors."

instance Selector s => GToNamedRecordHeader (M1 S s a)
  where
    gtoNamedRecordHeader :: forall (p :: k). Options -> M1 S s a p -> [ByteString]
gtoNamedRecordHeader Options
opts M1 S s a p
m
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name = forall a. HasCallStack => String -> a
error String
"Cannot derive DefaultOrdered for constructors without selectors"
        | Bool
otherwise = [String -> ByteString
B8.pack (Options -> String -> String
fieldLabelModifier Options
opts (forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s a p
m))]
      where name :: String
name = forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName M1 S s a p
m