    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE ViewPatterns #-}

    module Database.Esqueleto.Record
      ( deriveEsqueletoRecord
      , deriveEsqueletoRecordWith

      , DeriveEsqueletoRecordSettings(..)
      , defaultDeriveEsqueletoRecordSettings
      ) where

    import Control.Monad.Trans.State.Strict (StateT(..), evalStateT)
    import Data.Proxy (Proxy(..))
    import Database.Esqueleto.Experimental
           (Entity, PersistValue, SqlExpr, Value(..), (:&)(..))
    import Database.Esqueleto.Experimental.ToAlias (ToAlias(..))
    import Database.Esqueleto.Experimental.ToAliasReference (ToAliasReference(..))
    import Database.Esqueleto.Internal.Internal (SqlSelect(..))
    import Language.Haskell.TH
    import Language.Haskell.TH.Syntax
    import Data.Bifunctor (first)
    import Data.Text (Text)
    import Control.Monad (forM)
    import Data.Foldable (foldl')
    import GHC.Exts (IsString(fromString))
    import Data.Maybe (mapMaybe, fromMaybe, listToMaybe)

    -- | Takes the name of a Haskell record type and creates a variant of that
    -- record prefixed with @Sql@ which can be used in esqueleto expressions. This
    -- reduces the amount of pattern matching on large tuples required to interact
    -- with data extracted with esqueleto.
    --
    -- Note that because the input record and the @Sql@-prefixed record share field
    -- names, the @{-\# LANGUAGE DuplicateRecordFields \#-}@ extension is required in
    -- modules that use `deriveEsqueletoRecord`. Additionally, the @{-\# LANGUAGE
    -- TypeApplications \#-}@ extension is required for some of the generated code.
    --
    -- Given the following record:
    --
    -- @
    -- data MyRecord = MyRecord
    --   { myName    :: 'Text'
    --   , myAge     :: 'Maybe' 'Int'
    --   , myUser    :: 'Entity' User
    --   , myAddress :: 'Maybe' ('Entity' Address)
    --   }
    -- @
    --
    -- @$('deriveEsqueletoRecord' ''MyRecord)@ will generate roughly the following code:
    --
    -- @
    -- data SqlMyRecord =
    --   SqlMyRecord { myName    :: 'SqlExpr' ('Value' Text)
    --               , myAge     :: 'SqlExpr' ('Value' ('Maybe' Int))
    --               , myUser    :: 'SqlExpr' ('Entity' User)
    --               , myAddress :: 'SqlExpr' ('Maybe' ('Entity' Address))
    --               }
    --
    -- instance 'SqlSelect' SqlMyRecord MyRecord where
    --   'sqlSelectCols'
    --     identInfo
    --     SqlMyRecord { myName    = myName
    --                 , myAge     = myAge
    --                 , myUser    = myUser
    --                 , myAddress = myAddress
    --                 } =
    --     'sqlSelectCols' identInfo (myName :& myAge :& myUser :& myAddress)
    --
    --   'sqlSelectColCount' _ =
    --     'sqlSelectColCount'
    --       ('Proxy' \@(   ('SqlExpr' ('Value' Text))
    --                :& ('SqlExpr' ('Value' ('Maybe' Int)))
    --                :& ('SqlExpr' ('Entity' User))
    --                :& ('SqlExpr' ('Maybe' ('Entity' Address)))))
    --
    --   'sqlSelectProcessRow' columns =
    --     'first' (('fromString' "Failed to parse MyRecord: ") <>)
    --           ('evalStateT' process columns)
    --     where
    --       process = do
    --         'Value' myName <- 'takeColumns' \@('SqlExpr' ('Value' Text))
    --         'Value' myAge  <- 'takeColumns' \@('SqlExpr' ('Value' ('Maybe' Int)))
    --         myUser       <- 'takeColumns' \@('SqlExpr' ('Entity' User))
    --         myAddress    <- 'takeColumns' \@('SqlExpr' ('Maybe' ('Entity' Address)))
    --         'pure' MyRecord { myName = myName
    --                       , myAge = myAge
    --                       , myUser = myUser
    --                       , myAddress = myAddress
    --                       }
    -- @
    --
    -- Then, we could write a selection function to use the record in queries:
    --
    -- @
    -- getMyRecord :: 'Database.Esqueleto.SqlPersistT' 'IO' [MyRecord]
    -- getMyRecord = 'Database.Esqueleto.Experimental.select' myRecordQuery
    --
    -- myRecordQuery :: 'Database.Esqueleto.SqlQuery' SqlMyRecord
    -- myRecordQuery = do
    --   user ':&' address <- 'Database.Esqueleto.Experimental.from' '$'
    --     'Database.Esqueleto.Experimental.table' \@User
    --       \`'Database.Esqueleto.Experimental.leftJoin'\`
    --       'Database.Esqueleto.Experimental.table' \@Address
    --       \`'Database.Esqueleto.Experimental.on'\` (do \\(user ':&' address) -> user 'Database.Esqueleto.Experimental.^.' #address 'Database.Esqueleto.Experimental.==.' address 'Database.Esqueleto.Experimental.?.' #id)
    --   'pure'
    --     SqlMyRecord
    --       { myName = 'Database.Esqueleto.Experimental.castString' '$' user 'Database.Esqueleto.Experimental.^.' #firstName
    --       , myAge = 'Database.Esqueleto.Experimental.val' 10
    --       , myUser = user
    --       , myAddress = address
    --       }
    -- @
    --
    -- @since 3.5.6.0
    deriveEsqueletoRecord :: Name -> Q [Dec]
    deriveEsqueletoRecord :: Name -> Q [Dec]
    deriveEsqueletoRecord = DeriveEsqueletoRecordSettings -> Name -> Q [Dec]
    deriveEsqueletoRecordWith DeriveEsqueletoRecordSettings
    defaultDeriveEsqueletoRecordSettings

    -- | Codegen settings for 'deriveEsqueletoRecordWith'.
    --
    -- @since 3.5.8.0
    data DeriveEsqueletoRecordSettings = DeriveEsqueletoRecordSettings
      { DeriveEsqueletoRecordSettings -> String -> String
    sqlNameModifier :: String -> String
        -- ^ Function applied to the Haskell record's type name and constructor
        -- name to produce the SQL record's type name and constructor name.
        --
        -- @since 3.5.8.0
      , DeriveEsqueletoRecordSettings -> String -> String
    sqlFieldModifier :: String -> String
        -- ^ Function applied to the Haskell record's field names to produce the
        -- SQL record's field names.
        --
        -- @since 3.5.8.0
      }

    -- | The default codegen settings for 'deriveEsqueletoRecord'.
    --
    -- These defaults will cause you to require @{-# LANGUAGE DuplicateRecordFields #-}@
    -- in certain cases (see 'deriveEsqueletoRecord'.) If you don't want to do this,
    -- change the value of 'sqlFieldModifier' so the field names of the generated SQL
    -- record different from those of the Haskell record.
    --
    -- @since 3.5.8.0
    defaultDeriveEsqueletoRecordSettings :: DeriveEsqueletoRecordSettings
    defaultDeriveEsqueletoRecordSettings :: DeriveEsqueletoRecordSettings
    defaultDeriveEsqueletoRecordSettings = DeriveEsqueletoRecordSettings
      { sqlNameModifier :: String -> String
    sqlNameModifier = (String
    "Sql" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
      , sqlFieldModifier :: String -> String
    sqlFieldModifier = String -> String
    forall a. a -> a
    id
      }

    -- | Takes the name of a Haskell record type and creates a variant of that
    -- record based on the supplied settings which can be used in esqueleto
    -- expressions. This reduces the amount of pattern matching on large tuples
    -- required to interact with data extracted with esqueleto.
    --
    -- This is a variant of 'deriveEsqueletoRecord' which allows you to avoid the
    -- use of @{-# LANGUAGE DuplicateRecordFields #-}@, by configuring the
    -- 'DeriveEsqueletoRecordSettings' used to generate the SQL record.
    --
    -- @since 3.5.8.0
    deriveEsqueletoRecordWith :: DeriveEsqueletoRecordSettings -> Name -> Q [Dec]
    deriveEsqueletoRecordWith :: DeriveEsqueletoRecordSettings -> Name -> Q [Dec]
    deriveEsqueletoRecordWith DeriveEsqueletoRecordSettings
    settings Name
    originalName = do
      RecordInfo
    info <- DeriveEsqueletoRecordSettings -> Name -> Q RecordInfo
    getRecordInfo DeriveEsqueletoRecordSettings
    settings Name
    originalName
      -- It would be nicer to use `mconcat` here but I don't think the right
      -- instance is available in GHC 8.
      Dec
    recordDec <- RecordInfo -> Q Dec
    makeSqlRecord RecordInfo
    info
      Dec
    sqlSelectInstanceDec <- RecordInfo -> Q Dec
    makeSqlSelectInstance RecordInfo
    info
      Dec
    toAliasInstanceDec <- RecordInfo -> Q Dec
    makeToAliasInstance RecordInfo
    info
      Dec
    toAliasReferenceInstanceDec <- RecordInfo -> Q Dec
    makeToAliasReferenceInstance RecordInfo
    info
      [Dec] -> Q [Dec]
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        [ Dec
    recordDec
        , Dec
    sqlSelectInstanceDec
        , Dec
    toAliasInstanceDec
        , Dec
    toAliasReferenceInstanceDec
        ]

    -- | Information about a record we need to generate the declarations.
    -- We compute this once and then pass it around to save on complexity /
    -- repeated work.
    data RecordInfo = RecordInfo
      { -- | The original record's name.
        RecordInfo -> Name
    name :: Name
      , -- | The generated SQL record's name.
        RecordInfo -> Name
    sqlName :: Name
      , -- | The original record's constraints. If this isn't empty it'll probably
        -- cause problems, but it's easy to pass around so might as well.
        RecordInfo -> Cxt
    constraints :: Cxt
      , -- | The original record's type-variable-binders.
    #if MIN_VERSION_template_haskell(2,17,0)
        RecordInfo -> [TyVarBndr ()]
    typeVarBinders :: [TyVarBndr ()]
    #else
        typeVarBinders :: [TyVarBndr]
    #endif
      , -- | The original record's kind, I think.
        RecordInfo -> Maybe Type
    kind :: Maybe Kind
      , -- | The original record's constructor name.
        RecordInfo -> Name
    constructorName :: Name
      , -- | The generated SQL record's constructor name.
        RecordInfo -> Name
    sqlConstructorName :: Name
      , -- | The original record's field names and types, derived from the
        -- constructors.
        RecordInfo -> [(Name, Type)]
    fields :: [(Name, Type)]
      , -- | The generated SQL record's field names and types, computed
        -- with 'sqlFieldType'.
        RecordInfo -> [(Name, Type)]
    sqlFields :: [(Name, Type)]
      }

    -- | Get a `RecordInfo` instance for the given record name.
    getRecordInfo :: DeriveEsqueletoRecordSettings -> Name -> Q RecordInfo
    getRecordInfo :: DeriveEsqueletoRecordSettings -> Name -> Q RecordInfo
    getRecordInfo DeriveEsqueletoRecordSettings
    settings Name
    name = do
      TyConI Dec
    dec <- Name -> Q Info
    reify Name
    name
      (Cxt
    constraints, [TyVarBndr ()]
    typeVarBinders, Maybe Type
    kind, [Con]
    constructors) <-
            case Dec
    dec of
              DataD Cxt
    constraints' Name
    _name [TyVarBndr ()]
    typeVarBinders' Maybe Type
    kind' [Con]
    constructors' [DerivClause]
    _derivingClauses ->
                (Cxt, [TyVarBndr ()], Maybe Type, [Con])
    -> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con])
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Cxt
    constraints', [TyVarBndr ()]
    typeVarBinders', Maybe Type
    kind', [Con]
    constructors')
              NewtypeD Cxt
    constraints' Name
    _name [TyVarBndr ()]
    typeVarBinders' Maybe Type
    kind' Con
    constructor' [DerivClause]
    _derivingClauses ->
                (Cxt, [TyVarBndr ()], Maybe Type, [Con])
    -> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con])
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Cxt
    constraints', [TyVarBndr ()]
    typeVarBinders', Maybe Type
    kind', [Con
    constructor'])
              Dec
    _ -> String -> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con])
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con]))
    -> String -> Q (Cxt, [TyVarBndr ()], Maybe Type, [Con])
    forall a b. (a -> b) -> a -> b
    $ String
    "Esqueleto records can only be derived for records and newtypes, but " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Show a => a -> String
    show Name
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " is neither"
      Con
    constructor <- case [Con]
    constructors of
                      (Con
    c : [Con]
    _) -> Con -> Q Con
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Con
    c
                      [] -> String -> Q Con
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Q Con) -> String -> Q Con
    forall a b. (a -> b) -> a -> b
    $ String
    "Cannot derive Esqueleto record for a type with no constructors: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Show a => a -> String
    show Name
    name
      let constructorName :: Name
    constructorName =
            case [Con] -> Con
    forall a. HasCallStack => [a] -> a
    head [Con]
    constructors of
              RecC Name
    name' [VarBangType]
    _fields -> Name
    name'
              Con
    con -> String -> Name
    forall a. HasCallStack => String -> a
    error (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ Con -> String
    nonRecordConstructorMessage Con
    con
          fields :: [(Name, Type)]
    fields = Con -> [(Name, Type)]
    getFields Con
    constructor
          sqlName :: Name
    sqlName = DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlName DeriveEsqueletoRecordSettings
    settings Name
    name
          sqlConstructorName :: Name
    sqlConstructorName = DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlName DeriveEsqueletoRecordSettings
    settings Name
    constructorName

      [(Name, Type)]
    sqlFields <- ((Name, Type) -> Q (Name, Type))
    -> [(Name, Type)] -> Q [(Name, Type)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Name, Type) -> Q (Name, Type)
    toSqlField [(Name, Type)]
    fields

      RecordInfo -> Q RecordInfo
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    name :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    fields :: [(Name, Type)]
    sqlName :: Name
    sqlConstructorName :: Name
    sqlFields :: [(Name, Type)]
    ..}
      where
        getFields :: Con -> [(Name, Type)]
        getFields :: Con -> [(Name, Type)]
    getFields (RecC Name
    _name [VarBangType]
    fields) = [(Name
    fieldName', Type
    fieldType') | (Name
    fieldName', Bang
    _bang, Type
    fieldType') <- [VarBangType]
    fields]
        getFields Con
    con = String -> [(Name, Type)]
    forall a. HasCallStack => String -> a
    error (String -> [(Name, Type)]) -> String -> [(Name, Type)]
    forall a b. (a -> b) -> a -> b
    $ Con -> String
    nonRecordConstructorMessage Con
    con

        toSqlField :: (Name, Type) -> Q (Name, Type)
    toSqlField (Name
    fieldName', Type
    ty) = do
          let modifier :: Name -> Name
    modifier = String -> Name
    mkName (String -> Name) -> (Name -> String) -> Name -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DeriveEsqueletoRecordSettings -> String -> String
    sqlFieldModifier DeriveEsqueletoRecordSettings
    settings (String -> String) -> (Name -> String) -> Name -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase
          Type
    sqlTy <- Type -> Q Type
    sqlFieldType Type
    ty
          (Name, Type) -> Q (Name, Type)
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> Name
    modifier Name
    fieldName', Type
    sqlTy)

    -- | Create a new name by prefixing @Sql@ to a given name.
    makeSqlName :: DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlName :: DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlName DeriveEsqueletoRecordSettings
    settings Name
    name = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ DeriveEsqueletoRecordSettings -> String -> String
    sqlNameModifier DeriveEsqueletoRecordSettings
    settings (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Name -> String
    nameBase Name
    name

    -- | Transforms a record field type into a corresponding `SqlExpr` type.
    --
    -- * @'Entity' x@ is transformed into @'SqlExpr' ('Entity' x)@.
    -- * @'Maybe' ('Entity' x)@ is transformed into @'SqlExpr' ('Maybe' ('Entity' x))@.
    -- * @x@ is transformed into @'SqlExpr' ('Value' x)@.
    -- * If there exists an instance @'SqlSelect' sql x@, then @x@ is transformed into @sql@.
    --
    -- This function should match `sqlSelectProcessRowPat`.
    sqlFieldType :: Type -> Q Type
    sqlFieldType :: Type -> Q Type
    sqlFieldType Type
    fieldType = do
      Maybe Type
    maybeSqlType <- Type -> Q (Maybe Type)
    reifySqlSelectType Type
    fieldType

      Type -> Q Type
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Type -> Q Type) -> Type -> Q Type
    forall a b. (a -> b) -> a -> b
    $
        (Type -> Maybe Type -> Type) -> Maybe Type -> Type -> Type
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Type -> Maybe Type -> Type
    forall a. a -> Maybe a -> a
    fromMaybe Maybe Type
    maybeSqlType (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
          case Type
    fieldType of
            -- Entity x -> SqlExpr (Entity x)
            AppT (ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''Entity -> Bool
    True)) Type
    _innerType -> Type -> Type -> Type
    AppT (Name -> Type
    ConT ''SqlExpr) Type
    fieldType

            -- Maybe (Entity x) -> SqlExpr (Maybe (Entity x))
            (ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''Maybe -> Bool
    True))
              `AppT` ((ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''Entity -> Bool
    True))
                      `AppT` Type
    _innerType) -> Type -> Type -> Type
    AppT (Name -> Type
    ConT ''SqlExpr) Type
    fieldType

            -- x -> SqlExpr (Value x)
            Type
    _ -> (Name -> Type
    ConT ''SqlExpr)
                    Type -> Type -> Type
    `AppT` ((Name -> Type
    ConT ''Value)
                            Type -> Type -> Type
    `AppT` Type
    fieldType)

    -- | Generates the declaration for an @Sql@-prefixed record, given the original
    -- record's information.
    makeSqlRecord :: RecordInfo -> Q Dec
    makeSqlRecord :: RecordInfo -> Q Dec
    makeSqlRecord RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr ()]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    ..} = do
      let newConstructor :: Con
    newConstructor = Name -> [VarBangType] -> Con
    RecC Name
    sqlConstructorName ((Name, Type) -> VarBangType
    forall {a} {c}. (a, c) -> (a, Bang, c)
    makeField ((Name, Type) -> VarBangType) -> [(Name, Type)] -> [VarBangType]
    forall a b. (a -> b) -> [a] -> [b]
    `map` [(Name, Type)]
    sqlFields)
          derivingClauses :: [a]
    derivingClauses = []
      Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Dec -> Q Dec) -> Dec -> Q Dec
    forall a b. (a -> b) -> a -> b
    $ Cxt
    -> Name
    -> [TyVarBndr ()]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataD Cxt
    constraints Name
    sqlName [TyVarBndr ()]
    typeVarBinders Maybe Type
    kind [Con
    newConstructor] [DerivClause]
    forall a. [a]
    derivingClauses
      where
        makeField :: (a, c) -> (a, Bang, c)
    makeField (a
    fieldName', c
    fieldType) =
          (a
    fieldName', SourceUnpackedness -> SourceStrictness -> Bang
    Bang SourceUnpackedness
    NoSourceUnpackedness SourceStrictness
    NoSourceStrictness, c
    fieldType)

    -- | Generates an `SqlSelect` instance for the given record and its
    -- @Sql@-prefixed variant.
    makeSqlSelectInstance :: RecordInfo -> Q Dec
    makeSqlSelectInstance :: RecordInfo -> Q Dec
    makeSqlSelectInstance info :: RecordInfo
    info@RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr ()]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    ..} = do
      Dec
    sqlSelectColsDec' <- RecordInfo -> Q Dec
    sqlSelectColsDec RecordInfo
    info
      Dec
    sqlSelectColCountDec' <- RecordInfo -> Q Dec
    sqlSelectColCountDec RecordInfo
    info
      Dec
    sqlSelectProcessRowDec' <- RecordInfo -> Q Dec
    sqlSelectProcessRowDec RecordInfo
    info
      let overlap :: Maybe a
    overlap = Maybe a
    forall a. Maybe a
    Nothing
          instanceConstraints :: [a]
    instanceConstraints = []
          instanceType :: Type
    instanceType =
            (Name -> Type
    ConT ''SqlSelect)
              Type -> Type -> Type
    `AppT` (Name -> Type
    ConT Name
    sqlName)
              Type -> Type -> Type
    `AppT` (Name -> Type
    ConT Name
    name)

      Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Dec -> Q Dec) -> Dec -> Q Dec
    forall a b. (a -> b) -> a -> b
    $ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
    InstanceD Maybe Overlap
    forall a. Maybe a
    overlap Cxt
    forall a. [a]
    instanceConstraints Type
    instanceType [Dec
    sqlSelectColsDec', Dec
    sqlSelectColCountDec', Dec
    sqlSelectProcessRowDec']

    -- | Generates the `sqlSelectCols` declaration for an `SqlSelect` instance.
    sqlSelectColsDec :: RecordInfo -> Q Dec
    sqlSelectColsDec :: RecordInfo -> Q Dec
    sqlSelectColsDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr ()]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    ..} = do
      -- Pairs of record field names and local variable names.
      [(Name, Name)]
    fieldNames <- [(Name, Type)]
    -> ((Name, Type) -> Q (Name, Name)) -> Q [(Name, Name)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Name, Type)]
    sqlFields (\(Name
    name', Type
    _type) -> do
        Name
    var <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (String -> Q Name) -> String -> Q Name
    forall a b. (a -> b) -> a -> b
    $ Name -> String
    nameBase Name
    name'
        (Name, Name) -> Q (Name, Name)
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name
    name', Name
    var))

      -- Patterns binding record fields to local variables.
      let fieldPatterns :: [FieldPat]
          fieldPatterns :: [FieldPat]
    fieldPatterns = [(Name
    name', Name -> Pat
    VarP Name
    var) | (Name
    name', Name
    var) <- [(Name, Name)]
    fieldNames]

          -- Local variables for fields joined with `:&` in a single expression.
          joinedFields :: Exp
          joinedFields :: Exp
    joinedFields =
            case (Name, Name) -> Name
    forall a b. (a, b) -> b
    snd ((Name, Name) -> Name) -> [(Name, Name)] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    `map` [(Name, Name)]
    fieldNames of
              [] -> [Maybe Exp] -> Exp
    TupE []
              [Name
    f1] -> Name -> Exp
    VarE Name
    f1
              Name
    f1 : [Name]
    rest ->
                let helper :: Exp -> Name -> Exp
    helper Exp
    lhs Name
    field =
                      Maybe Exp -> Exp -> Maybe Exp -> Exp
    InfixE
                        (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just Exp
    lhs)
                        (Name -> Exp
    ConE '(:&))
                        (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    field)
                 in (Exp -> Name -> Exp) -> Exp -> [Name] -> Exp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Exp -> Name -> Exp
    helper (Name -> Exp
    VarE Name
    f1) [Name]
    rest

      Name
    identInfo <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "identInfo"
      -- Roughly:
      -- sqlSelectCols $identInfo SqlFoo{..} = sqlSelectCols $identInfo $joinedFields
      Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Dec -> Q Dec) -> Dec -> Q Dec
    forall a b. (a -> b) -> a -> b
    $
        Name -> [Clause] -> Dec
    FunD
          'sqlSelectCols
          [ [Pat] -> Body -> [Dec] -> Clause
    Clause
              [ Name -> Pat
    VarP Name
    identInfo
              , Name -> [FieldPat] -> Pat
    RecP Name
    sqlName [FieldPat]
    fieldPatterns
              ]
              ( Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $
                  (Name -> Exp
    VarE 'sqlSelectCols)
                    Exp -> Exp -> Exp
    `AppE` (Name -> Exp
    VarE Name
    identInfo)
                    Exp -> Exp -> Exp
    `AppE` (Exp -> Exp
    ParensE Exp
    joinedFields)
              )
              -- `where` clause.
              []
          ]

    -- | Generates the `sqlSelectColCount` declaration for an `SqlSelect` instance.
    sqlSelectColCountDec :: RecordInfo -> Q Dec
    sqlSelectColCountDec :: RecordInfo -> Q Dec
    sqlSelectColCountDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr ()]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    ..} = do
      let joinedTypes :: Type
    joinedTypes =
            case (Name, Type) -> Type
    forall a b. (a, b) -> b
    snd ((Name, Type) -> Type) -> [(Name, Type)] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    `map` [(Name, Type)]
    sqlFields of
              [] -> Int -> Type
    TupleT Int
    0
              Type
    t1 : Cxt
    rest ->
                let helper :: Type -> Type -> Type
    helper Type
    lhs Type
    ty =
                      Type -> Name -> Type -> Type
    InfixT Type
    lhs ''(:&) Type
    ty
                 in (Type -> Type -> Type) -> Type -> Cxt -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Type -> Type -> Type
    helper Type
    t1 Cxt
    rest

      -- Roughly:
      -- sqlSelectColCount _ = sqlSelectColCount (Proxy @($joinedTypes))
      Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Dec -> Q Dec) -> Dec -> Q Dec
    forall a b. (a -> b) -> a -> b
    $
        Name -> [Clause] -> Dec
    FunD
          'sqlSelectColCount
          [ [Pat] -> Body -> [Dec] -> Clause
    Clause
              [Pat
    WildP]
              ( Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $
                  Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'sqlSelectColCount) (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $
                    Exp -> Exp
    ParensE (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $
                      Exp -> Type -> Exp
    AppTypeE
                        (Name -> Exp
    ConE 'Proxy)
                        Type
    joinedTypes
              )
              -- `where` clause.
              []
          ]

    -- | Generates the `sqlSelectProcessRow` declaration for an `SqlSelect`
    -- instance.
    sqlSelectProcessRowDec :: RecordInfo -> Q Dec
    sqlSelectProcessRowDec :: RecordInfo -> Q Dec
    sqlSelectProcessRowDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr ()]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    ..} = do
      -- Binding statements and field expressions (used in record construction) to
      -- fill out the body of the main generated `do` expression.
      --
      -- Each statement is like:
      --     Value fooName' <- takeColumns @(SqlExpr (Value Text))
      -- A corresponding field expression would be:
      --     fooName = fooName'
      --
      -- See `sqlSelectProcessRowPat` for the left-hand side of the patterns.
      ([Stmt]
    statements, [(Name, Exp)]
    fieldExps) <-
        [(Stmt, (Name, Exp))] -> ([Stmt], [(Name, Exp)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(Stmt, (Name, Exp))] -> ([Stmt], [(Name, Exp)]))
    -> Q [(Stmt, (Name, Exp))] -> Q ([Stmt], [(Name, Exp)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [((Name, Type), (Name, Type))]
    -> (((Name, Type), (Name, Type)) -> Q (Stmt, (Name, Exp)))
    -> Q [(Stmt, (Name, Exp))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM ([(Name, Type)] -> [(Name, Type)] -> [((Name, Type), (Name, Type))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(Name, Type)]
    fields [(Name, Type)]
    sqlFields) (\((Name
    fieldName', Type
    fieldType), (Name
    _, Type
    sqlType')) -> do
          Name
    valueName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
          Pat
    pattern <- Type -> Name -> Q Pat
    sqlSelectProcessRowPat Type
    fieldType Name
    valueName
          (Stmt, (Name, Exp)) -> Q (Stmt, (Name, Exp))
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
            ( Pat -> Exp -> Stmt
    BindS
                Pat
    pattern
                (Exp -> Type -> Exp
    AppTypeE (Name -> Exp
    VarE 'takeColumns) Type
    sqlType')
            , (String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ Name -> String
    nameBase Name
    fieldName', Name -> Exp
    VarE Name
    valueName)
            ))

      Name
    colsName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "columns"
      Name
    processName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "process"

      -- Roughly:
      -- sqlSelectProcessRow $colsName =
      --   first ((fromString "Failed to parse $name: ") <>)
      --         (evalStateT $processName $colsName)
      --   where $processName = do $statements
      --                           pure $name {$fieldExps}
      Exp
    bodyExp <- [e|
        first (fromString ("Failed to parse " ++ $(String -> Q Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => String -> m Exp
    lift (String -> Q Exp) -> String -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> String
    nameBase Name
    name) ++ ": ") <>)
              (evalStateT $(Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    processName) $(Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    colsName))
        |]

      Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Dec -> Q Dec) -> Dec -> Q Dec
    forall a b. (a -> b) -> a -> b
    $
        Name -> [Clause] -> Dec
    FunD
          'sqlSelectProcessRow
          [ [Pat] -> Body -> [Dec] -> Clause
    Clause
              [Name -> Pat
    VarP Name
    colsName]
              (Exp -> Body
    NormalB Exp
    bodyExp)
              -- `where` clause
              [ Pat -> Body -> [Dec] -> Dec
    ValD
                  (Name -> Pat
    VarP Name
    processName)
                  ( Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $
                      Maybe ModName -> [Stmt] -> Exp
    DoE
    #if MIN_VERSION_template_haskell(2,17,0)
                        Maybe ModName
    forall a. Maybe a
    Nothing
    #endif
                        ([Stmt]
    statements [Stmt] -> [Stmt] -> [Stmt]
    forall a. [a] -> [a] -> [a]
    ++ [Exp -> Stmt
    NoBindS (Exp -> Stmt) -> Exp -> Stmt
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'pure) (Name -> [(Name, Exp)] -> Exp
    RecConE Name
    constructorName [(Name, Exp)]
    fieldExps)])
                  )
                  []
              ]
          ]

    -- | Get the left-hand side pattern of a statement in a @do@ block for binding
    -- to the result of `sqlSelectProcessRow`.
    --
    -- * A type of @'Entity' x@ gives a pattern of @var@.
    -- * A type of @'Maybe' ('Entity' x)@ gives a pattern of @var@.
    -- * A type of @x@ gives a pattern of @'Value' var@.
    -- * If there exists an instance @'SqlSelect' sql x@, then a type of @x@ gives a pattern of @var@.
    --
    -- This function should match `sqlFieldType`.
    sqlSelectProcessRowPat :: Type -> Name -> Q Pat
    sqlSelectProcessRowPat :: Type -> Name -> Q Pat
    sqlSelectProcessRowPat Type
    fieldType Name
    var = do
      Maybe Type
    maybeSqlType <- Type -> Q (Maybe Type)
    reifySqlSelectType Type
    fieldType

      case Maybe Type
    maybeSqlType of
        Just Type
    _ -> Pat -> Q Pat
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pat -> Q Pat) -> Pat -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ Name -> Pat
    VarP Name
    var
        Maybe Type
    Nothing -> case Type
    fieldType of
            -- Entity x -> var
            AppT (ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''Entity -> Bool
    True)) Type
    _innerType -> Pat -> Q Pat
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pat -> Q Pat) -> Pat -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ Name -> Pat
    VarP Name
    var
            -- Maybe (Entity x) -> var
            (ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''Maybe -> Bool
    True))
              `AppT` ((ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''Entity -> Bool
    True))
                      `AppT` Type
    _innerType) -> Pat -> Q Pat
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pat -> Q Pat) -> Pat -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ Name -> Pat
    VarP Name
    var
            -- x -> Value var
    #if MIN_VERSION_template_haskell(2,18,0)
            Type
    _ -> Pat -> Q Pat
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Pat -> Q Pat) -> Pat -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ Name -> Cxt -> [Pat] -> Pat
    ConP 'Value [] [Name -> Pat
    VarP Name
    var]
    #else
            _ -> pure $ ConP 'Value [VarP var]
    #endif

    -- Given a type, find the corresponding SQL type.
    --
    -- If there exists an instance `SqlSelect sql ty`, then the SQL type for `ty`
    -- is `sql`.
    --
    -- This function definitely works for records and instances generated by this
    -- module, and might work for instances outside of it.
    reifySqlSelectType :: Type -> Q (Maybe Type)
    reifySqlSelectType :: Type -> Q (Maybe Type)
    reifySqlSelectType Type
    originalType = do
      -- Here we query the compiler for Instances of `SqlSelect a $(originalType)`;
      -- the API for this is super weird, it interprets a list of types as being
      -- applied as successive arguments to the typeclass name.
      --
      -- See: https://gitlab.haskell.org/ghc/ghc/-/issues/21825
      --
      -- >>> reifyInstances ''SqlSelect [VarT (mkName "a"), ConT ''MyRecord]
      -- [ InstanceD Nothing
      --             []
      --             (AppT (AppT (ConT Database.Esqueleto.Internal.Internal.SqlSelect)
      --                         (ConT Ghci3.SqlMyRecord))
      --                   (ConT Ghci3.MyRecord))
      --             []
      -- ]
      Name
    tyVarName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "a"
      [Dec]
    instances <- Name -> Cxt -> Q [Dec]
    reifyInstances ''SqlSelect [Name -> Type
    VarT Name
    tyVarName, Type
    originalType]

      -- Given the original type (`originalType`) and an instance type for a
      -- `SqlSelect` instance, get the SQL type which corresponds to the original
      -- type.
      let extractSqlRecord :: Type -> Type -> Maybe Type
          extractSqlRecord :: Type -> Type -> Maybe Type
    extractSqlRecord Type
    originalTy Type
    instanceTy =
            case Type
    instanceTy of
              (ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''SqlSelect -> Bool
    True))
                `AppT` Type
    sqlTy
                `AppT` (Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Type
    originalTy -> Bool
    True) -> Type -> Maybe Type
    forall a. a -> Maybe a
    Just Type
    sqlTy
              Type
    _ -> Maybe Type
    forall a. Maybe a
    Nothing

          -- Filter `instances` to the instances which match `originalType`.
          filteredInstances :: [Type]
          filteredInstances :: Cxt
    filteredInstances =
            ((Dec -> Maybe Type) -> [Dec] -> Cxt)
    -> [Dec] -> (Dec -> Maybe Type) -> Cxt
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Dec -> Maybe Type) -> [Dec] -> Cxt
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe [Dec]
    instances
              (\case InstanceD Maybe Overlap
    _overlap
                               Cxt
    _constraints
                               (Type -> Type -> Maybe Type
    extractSqlRecord Type
    originalType -> Just Type
    sqlRecord)
                               [Dec]
    _decs ->
                                 Type -> Maybe Type
    forall a. a -> Maybe a
    Just Type
    sqlRecord
                     Dec
    _ -> Maybe Type
    forall a. Maybe a
    Nothing)

      Maybe Type -> Q (Maybe Type)
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe Type -> Q (Maybe Type)) -> Maybe Type -> Q (Maybe Type)
    forall a b. (a -> b) -> a -> b
    $ Cxt -> Maybe Type
    forall a. [a] -> Maybe a
    listToMaybe Cxt
    filteredInstances

    -- | Statefully parse some number of columns from a list of `PersistValue`s,
    -- where the number of columns to parse is determined by `sqlSelectColCount`
    -- for @a@.
    --
    -- This is used to implement `sqlSelectProcessRow` for records created with
    -- `deriveEsqueletoRecord`.
    takeColumns ::
      forall a b.
      SqlSelect a b =>
      StateT [PersistValue] (Either Text) b
    takeColumns :: forall a b. SqlSelect a b => StateT [PersistValue] (Either Text) b
    takeColumns = ([PersistValue] -> Either Text (b, [PersistValue]))
    -> StateT [PersistValue] (Either Text) b
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
    StateT (\[PersistValue]
    pvs ->
      let targetColCount :: Int
    targetColCount =
            Proxy a -> Int
    forall a r. SqlSelect a r => Proxy a -> Int
    sqlSelectColCount (forall t. Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)
          ([PersistValue]
    target, [PersistValue]
    other) =
            Int -> [PersistValue] -> ([PersistValue], [PersistValue])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    targetColCount [PersistValue]
    pvs
       in if [PersistValue] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [PersistValue]
    target Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    targetColCount
            then do
              b
    value <- [PersistValue] -> Either Text b
    forall a r. SqlSelect a r => [PersistValue] -> Either Text r
    sqlSelectProcessRow [PersistValue]
    target
              (b, [PersistValue]) -> Either Text (b, [PersistValue])
    forall a b. b -> Either a b
    Right (b
    value, [PersistValue]
    other)
            else Text -> Either Text (b, [PersistValue])
    forall a b. a -> Either a b
    Left Text
    "Insufficient columns when trying to parse a column")

    -- | Get an error message for a non-record constructor.
    -- This module does not yet support non-record constructors, so we'll tell the
    -- user what sort of constructor they provided that we can't use, along with
    -- the name of that constructor. This turns out to require recursion, but you
    -- can't win every battle.
    nonRecordConstructorMessage :: Con -> String
    nonRecordConstructorMessage :: Con -> String
    nonRecordConstructorMessage Con
    con =
      case Con
    con of
        (RecC {}) -> String -> String
    forall a. HasCallStack => String -> a
    error String
    "Record constructors are not an error"
        (NormalC {}) -> String -> String
    helper String
    "non-record data constructor"
        (InfixC {}) -> String -> String
    helper String
    "infix constructor"
        (ForallC {}) -> String -> String
    helper String
    "constructor qualified by type variables / class contexts"
        (GadtC {}) -> String -> String
    helper String
    "GADT constructor"
        (RecGadtC {}) -> String -> String
    helper String
    "record GADT constructor"
      where
        helper :: String -> String
    helper String
    constructorType =
          String
    "Esqueleto records can only be derived for record constructors, but "
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Show a => a -> String
    show (Con -> Name
    constructorName Con
    con)
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " is a "
            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    constructorType

        constructorName :: Con -> Name
    constructorName Con
    constructor =
          case Con
    constructor of
            (RecC Name
    name [VarBangType]
    _) -> Name
    name
            (NormalC Name
    name [BangType]
    _fields) -> Name
    name
            (InfixC BangType
    _ty1 Name
    name BangType
    _ty2) -> Name
    name
            (ForallC [TyVarBndr Specificity]
    _vars Cxt
    _constraints Con
    innerConstructor) -> Con -> Name
    constructorName Con
    innerConstructor
            -- If there's GADTs where multiple constructors are declared with the
            -- same type signature you're evil and furthermore this diagnostic will
            -- only show you the first name.
            (GadtC [Name]
    names [BangType]
    _fields Type
    _ret) -> [Name] -> Name
    forall a. HasCallStack => [a] -> a
    head [Name]
    names
            (RecGadtC [Name]
    names [VarBangType]
    _fields Type
    _ret) -> [Name] -> Name
    forall a. HasCallStack => [a] -> a
    head [Name]
    names

    makeToAliasInstance :: RecordInfo -> Q Dec
    makeToAliasInstance :: RecordInfo -> Q Dec
    makeToAliasInstance info :: RecordInfo
    info@RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr ()]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    ..} = do
      Dec
    toAliasDec' <- RecordInfo -> Q Dec
    toAliasDec RecordInfo
    info
      let overlap :: Maybe a
    overlap = Maybe a
    forall a. Maybe a
    Nothing
          instanceConstraints :: [a]
    instanceConstraints = []
          instanceType :: Type
    instanceType =
            (Name -> Type
    ConT ''ToAlias)
              Type -> Type -> Type
    `AppT` (Name -> Type
    ConT Name
    sqlName)
      Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Dec -> Q Dec) -> Dec -> Q Dec
    forall a b. (a -> b) -> a -> b
    $ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
    InstanceD Maybe Overlap
    forall a. Maybe a
    overlap Cxt
    forall a. [a]
    instanceConstraints Type
    instanceType [Dec
    toAliasDec']

    toAliasDec :: RecordInfo -> Q Dec
    toAliasDec :: RecordInfo -> Q Dec
    toAliasDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr ()]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    ..} = do
      ([Stmt]
    statements, [FieldPat]
    fieldPatterns, [(Name, Exp)]
    fieldExps) <-
        [(Stmt, FieldPat, (Name, Exp))]
    -> ([Stmt], [FieldPat], [(Name, Exp)])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([(Stmt, FieldPat, (Name, Exp))]
     -> ([Stmt], [FieldPat], [(Name, Exp)]))
    -> Q [(Stmt, FieldPat, (Name, Exp))]
    -> Q ([Stmt], [FieldPat], [(Name, Exp)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Name, Type)]
    -> ((Name, Type) -> Q (Stmt, FieldPat, (Name, Exp)))
    -> Q [(Stmt, FieldPat, (Name, Exp))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Name, Type)]
    sqlFields (\(Name
    fieldName', Type
    _) -> do
          Name
    fieldPatternName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
          Name
    boundValueName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
          (Stmt, FieldPat, (Name, Exp)) -> Q (Stmt, FieldPat, (Name, Exp))
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
            ( Pat -> Exp -> Stmt
    BindS
                (Name -> Pat
    VarP Name
    boundValueName)
                (Name -> Exp
    VarE 'toAlias Exp -> Exp -> Exp
    `AppE` Name -> Exp
    VarE Name
    fieldPatternName)
            , (Name
    fieldName', Name -> Pat
    VarP Name
    fieldPatternName)
            , (Name
    fieldName', Name -> Exp
    VarE Name
    boundValueName)
            ))

      Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Dec -> Q Dec) -> Dec -> Q Dec
    forall a b. (a -> b) -> a -> b
    $
        Name -> [Clause] -> Dec
    FunD
          'toAlias
          [ [Pat] -> Body -> [Dec] -> Clause
    Clause
              [ Name -> [FieldPat] -> Pat
    RecP Name
    sqlName [FieldPat]
    fieldPatterns
              ]
              ( Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $
                  Maybe ModName -> [Stmt] -> Exp
    DoE
    #if MIN_VERSION_template_haskell(2,17,0)
                    Maybe ModName
    forall a. Maybe a
    Nothing
    #endif
                    ([Stmt]
    statements [Stmt] -> [Stmt] -> [Stmt]
    forall a. [a] -> [a] -> [a]
    ++ [Exp -> Stmt
    NoBindS (Exp -> Stmt) -> Exp -> Stmt
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'pure) (Name -> [(Name, Exp)] -> Exp
    RecConE Name
    sqlName [(Name, Exp)]
    fieldExps)])
              )
              -- `where` clause.
              []
          ]

    makeToAliasReferenceInstance :: RecordInfo -> Q Dec
    makeToAliasReferenceInstance :: RecordInfo -> Q Dec
    makeToAliasReferenceInstance info :: RecordInfo
    info@RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr ()]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    ..} = do
      Dec
    toAliasReferenceDec' <- RecordInfo -> Q Dec
    toAliasReferenceDec RecordInfo
    info
      let overlap :: Maybe a
    overlap = Maybe a
    forall a. Maybe a
    Nothing
          instanceConstraints :: [a]
    instanceConstraints = []
          instanceType :: Type
    instanceType =
            (Name -> Type
    ConT ''ToAliasReference)
              Type -> Type -> Type
    `AppT` (Name -> Type
    ConT Name
    sqlName)
      Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Dec -> Q Dec) -> Dec -> Q Dec
    forall a b. (a -> b) -> a -> b
    $ Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
    InstanceD Maybe Overlap
    forall a. Maybe a
    overlap Cxt
    forall a. [a]
    instanceConstraints Type
    instanceType [Dec
    toAliasReferenceDec']

    toAliasReferenceDec :: RecordInfo -> Q Dec
    toAliasReferenceDec :: RecordInfo -> Q Dec
    toAliasReferenceDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr ()]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr ()]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr ()]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    ..} = do
      Name
    identInfo <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "identInfo"

      ([Stmt]
    statements, [FieldPat]
    fieldPatterns, [(Name, Exp)]
    fieldExps) <-
        [(Stmt, FieldPat, (Name, Exp))]
    -> ([Stmt], [FieldPat], [(Name, Exp)])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 ([(Stmt, FieldPat, (Name, Exp))]
     -> ([Stmt], [FieldPat], [(Name, Exp)]))
    -> Q [(Stmt, FieldPat, (Name, Exp))]
    -> Q ([Stmt], [FieldPat], [(Name, Exp)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Name, Type)]
    -> ((Name, Type) -> Q (Stmt, FieldPat, (Name, Exp)))
    -> Q [(Stmt, FieldPat, (Name, Exp))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [(Name, Type)]
    sqlFields (\(Name
    fieldName', Type
    _) -> do
          Name
    fieldPatternName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
          Name
    boundValueName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
          (Stmt, FieldPat, (Name, Exp)) -> Q (Stmt, FieldPat, (Name, Exp))
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
            ( Pat -> Exp -> Stmt
    BindS
                (Name -> Pat
    VarP Name
    boundValueName)
                (Name -> Exp
    VarE 'toAliasReference Exp -> Exp -> Exp
    `AppE` Name -> Exp
    VarE Name
    identInfo Exp -> Exp -> Exp
    `AppE` Name -> Exp
    VarE Name
    fieldPatternName)
            , (Name
    fieldName', Name -> Pat
    VarP Name
    fieldPatternName)
            , (Name
    fieldName', Name -> Exp
    VarE Name
    boundValueName)
            ))

      Dec -> Q Dec
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Dec -> Q Dec) -> Dec -> Q Dec
    forall a b. (a -> b) -> a -> b
    $
        Name -> [Clause] -> Dec
    FunD
          'toAliasReference
          [ [Pat] -> Body -> [Dec] -> Clause
    Clause
              [ Name -> Pat
    VarP Name
    identInfo
              , Name -> [FieldPat] -> Pat
    RecP Name
    sqlName [FieldPat]
    fieldPatterns
              ]
              ( Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $
                  Maybe ModName -> [Stmt] -> Exp
    DoE
    #if MIN_VERSION_template_haskell(2,17,0)
                    Maybe ModName
    forall a. Maybe a
    Nothing
    #endif
                    ([Stmt]
    statements [Stmt] -> [Stmt] -> [Stmt]
    forall a. [a] -> [a] -> [a]
    ++ [Exp -> Stmt
    NoBindS (Exp -> Stmt) -> Exp -> Stmt
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'pure) (Name -> [(Name, Exp)] -> Exp
    RecConE Name
    sqlName [(Name, Exp)]
    fieldExps)])
              )
              -- `where` clause.
              []
          ]