{-# language TemplateHaskell #-}

-- | This module provides @TemplateHaskell@ support for the @cassava@
-- library, so you can avoid deriving 'Generic' and the compilation
-- overhead that brings.
module Data.Csv.TH
  ( deriveToNamedRecord,
    deriveToRecord,
    deriveDefaultOrdered,
    deriveNamedRecord,
    deriveFromNamedRecord,
    deriveFromRecord,
    deriveToAndFromRecord,
    deriveToNamedRecordAndDefaultOrdered,
    deriveToAndFromNamedRecordAndDefaultOrdered,
    CsvOptions,
    csvDefaultOptions,
  )
where

import Data.Traversable
import Control.Monad
import Control.Monad.Fail
import Data.Csv qualified as Csv
import Data.Vector qualified as V
import Language.Haskell.TH

-- | Cassava uses the same name as Aeson, which is used much more frequently.
-- This alias makes it a bit easier to refer to it.
type CsvOptions = Csv.Options

-- | Cassava uses the same name as Aeson, which is used more frequently. To
-- avoid qualified names and lots of clashes, we export an alias here.
csvDefaultOptions :: Csv.Options
csvDefaultOptions :: Options
csvDefaultOptions = Options
Csv.defaultOptions

-- | A helper for the common case of deriving both 'Csv.ToNamedRecord' and
-- 'Csv.DefaultOrdered', sharing the same options.
deriveToNamedRecordAndDefaultOrdered :: Csv.Options -> Name -> DecsQ
deriveToNamedRecordAndDefaultOrdered :: Options -> Name -> DecsQ
deriveToNamedRecordAndDefaultOrdered Options
opts Name
name =
  Options -> Name -> DecsQ
deriveToNamedRecord Options
opts Name
name forall a. Semigroup a => a -> a -> a
<> Options -> Name -> DecsQ
deriveDefaultOrdered Options
opts Name
name

-- | A helper for the common case of deriving 'Csv.ToNamedRecord',
-- 'Csv.FromNamedRecord', and 'Csv.DefaultOrdered', sharing the same options.
deriveToAndFromNamedRecordAndDefaultOrdered :: Csv.Options -> Name -> DecsQ
deriveToAndFromNamedRecordAndDefaultOrdered :: Options -> Name -> DecsQ
deriveToAndFromNamedRecordAndDefaultOrdered Options
opts Name
name =
  Options -> Name -> DecsQ
deriveToNamedRecord Options
opts Name
name
    forall a. Semigroup a => a -> a -> a
<> Options -> Name -> DecsQ
deriveDefaultOrdered Options
opts Name
name
    forall a. Semigroup a => a -> a -> a
<> Options -> Name -> DecsQ
deriveFromNamedRecord Options
opts Name
name

-- | Derives a 'Csv.ToNamedRecord' instance for a given type.
deriveToNamedRecord :: Csv.Options -> Name -> DecsQ
deriveToNamedRecord :: Options -> Name -> DecsQ
deriveToNamedRecord Options
opts Name
typName = do
  Info
info <- Name -> Q Info
reify Name
typName
  Con
con <-
    case Info
info of
      TyConI Dec
dec ->
        case Dec
dec of
          NewtypeD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind Con
con [DerivClause]
_derivs ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Con
con
          DataD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind [Con]
cons [DerivClause]
_derivs ->
            case [Con]
cons of
              [Con
con] ->
                forall (f :: * -> *) a. Applicative f => a -> f a
pure Con
con
              [Con]
_ ->
                forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
                  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ [Char]
"Expected "
                    , forall a. Show a => a -> [Char]
show Name
typName
                    , [Char]
" to be a record with a single constructor."
                    ]
          Dec
_ ->
            forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Char]
"Expected "
                , forall a. Show a => a -> [Char]
show Name
typName
                , [Char]
" to be a record with a single constructor."
                ]
      Info
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected"
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
" to be a type name of a single record constructor."
            ]
  (Pat
constrPatternMatch, [FieldName]
matchedVariables) <-
    case Con
con of
      RecC Name
constrName [VarBangType]
fields -> do
        [FieldName]
namesWithPatterns <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [VarBangType]
fields \(Name
fieldName, Bang
_, Kind
_) -> do
          Name -> Name -> FieldName
FieldName Name
fieldName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Quote m => [Char] -> m Name
newName (Name -> [Char]
nameBase Name
fieldName)

        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Cxt -> [Pat] -> Pat
ConP Name
constrName [] (forall a b. (a -> b) -> [a] -> [b]
map (Name -> Pat
VarP forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Name
fieldPatternVariable) [FieldName]
namesWithPatterns), [FieldName]
namesWithPatterns)
      Con
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected "
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
"to be a record with a single constructor."
            ]

  let fieldExpr :: FieldName -> Q Exp
fieldExpr FieldName
fieldName = do
        let modifiedFieldName :: [Char]
modifiedFieldName =
              Options -> [Char] -> [Char]
Csv.fieldLabelModifier Options
opts (Name -> [Char]
nameBase forall a b. (a -> b) -> a -> b
$ FieldName -> Name
fieldOriginalName FieldName
fieldName)

        [e|
          ( $(litE $ StringL modifiedFieldName)
          , Csv.toField $(varE (fieldPatternVariable fieldName))
          )
          |]

  Exp
listExpr <-
    [Exp] -> Exp
ListE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FieldName]
matchedVariables \FieldName
fieldName ->
      FieldName -> Q Exp
fieldExpr FieldName
fieldName
  [d|
    instance Csv.ToNamedRecord $(conT typName) where
      toNamedRecord val =
        case val of
          $(pure constrPatternMatch) ->
            Csv.namedRecord $(pure listExpr)
    |]

data FieldName = FieldName
  { FieldName -> Name
fieldOriginalName :: Name
  , FieldName -> Name
fieldPatternVariable :: Name
  }

-- | Derive an instance of the 'Csv.ToRecord' type class. This only works for
-- non-record types.
deriveToRecord :: Name -> DecsQ
deriveToRecord :: Name -> DecsQ
deriveToRecord Name
typName = do
  Info
info <- Name -> Q Info
reify Name
typName
  [Con]
cons <-
    case Info
info of
      TyConI Dec
dec ->
        case Dec
dec of
          NewtypeD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind Con
con [DerivClause]
_derivs ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure [Con
con]
          DataD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind [Con]
cons [DerivClause]
_derivs ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure [Con]
cons
          Dec
_ ->
            forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Char]
"Expected "
                , forall a. Show a => a -> [Char]
show Name
typName
                , [Char]
" to be a datatype."
                ]
      Info
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected"
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
" to be a type name of a datatype."
            ]

  [Match]
cases <-
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Con]
cons \case
      NormalC Name
constrName [BangType]
bangTypes -> do
        [Name]
names <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [BangType]
bangTypes \BangType
_ -> forall (m :: * -> *). Quote m => [Char] -> m Name
newName [Char]
"p"
        Exp
exprBody <-
          Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'V.fromList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> Exp
ListE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Name]
names \Name
name ->
              [e|Csv.toField $(varE name)|]
        let constrPattern :: Pat
constrPattern =
              Name -> Cxt -> [Pat] -> Pat
ConP Name
constrName [] (forall a b. (a -> b) -> [a] -> [b]
map Name -> Pat
VarP [Name]
names)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Pat -> Body -> [Dec] -> Match
Match Pat
constrPattern (Exp -> Body
NormalB Exp
exprBody) []
      RecC Name
constrName [VarBangType]
varBangTypes -> do
        [Name]
names <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [VarBangType]
varBangTypes \(Name
name, Bang
_, Kind
_) -> forall (m :: * -> *). Quote m => [Char] -> m Name
newName (Name -> [Char]
nameBase Name
name)
        Exp
exprBody <-
          Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'V.fromList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> Exp
ListE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
            forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Name]
names \Name
name ->
              [e|Csv.toField $(varE name)|]
        let constrPattern :: Pat
constrPattern =
              Name -> Cxt -> [Pat] -> Pat
ConP Name
constrName [] (forall a b. (a -> b) -> [a] -> [b]
map Name -> Pat
VarP [Name]
names)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Pat -> Body -> [Dec] -> Match
Match Pat
constrPattern (Exp -> Body
NormalB Exp
exprBody) []
      Con
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected "
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
" to have regular constructors"
            ]

  [d|
    instance Csv.ToRecord $(conT typName) where
      toRecord =
        $(pure $ LamCaseE cases)
    |]

-- | Derive an instance of 'Csv.DefaultOrdered' for the type.
deriveDefaultOrdered :: CsvOptions -> Name -> DecsQ
deriveDefaultOrdered :: Options -> Name -> DecsQ
deriveDefaultOrdered Options
opts Name
typName = do
  Info
info <- Name -> Q Info
reify Name
typName
  Con
con <-
    case Info
info of
      TyConI Dec
dec ->
        case Dec
dec of
          NewtypeD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind Con
con [DerivClause]
_derivs ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Con
con
          DataD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind [Con]
cons [DerivClause]
_derivs ->
            case [Con]
cons of
              [Con
con] ->
                forall (f :: * -> *) a. Applicative f => a -> f a
pure Con
con
              [Con]
_ ->
                forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
                  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ [Char]
"Expected "
                    , forall a. Show a => a -> [Char]
show Name
typName
                    , [Char]
" to be a record with a single constructor."
                    ]
          Dec
_ ->
            forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Char]
"Expected "
                , forall a. Show a => a -> [Char]
show Name
typName
                , [Char]
" to be a record with a single constructor."
                ]
      Info
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected"
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
" to be a type name of a single record constructor."
            ]
  Exp
body <-
    case Con
con of
      RecC Name
_constrName [VarBangType]
varBangTypes -> do
        [Exp] -> Exp
ListE forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [VarBangType]
varBangTypes \(Name
fieldName, Bang
_, Kind
_) -> do
          let modifiedFieldName :: [Char]
modifiedFieldName =
                Options -> [Char] -> [Char]
Csv.fieldLabelModifier Options
opts (Name -> [Char]
nameBase Name
fieldName)
          [e|$(litE $ StringL modifiedFieldName)|]
      Con
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected "
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
"to be a record with a single constructor."
            ]

  [d|
    instance Csv.DefaultOrdered $(conT typName) where
      headerOrder _ = V.fromList $(pure body)
    |]

-- | Derive an instance of both 'Csv.ToNamedRecord' and 'Csv.FromNamedRecord'
-- for a record type.
deriveNamedRecord :: CsvOptions -> Name -> DecsQ
deriveNamedRecord :: Options -> Name -> DecsQ
deriveNamedRecord Options
opts Name
typName =
  Options -> Name -> DecsQ
deriveToNamedRecord Options
opts Name
typName forall a. Semigroup a => a -> a -> a
<> Options -> Name -> DecsQ
deriveFromNamedRecord Options
opts Name
typName

-- | Derive an instance of 'Csv.FromNamedRecord' for record types.
deriveFromNamedRecord :: CsvOptions -> Name -> DecsQ
deriveFromNamedRecord :: Options -> Name -> DecsQ
deriveFromNamedRecord Options
opts Name
typName = do
  Info
info <- Name -> Q Info
reify Name
typName
  Con
con <-
    case Info
info of
      TyConI Dec
dec ->
        case Dec
dec of
          NewtypeD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind Con
con [DerivClause]
_derivs ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Con
con
          DataD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind [Con]
cons [DerivClause]
_derivs ->
            case [Con]
cons of
              [Con
con] ->
                forall (f :: * -> *) a. Applicative f => a -> f a
pure Con
con
              [Con]
_ ->
                forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
                  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ [Char]
"Expected "
                    , forall a. Show a => a -> [Char]
show Name
typName
                    , [Char]
" to be a record with a single constructor."
                    ]
          Dec
_ ->
            forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Char]
"Expected "
                , forall a. Show a => a -> [Char]
show Name
typName
                , [Char]
" to be a record with a single constructor."
                ]
      Info
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected"
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
" to be a type name of a single record constructor."
            ]
  (Name
constrName, [Name]
fieldNames) <-
    case Con
con of
      RecC Name
constrName [VarBangType]
fields -> do
        [Name]
namesWithPatterns <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [VarBangType]
fields \(Name
fieldName, Bang
_, Kind
_) -> do
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
fieldName

        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
constrName, [Name]
namesWithPatterns)
      Con
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected "
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
"to be a record with a single constructor."
            ]

  Exp
lamExpr <- do
    Name
arg <- forall (m :: * -> *). Quote m => [Char] -> m Name
newName [Char]
"namedRecord"

    let getFieldExpr :: Name -> Q Exp
getFieldExpr Name
fieldName = do
          let modifiedFieldName :: [Char]
modifiedFieldName =
                Options -> [Char] -> [Char]
Csv.fieldLabelModifier Options
opts (Name -> [Char]
nameBase Name
fieldName)

          [e|$(varE arg) Csv..: $(litE $ StringL modifiedFieldName)|]
    Exp
body <- do
      forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
        (\Exp
acc Name
fieldName -> [e|$(pure acc) <*> $(getFieldExpr fieldName)|])
        (Name -> Exp
VarE 'pure Exp -> Exp -> Exp
`AppE` Name -> Exp
ConE Name
constrName)
        [Name]
fieldNames
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP Name
arg] Exp
body

  [d|
    instance Csv.FromNamedRecord $(conT typName) where
      parseNamedRecord = $(pure lamExpr)
    |]

-- | Derive 'Csv.FromRecord' for a type. This ignores the record fields and uses
-- the position of the fields to determine how to parse the record.
deriveFromRecord :: Name -> DecsQ
deriveFromRecord :: Name -> DecsQ
deriveFromRecord Name
typName = do
  Info
info <- Name -> Q Info
reify Name
typName
  Con
con <-
    case Info
info of
      TyConI Dec
dec ->
        case Dec
dec of
          NewtypeD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind Con
con [DerivClause]
_derivs ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Con
con
          DataD Cxt
_cxt Name
_name [TyVarBndr ()]
_tyvars Maybe Kind
_mkind [Con]
cons [DerivClause]
_derivs ->
            case [Con]
cons of
              [Con
con] ->
                forall (f :: * -> *) a. Applicative f => a -> f a
pure Con
con
              [Con]
_ ->
                forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
                  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ [Char]
"Expected "
                    , forall a. Show a => a -> [Char]
show Name
typName
                    , [Char]
" to be a record with a single constructor."
                    ]
          Dec
_ ->
            forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [Char]
"Expected "
                , forall a. Show a => a -> [Char]
show Name
typName
                , [Char]
" to be a record with a single constructor."
                ]
      Info
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected"
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
" to be a type name of a single record constructor."
            ]
  (Name
constrName, Int
fieldCount) <-
    case Con
con of
      RecC Name
constrName [VarBangType]
fields -> do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
constrName, forall (t :: * -> *) a. Foldable t => t a -> Int
length [VarBangType]
fields)
      NormalC Name
constrName [BangType]
fields ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name
constrName, forall (t :: * -> *) a. Foldable t => t a -> Int
length [BangType]
fields)
      Con
_ ->
        forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"Expected "
            , forall a. Show a => a -> [Char]
show Name
typName
            , [Char]
"to be a record with a single constructor."
            ]

  Exp
lamExpr <- do
    Name
arg <- forall (m :: * -> *). Quote m => [Char] -> m Name
newName [Char]
"record"

    let getFieldExpr :: Int -> Q Exp
getFieldExpr Int
idx = do
          [e|$(varE arg) Csv..! idx|]

    Exp
body <- do
      forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
        (\Exp
acc Int
fieldIndex -> [e|$(pure acc) <*> $(getFieldExpr fieldIndex)|])
        (Name -> Exp
VarE 'pure Exp -> Exp -> Exp
`AppE` Name -> Exp
ConE Name
constrName)
        [Int
0 .. Int
fieldCount forall a. Num a => a -> a -> a
- Int
1]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Pat] -> Exp -> Exp
LamE [Name -> Pat
VarP Name
arg] Exp
body

  [d|
    instance Csv.FromRecord $(conT typName) where
      parseRecord = $(pure lamExpr)
    |]

deriveToAndFromRecord :: Name -> DecsQ
deriveToAndFromRecord :: Name -> DecsQ
deriveToAndFromRecord Name
name =
  Name -> DecsQ
deriveToRecord Name
name forall a. Semigroup a => a -> a -> a
<> Name -> DecsQ
deriveFromRecord Name
name