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

    module Database.Esqueleto.Record
      ( deriveEsqueletoRecord
      , deriveEsqueletoRecordWith

      , DeriveEsqueletoRecordSettings(..)
      , defaultDeriveEsqueletoRecordSettings
      , takeColumns
      , takeMaybeColumns
      ) 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.ToMaybe (ToMaybe(..))
    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, isJust)

    -- | 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
    sqlMaybeNameModifier :: String -> String
        -- ^ Function applied to the Haskell record's type name and constructor
        -- name to produce the 'ToMaybe' record's type name and constructor name.
        --
        -- @since 3.5.11.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
      , DeriveEsqueletoRecordSettings -> String -> String
    sqlMaybeFieldModifier :: String -> String
        -- ^ Function applied to the Haskell record's field names to produce the
        -- 'ToMaybe' SQL record's field names.
        --
        -- @since 3.5.11.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]
    ++)
      , sqlMaybeNameModifier :: String -> String
    sqlMaybeNameModifier = (String
    "SqlMaybe" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)
      , sqlFieldModifier :: String -> String
    sqlFieldModifier = String -> String
    forall a. a -> a
    id
      , sqlMaybeFieldModifier :: String -> String
    sqlMaybeFieldModifier = 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
      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.
      recordDec <- makeSqlRecord info
      sqlSelectInstanceDec <- makeSqlSelectInstance info
      sqlMaybeRecordDec <- makeSqlMaybeRecord info
      toMaybeInstanceDec <- makeToMaybeInstance info
      sqlMaybeToMaybeInstanceDec <- makeSqlMaybeToMaybeInstance info
      sqlMaybeRecordSelectInstanceDec <- makeSqlMaybeRecordSelectInstance info
      toAliasInstanceDec <- makeToAliasInstance info
      sqlMaybeToAliasInstanceDec <- makeSqlMaybeToAliasInstance info
      toAliasReferenceInstanceDec <- makeToAliasReferenceInstance info
      sqlMaybeToAliasReferenceInstanceDec <- makeSqlMaybeToAliasReferenceInstance info
      pure
        [ recordDec
        , sqlSelectInstanceDec
        , sqlMaybeRecordDec
        , toMaybeInstanceDec
        , sqlMaybeToMaybeInstanceDec
        , sqlMaybeRecordSelectInstanceDec
        , toAliasInstanceDec
        , sqlMaybeToAliasInstanceDec
        , toAliasReferenceInstanceDec
        , sqlMaybeToAliasReferenceInstanceDec
        ]

    -- | 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 generated SQL 'ToMaybe' record's name.
        RecordInfo -> Name
    sqlMaybeName :: 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,21,0)
        RecordInfo -> [TyVarBndr BndrVis]
    typeVarBinders :: [TyVarBndr BndrVis]
    #elif MIN_VERSION_template_haskell(2,17,0)
        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 generated SQL 'ToMaybe' record's constructor name.
        RecordInfo -> Name
    sqlMaybeConstructorName :: 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)]
      , -- | The generated SQL 'ToMaybe' record's field names and types, computed
        -- with 'sqlMaybeFieldType'.
        RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: [(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 <- Name -> Q Info
    reify Name
    name
      (constraints, typeVarBinders, kind, constructors) <-
            case dec of
              DataD Cxt
    constraints' Name
    _name [TyVarBndr BndrVis]
    typeVarBinders' Maybe Type
    kind' [Con]
    constructors' [DerivClause]
    _derivingClauses ->
                (Cxt, [TyVarBndr BndrVis], Maybe Type, [Con])
    -> Q (Cxt, [TyVarBndr BndrVis], Maybe Type, [Con])
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Cxt
    constraints', [TyVarBndr BndrVis]
    typeVarBinders', Maybe Type
    kind', [Con]
    constructors')
              NewtypeD Cxt
    constraints' Name
    _name [TyVarBndr BndrVis]
    typeVarBinders' Maybe Type
    kind' Con
    constructor' [DerivClause]
    _derivingClauses ->
                (Cxt, [TyVarBndr BndrVis], Maybe Type, [Con])
    -> Q (Cxt, [TyVarBndr BndrVis], Maybe Type, [Con])
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Cxt
    constraints', [TyVarBndr BndrVis]
    typeVarBinders', Maybe Type
    kind', [Con
    constructor'])
              Dec
    _ -> String -> Q (Cxt, [TyVarBndr BndrVis], Maybe Type, [Con])
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Q (Cxt, [TyVarBndr BndrVis], Maybe Type, [Con]))
    -> String -> Q (Cxt, [TyVarBndr BndrVis], 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"
      constructor <- case 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 =
            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 = Con -> [(Name, Type)]
    getFields Con
    constructor
          sqlName = DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlName DeriveEsqueletoRecordSettings
    settings Name
    name
          sqlMaybeName = DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlMaybeName DeriveEsqueletoRecordSettings
    settings Name
    name
          sqlConstructorName = DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlName DeriveEsqueletoRecordSettings
    settings Name
    constructorName
          sqlMaybeConstructorName = DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlMaybeName DeriveEsqueletoRecordSettings
    settings Name
    constructorName

      sqlFields <- mapM toSqlField fields
      sqlMaybeFields <- mapM toSqlMaybeField fields

      pure RecordInfo {..}
      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
          sqlTy <- Type -> Q Type
    sqlFieldType Type
    ty
          pure (modifier fieldName', sqlTy)

        toSqlMaybeField :: (Name, Type) -> Q (Name, Type)
    toSqlMaybeField (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
    sqlMaybeFieldModifier DeriveEsqueletoRecordSettings
    settings (String -> String) -> (Name -> String) -> Name -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase
          sqlTy <- Type -> Q Type
    sqlMaybeFieldType Type
    ty
          pure (modifier fieldName', 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

    -- | Create a new name by prefixing @SqlMaybe@ to a given name.
    makeSqlMaybeName :: DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlMaybeName :: DeriveEsqueletoRecordSettings -> Name -> Name
    makeSqlMaybeName DeriveEsqueletoRecordSettings
    settings Name
    name = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ DeriveEsqueletoRecordSettings -> String -> String
    sqlMaybeNameModifier 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
      maybeSqlType <- Type -> Q (Maybe Type)
    reifySqlSelectType Type
    fieldType

      pure $
        flip fromMaybe maybeSqlType $
          case 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)

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

      pure $ maybe convertFieldType convertSqlType maybeSqlType
     where
        convertSqlType :: Type -> Type
    convertSqlType = ((Name -> Type
    ConT ''ToMaybeT) Type -> Type -> Type
    `AppT`)
        convertFieldType :: Type
    convertFieldType = case Type
    fieldType of
            -- Entity x -> SqlExpr (Entity x) -> SqlExpr (Maybe (Entity x))
            AppT (ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''Entity -> Bool
    True)) Type
    _innerType ->
              (Name -> Type
    ConT ''SqlExpr) Type -> Type -> Type
    `AppT` ((Name -> Type
    ConT ''Maybe) Type -> Type -> Type
    `AppT` Type
    fieldType)

            -- Maybe (Entity x) -> SqlExpr (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) ->
                        (Name -> Type
    ConT ''SqlExpr) Type -> Type -> Type
    `AppT` Type
    fieldType

            -- Maybe x -> SqlExpr (Value (Maybe x)) -> SqlExpr (Value (Maybe x))
            inner :: Type
    inner@((ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''Maybe -> Bool
    True)) `AppT` Type
    _inner) -> (Name -> Type
    ConT ''SqlExpr) Type -> Type -> Type
    `AppT` ((Name -> Type
    ConT ''Value) Type -> Type -> Type
    `AppT` Type
    inner)

            -- x -> SqlExpr (Value x) -> SqlExpr (Value (Maybe x))
            Type
    _ -> (Name -> Type
    ConT ''SqlExpr)
                    Type -> Type -> Type
    `AppT` ((Name -> Type
    ConT ''Value)
                            Type -> Type -> Type
    `AppT` ((Name -> Type
    ConT ''Maybe) 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 BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(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 BndrVis]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataD Cxt
    constraints Name
    sqlName [TyVarBndr BndrVis]
    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 BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = do
      sqlSelectColsDec' <- RecordInfo -> Q [Dec]
    sqlSelectColsDec RecordInfo
    info
      sqlSelectColCountDec' <- sqlSelectColCountDec info
      sqlSelectProcessRowDec' <- sqlSelectProcessRowDec info
      let overlap = Maybe a
    forall a. Maybe a
    Nothing
          instanceConstraints = []
      instanceType <- [t| SqlSelect $(conT sqlName) $(conT name) |]

      pure $ InstanceD overlap instanceConstraints instanceType (sqlSelectColsDec' ++ sqlSelectColCountDec' ++ [ sqlSelectProcessRowDec'])

    -- | Generates the `sqlSelectCols` declaration for an `SqlSelect` instance.
    sqlSelectColsDec :: RecordInfo -> Q [Dec]
    sqlSelectColsDec :: RecordInfo -> Q [Dec]
    sqlSelectColsDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = do
      -- Pairs of record field names and local variable names.
      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
        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'
        pure (name', var))

      -- Patterns binding record fields to local variables.
      let 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 =
            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

      identInfo <- newName "identInfo"
      [d| $(varP 'sqlSelectCols) = \ $(varP identInfo) $(pure $ RecP sqlName fieldPatterns) ->
            sqlSelectCols $(varE identInfo) $(pure joinedFields)
        |]

    -- | Generates the `sqlSelectColCount` declaration for an `SqlSelect` instance.
    sqlSelectColCountDec :: RecordInfo -> Q [Dec]
    sqlSelectColCountDec :: RecordInfo -> Q [Dec]
    sqlSelectColCountDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(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

      [d| $(Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP 'sqlSelectColCount) = \ _ -> sqlSelectColCount (Proxy @($(Type -> Q Type
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Type
    joinedTypes))) |]

    -- | Generates the `sqlSelectProcessRow` declaration for an `SqlSelect`
    -- instance.
    sqlSelectProcessRowDec :: RecordInfo -> Q Dec
    sqlSelectProcessRowDec :: RecordInfo -> Q Dec
    sqlSelectProcessRowDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(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.
      (statements, 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
          valueName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
          pattern <- sqlSelectProcessRowPat fieldType valueName
          pure
            ( BindS
                pattern
                (AppTypeE (VarE 'takeColumns) sqlType')
            , (mkName $ nameBase fieldName', VarE valueName)
            ))

      colsName <- newName "columns"
      processName <- newName "process"

      -- Roughly:
      -- sqlSelectProcessRow $colsName =
      --   first ((fromString "Failed to parse $name: ") <>)
      --         (evalStateT $processName $colsName)
      --   where $processName = do $statements
      --                           pure $name {$fieldExps}
      bodyExp <- [e|
        first (fromString ("Failed to parse " ++ $(lift $ nameBase name) ++ ": ") <>)
              (evalStateT $(varE processName) $(varE colsName))
        |]

      pure $
        FunD
          'sqlSelectProcessRow
          [ Clause
              [VarP colsName]
              (NormalB bodyExp)
              -- `where` clause
              [ ValD
                  (VarP processName)
                  ( NormalB $
                      DoE
    #if MIN_VERSION_template_haskell(2,17,0)
                        Nothing
    #endif
                        (statements ++ [NoBindS $ AppE (VarE 'pure) (RecConE constructorName 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
      maybeSqlType <- Type -> Q (Maybe Type)
    reifySqlSelectType Type
    fieldType

      case 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
            Type
    _ -> [p| Value $(Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    var) |]

    -- 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))
      --             []
      -- ]
      tyVarName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "a"
      instances <- reifyInstances ''SqlSelect [VarT tyVarName, 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
    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 =
            ((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)

      pure $ listToMaybe 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
              value <- [PersistValue] -> Either Text b
    forall a r. SqlSelect a r => [PersistValue] -> Either Text r
    sqlSelectProcessRow [PersistValue]
    target
              Right (value, 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 RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = Name -> [(Name, Type)] -> Q Dec
    makeToAliasInstanceFor Name
    sqlName [(Name, Type)]
    sqlFields

    makeSqlMaybeToAliasInstance :: RecordInfo -> Q Dec
    makeSqlMaybeToAliasInstance :: RecordInfo -> Q Dec
    makeSqlMaybeToAliasInstance RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = Name -> [(Name, Type)] -> Q Dec
    makeToAliasInstanceFor Name
    sqlMaybeName [(Name, Type)]
    sqlMaybeFields

    makeToAliasInstanceFor :: Name -> [(Name, Type)] -> Q Dec
    makeToAliasInstanceFor :: Name -> [(Name, Type)] -> Q Dec
    makeToAliasInstanceFor Name
    name [(Name, Type)]
    fields = do
      toAliasDec' <- Name -> [(Name, Type)] -> Q Dec
    toAliasDec Name
    name [(Name, Type)]
    fields
      let overlap = Maybe a
    forall a. Maybe a
    Nothing
          instanceConstraints = []
          instanceType = (Name -> Type
    ConT ''ToAlias) Type -> Type -> Type
    `AppT` (Name -> Type
    ConT Name
    name)
      pure $ InstanceD overlap instanceConstraints instanceType [toAliasDec']

    toAliasDec :: Name -> [(Name, Type)] -> Q Dec
    toAliasDec :: Name -> [(Name, Type)] -> Q Dec
    toAliasDec Name
    name [(Name, Type)]
    fields = do
      (statements, fieldPatterns, 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)]
    fields (\(Name
    fieldName', Type
    _) -> do
          fieldPatternName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
          boundValueName <- newName (nameBase fieldName')
          pure
            ( BindS
                (VarP boundValueName)
                (VarE 'toAlias `AppE` VarE fieldPatternName)
            , (fieldName', VarP fieldPatternName)
            , (fieldName', VarE boundValueName)
            ))

      pure $
        FunD
          'toAlias
          [ Clause
              [ RecP name fieldPatterns
              ]
              ( NormalB $
                  DoE
    #if MIN_VERSION_template_haskell(2,17,0)
                    Nothing
    #endif
                    (statements ++ [NoBindS $ AppE (VarE 'pure) (RecConE name fieldExps)])
              )
              -- `where` clause.
              []
          ]

    makeToAliasReferenceInstance :: RecordInfo -> Q Dec
    makeToAliasReferenceInstance :: RecordInfo -> Q Dec
    makeToAliasReferenceInstance RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = Name -> [(Name, Type)] -> Q Dec
    makeToAliasReferenceInstanceFor Name
    sqlName [(Name, Type)]
    sqlFields

    makeSqlMaybeToAliasReferenceInstance :: RecordInfo -> Q Dec
    makeSqlMaybeToAliasReferenceInstance :: RecordInfo -> Q Dec
    makeSqlMaybeToAliasReferenceInstance RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} =
      Name -> [(Name, Type)] -> Q Dec
    makeToAliasReferenceInstanceFor Name
    sqlMaybeName [(Name, Type)]
    sqlMaybeFields

    makeToAliasReferenceInstanceFor :: Name -> [(Name, Type)] -> Q Dec
    makeToAliasReferenceInstanceFor :: Name -> [(Name, Type)] -> Q Dec
    makeToAliasReferenceInstanceFor Name
    name [(Name, Type)]
    fields = do
      toAliasReferenceDec' <- Name -> [(Name, Type)] -> Q Dec
    toAliasReferenceDec Name
    name [(Name, Type)]
    fields
      let overlap = Maybe a
    forall a. Maybe a
    Nothing
          instanceConstraints = []
          instanceType = (Name -> Type
    ConT ''ToAliasReference) Type -> Type -> Type
    `AppT` (Name -> Type
    ConT Name
    name)
      pure $ InstanceD overlap instanceConstraints instanceType [toAliasReferenceDec']

    toAliasReferenceDec :: Name -> [(Name, Type)] -> Q Dec
    toAliasReferenceDec :: Name -> [(Name, Type)] -> Q Dec
    toAliasReferenceDec Name
    name [(Name, Type)]
    fields = do
      identInfo <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "identInfo"

      (statements, fieldPatterns, fieldExps) <-
        unzip3 <$> forM fields (\(Name
    fieldName', Type
    _) -> do
          fieldPatternName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
          boundValueName <- newName (nameBase fieldName')
          pure
            ( BindS
                (VarP boundValueName)
                (VarE 'toAliasReference `AppE` VarE identInfo `AppE` VarE fieldPatternName)
            , (fieldName', VarP fieldPatternName)
            , (fieldName', VarE boundValueName)
            ))

      pure $
        FunD
          'toAliasReference
          [ Clause
              [ VarP identInfo
              , RecP name fieldPatterns
              ]
              ( NormalB $
                  DoE
    #if MIN_VERSION_template_haskell(2,17,0)
                    Nothing
    #endif
                    (statements ++ [NoBindS $ AppE (VarE 'pure) (RecConE name fieldExps)])
              )
              -- `where` clause.
              []
          ]

    -- | Generates the declaration for an @SqlMaybe@-prefixed record, given the original
    -- record's information.
    makeSqlMaybeRecord :: RecordInfo -> Q Dec
    makeSqlMaybeRecord :: RecordInfo -> Q Dec
    makeSqlMaybeRecord  RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = do
      let newConstructor :: Con
    newConstructor = Name -> [VarBangType] -> Con
    RecC Name
    sqlMaybeConstructorName ((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)]
    sqlMaybeFields)
          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 BndrVis]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataD Cxt
    constraints Name
    sqlMaybeName [TyVarBndr BndrVis]
    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 a `ToMaybe` instance for the given record.
    makeToMaybeInstance :: RecordInfo -> Q Dec
    makeToMaybeInstance :: RecordInfo -> Q Dec
    makeToMaybeInstance info :: RecordInfo
    info@RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = do
      toMaybeTDec' <- Name -> Name -> Q [Dec]
    toMaybeTDec Name
    sqlName Name
    sqlMaybeName
      toMaybeDec' <- toMaybeDec info
      let overlap = Maybe a
    forall a. Maybe a
    Nothing
          instanceConstraints = []
          instanceType = (Name -> Type
    ConT ''ToMaybe) Type -> Type -> Type
    `AppT` (Name -> Type
    ConT Name
    sqlName)

      pure $ InstanceD overlap instanceConstraints instanceType (toMaybeTDec' ++ toMaybeDec')

    -- | Generates a `ToMaybe` instance for the SqlMaybe of the given record.
    makeSqlMaybeToMaybeInstance :: RecordInfo -> Q Dec
    makeSqlMaybeToMaybeInstance :: RecordInfo -> Q Dec
    makeSqlMaybeToMaybeInstance RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = do
      sqlMaybeToMaybeTDec' <- Name -> Name -> Q [Dec]
    toMaybeTDec Name
    sqlMaybeName Name
    sqlMaybeName
      let toMaybeIdDec = Name -> [Clause] -> Dec
    FunD 'toMaybe [ [Pat] -> Body -> [Dec] -> Clause
    Clause [] (Exp -> Body
    NormalB (Name -> Exp
    VarE 'id)) []]
          overlap = Maybe a
    forall a. Maybe a
    Nothing
          instanceConstraints = []
          instanceType = (Name -> Type
    ConT ''ToMaybe) Type -> Type -> Type
    `AppT` (Name -> Type
    ConT Name
    sqlMaybeName)
      pure $ InstanceD overlap instanceConstraints instanceType (toMaybeIdDec:sqlMaybeToMaybeTDec')

    -- | Generates a `type ToMaybeT ... = ...` declaration for the given names.
    toMaybeTDec :: Name -> Name -> Q [Dec]
    toMaybeTDec :: Name -> Name -> Q [Dec]
    toMaybeTDec Name
    nameLeft Name
    nameRight =
      [d| type instance ToMaybeT $(Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    nameLeft) = $(Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    nameRight) |]

    -- | Generates a `toMaybe value = ...` declaration for the given record.
    toMaybeDec :: RecordInfo -> Q [Dec]
    toMaybeDec :: RecordInfo -> Q [Dec]
    toMaybeDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = do
      (fieldPatterns, fieldExps) <-
        [(FieldPat, (Name, Exp))] -> ([FieldPat], [(Name, Exp)])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(FieldPat, (Name, Exp))] -> ([FieldPat], [(Name, Exp)]))
    -> Q [(FieldPat, (Name, Exp))] -> Q ([FieldPat], [(Name, Exp)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [((Name, Type), (Name, Type))]
    -> (((Name, Type), (Name, Type)) -> Q (FieldPat, (Name, Exp)))
    -> Q [(FieldPat, (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)]
    sqlFields [(Name, Type)]
    sqlMaybeFields) (\((Name
    fieldName', Type
    _), (Name
    maybeFieldName', Type
    _)) -> do
            fieldPatternName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
            pure
                ( (fieldName', VarP fieldPatternName)
                , (maybeFieldName', VarE 'toMaybe `AppE` VarE fieldPatternName)
                ))

      [d| $(varP 'toMaybe) = \ $(pure $ RecP sqlName fieldPatterns) ->
            $(pure $ RecConE sqlMaybeName fieldExps)
        |]

    -- | Generates an `SqlSelect` instance for the given record and its
    -- @Sql@-prefixed variant.
    makeSqlMaybeRecordSelectInstance :: RecordInfo -> Q Dec
    makeSqlMaybeRecordSelectInstance :: RecordInfo -> Q Dec
    makeSqlMaybeRecordSelectInstance info :: RecordInfo
    info@RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = do
      sqlSelectColsDec' <- RecordInfo -> Q [Dec]
    sqlMaybeSelectColsDec RecordInfo
    info
      sqlSelectColCountDec' <- sqlMaybeSelectColCountDec info
      sqlSelectProcessRowDec' <- sqlMaybeSelectProcessRowDec info
      let overlap = Maybe a
    forall a. Maybe a
    Nothing
          instanceConstraints = []
      instanceType <- [t| SqlSelect $(conT sqlMaybeName) (Maybe $(conT name)) |]
      pure $ InstanceD overlap instanceConstraints instanceType (sqlSelectColsDec' ++ sqlSelectColCountDec' ++ [sqlSelectProcessRowDec'])

    -- | Generates the `sqlSelectCols` declaration for an `SqlSelect` instance.
    sqlMaybeSelectColsDec :: RecordInfo -> Q [Dec]
    sqlMaybeSelectColsDec :: RecordInfo -> Q [Dec]
    sqlMaybeSelectColsDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = do
      -- Pairs of record field names and local variable names.
      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)]
    sqlMaybeFields (\(Name
    name', Type
    _type) -> do
        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'
        pure (name', var))

      -- Patterns binding record fields to local variables.
      let 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 =
            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

      identInfo <- newName "identInfo"
      [d| $(varP 'sqlSelectCols) = \ $(varP identInfo) $(pure $ RecP sqlMaybeName fieldPatterns) ->
            sqlSelectCols $(varE identInfo) $(pure joinedFields)
        |]

    -- | Generates the `sqlSelectProcessRow` declaration for an `SqlSelect`
    -- instance for a SqlMaybe.
    sqlMaybeSelectProcessRowDec :: RecordInfo -> Q Dec
    sqlMaybeSelectProcessRowDec :: RecordInfo -> Q Dec
    sqlMaybeSelectProcessRowDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(Name, Type)]
    ..} = do
      -- See sqlSelectProcessRowDec, which is similar but does not have special handling for Maybe
      (statements, 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)]
    sqlMaybeFields) (\((Name
    fieldName', Type
    fieldType), (Name
    _, Type
    sqlType')) -> do
          valueName <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Name -> String
    nameBase Name
    fieldName')
          pattern <- sqlSelectProcessRowPat fieldType valueName
          pure
            ( BindS
                pattern
                (AppTypeE (VarE 'takeColumns) sqlType')
            , (valueName, wrapJust fieldType $ VarE valueName)
            ))

      colsName <- newName "columns"
      processName <- newName "process"

      bodyExp <- [e|
        first (fromString ("Failed to parse " ++ $(lift $ nameBase sqlMaybeName) ++ ": ") <>)
              (evalStateT $(varE processName) $(varE colsName))
        |]

      pure $
        FunD
          'sqlSelectProcessRow
          [ Clause
              [VarP colsName]
              (NormalB bodyExp)
              -- `where`
              [ ValD
                  (VarP processName)
                  (NormalB $
                      DoE
    #if MIN_VERSION_template_haskell(2,17,0)
                        Nothing
    #endif
                        (statements ++ [
                          NoBindS $ AppE (VarE 'pure) (
                            CondE
                              (AppE
                                (VarE 'or)
                                (ListE $ fmap (\(Name
    n, Exp
    _) -> Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'isJust) (Name -> Exp
    VarE Name
    n)) fieldExps))
                              (case snd <$> fieldExps of
                                  [] -> Name -> Exp
    ConE Name
    constructorName
                                  Exp
    x:[Exp]
    xs ->  (Exp -> Exp -> Exp) -> Exp -> [Exp] -> 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
    a Exp
    b -> Maybe Exp -> Exp -> Maybe Exp -> Exp
    InfixE (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just Exp
    a) (Name -> Exp
    VarE '(<*>)) (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just Exp
    b))
                                    (Maybe Exp -> Exp -> Maybe Exp -> Exp
    InfixE (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    ConE Name
    constructorName) (Name -> Exp
    VarE '(<$>)) (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just Exp
    x))
                                    [Exp]
    xs)
                              (ConE 'Nothing)
                            )
                          ]
                        )
                  )
                  []
              ]
          ]
      where
        wrapJust :: Type -> Exp -> Exp
    wrapJust Type
    x = case Type
    x of
          ((ConT (Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ''Maybe -> Bool
    True)) `AppT` Type
    _inner) -> Exp -> Exp -> Exp
    AppE (Name -> Exp
    ConE 'Just)
          Type
    _ -> Exp -> Exp
    forall a. a -> a
    id

    -- | Generates the `sqlSelectColCount` declaration for an `SqlSelect` instance.
    sqlMaybeSelectColCountDec :: RecordInfo -> Q [Dec]
    sqlMaybeSelectColCountDec :: RecordInfo -> Q [Dec]
    sqlMaybeSelectColCountDec RecordInfo {Cxt
    [(Name, Type)]
    [TyVarBndr BndrVis]
    Maybe Type
    Name
    name :: RecordInfo -> Name
    sqlName :: RecordInfo -> Name
    sqlMaybeName :: RecordInfo -> Name
    constraints :: RecordInfo -> Cxt
    typeVarBinders :: RecordInfo -> [TyVarBndr BndrVis]
    kind :: RecordInfo -> Maybe Type
    constructorName :: RecordInfo -> Name
    sqlConstructorName :: RecordInfo -> Name
    sqlMaybeConstructorName :: RecordInfo -> Name
    fields :: RecordInfo -> [(Name, Type)]
    sqlFields :: RecordInfo -> [(Name, Type)]
    sqlMaybeFields :: RecordInfo -> [(Name, Type)]
    name :: Name
    sqlName :: Name
    sqlMaybeName :: Name
    constraints :: Cxt
    typeVarBinders :: [TyVarBndr BndrVis]
    kind :: Maybe Type
    constructorName :: Name
    sqlConstructorName :: Name
    sqlMaybeConstructorName :: Name
    fields :: [(Name, Type)]
    sqlFields :: [(Name, Type)]
    sqlMaybeFields :: [(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)]
    sqlMaybeFields 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

      [d| $(Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP 'sqlSelectColCount) = \_ -> sqlSelectColCount (Proxy @($(Type -> Q Type
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Type
    joinedTypes))) |]

    -- | 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`.
    takeMaybeColumns ::
      forall a b.
      (SqlSelect a (ToMaybeT b)) =>
      StateT [PersistValue] (Either Text) (ToMaybeT b)
    takeMaybeColumns :: forall a b.
    SqlSelect a (ToMaybeT b) =>
    StateT [PersistValue] (Either Text) (ToMaybeT b)
    takeMaybeColumns = ([PersistValue] -> Either Text (ToMaybeT b, [PersistValue]))
    -> StateT [PersistValue] (Either Text) (ToMaybeT 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
              value <- [PersistValue] -> Either Text (ToMaybeT b)
    forall a r. SqlSelect a r => [PersistValue] -> Either Text r
    sqlSelectProcessRow [PersistValue]
    target
              Right (value, other)
            else Text -> Either Text (ToMaybeT b, [PersistValue])
    forall a b. a -> Either a b
    Left Text
    "Insufficient columns when trying to parse a column")