    {-# LANGUAGE CPP #-}
    {-# LANGUAGE PatternGuards #-}
    #ifdef TRUSTWORTHY
    # if MIN_VERSION_template_haskell(2,12,0)
    {-# LANGUAGE Safe #-}
    # else
    {-# LANGUAGE Trustworthy #-}
    # endif
    #endif

    #ifndef MIN_VERSION_base
    #define MIN_VERSION_base(x,y,z) 1
    #endif

    #ifndef MIN_VERSION_template_haskell
    #define MIN_VERSION_template_haskell(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706)
    #endif
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Lens.TH
    -- Copyright   :  (C) 2012-16 Edward Kmett, 2012-13 Michael Sloan
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -----------------------------------------------------------------------------
    module Control.Lens.TH
      (
      -- * Constructing Lenses Automatically
      -- ** Lenses for data fields
        makeLenses, makeLensesFor
      , makeClassy, makeClassyFor, makeClassy_
      , makeFields
      , makeFieldsNoPrefix
      -- ** Prisms
      , makePrisms
      , makeClassyPrisms
      -- ** Wrapped
      , makeWrapped
      -- * Constructing Lenses Given a Declaration Quote
      -- ** Lenses for data fields
      , declareLenses, declareLensesFor
      , declareClassy, declareClassyFor
      , declareFields
      -- ** Prisms
      , declarePrisms
      -- ** Wrapped
      , declareWrapped
      -- * Configuring Lenses
      -- ** Running LensRules
      , makeLensesWith
      , declareLensesWith
      -- ** LensRules type
      , LensRules
      -- ** Predefined LensRules
      , lensRules
      , lensRulesFor
      , classyRules
      , classyRules_
      , defaultFieldRules
      , camelCaseFields
      , classUnderscoreNoPrefixFields
      , underscoreFields
      , abbreviatedFields
      -- ** LensRules configuration accessors
      , lensField
      , FieldNamer
      , DefName(..)
      , lensClass
      , ClassyNamer
      , simpleLenses
      , createClass
      , generateSignatures
      , generateUpdateableOptics
      , generateLazyPatterns
      -- ** FieldNamers
      , underscoreNoPrefixNamer
      , lookingupNamer
      , mappingNamer
      , camelCaseNamer
      , classUnderscoreNoPrefixNamer
      , underscoreNamer
      , abbreviatedNamer
      ) where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative
    #endif
    #if !(MIN_VERSION_template_haskell(2,7,0))
    import Control.Monad (ap)
    #endif
    import Control.Monad.Trans.Class
    import Control.Monad.Trans.State
    import Control.Monad.Trans.Writer
    import Control.Lens.Fold
    import Control.Lens.Getter
    import Control.Lens.Lens
    import Control.Lens.Setter
    import Control.Lens.Tuple
    import Control.Lens.Traversal
    import Control.Lens.Internal.TH
    import Control.Lens.Internal.FieldTH
    import Control.Lens.Internal.PrismTH
    import Control.Lens.Wrapped () -- haddocks
    import Control.Lens.Type () -- haddocks
    import Data.Char (toLower, toUpper, isUpper)
    import Data.Foldable hiding (concat, any)
    import Data.List as List
    import qualified Data.Map as Map
    import Data.Map (Map)
    import Data.Maybe (maybeToList)
    import Data.Monoid
    import qualified Data.Set as Set
    import Data.Set (Set)
    import Data.Set.Lens
    import Data.Traversable hiding (mapM)
    import Language.Haskell.TH
    import Language.Haskell.TH.Datatype
    import Language.Haskell.TH.Lens
    import Language.Haskell.TH.Syntax hiding (lift)

    #ifdef HLINT
    {-# ANN module "HLint: ignore Eta reduce" #-}
    {-# ANN module "HLint: ignore Use fewer imports" #-}
    {-# ANN module "HLint: ignore Use foldl" #-}
    #endif

    -- | Generate "simple" optics even when type-changing optics are possible.
    -- (e.g. 'Lens'' instead of 'Lens')
    simpleLenses :: Lens' LensRules Bool
    simpleLenses :: (Bool -> f Bool) -> LensRules -> f LensRules
    simpleLenses f :: Bool -> f Bool
    f r :: LensRules
    r = (Bool -> LensRules) -> f Bool -> f LensRules
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Bool
    x -> LensRules
    r { _simpleLenses :: Bool
    _simpleLenses = Bool
    x}) (Bool -> f Bool
    f (LensRules -> Bool
    _simpleLenses LensRules
    r))

    -- | Indicate whether or not to supply the signatures for the generated
    -- lenses.
    --
    -- Disabling this can be useful if you want to provide a more restricted type
    -- signature or if you want to supply hand-written haddocks.
    generateSignatures :: Lens' LensRules Bool
    generateSignatures :: (Bool -> f Bool) -> LensRules -> f LensRules
    generateSignatures f :: Bool -> f Bool
    f r :: LensRules
    r =
      (Bool -> LensRules) -> f Bool -> f LensRules
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Bool
    x -> LensRules
    r { _generateSigs :: Bool
    _generateSigs = Bool
    x}) (Bool -> f Bool
    f (LensRules -> Bool
    _generateSigs LensRules
    r))

    -- | Generate "updateable" optics when 'True'. When 'False', 'Fold's will be
    -- generated instead of 'Traversal's and 'Getter's will be generated instead
    -- of 'Lens'es. This mode is intended to be used for types with invariants
    -- which must be maintained by "smart" constructors.
    generateUpdateableOptics :: Lens' LensRules Bool
    generateUpdateableOptics :: (Bool -> f Bool) -> LensRules -> f LensRules
    generateUpdateableOptics f :: Bool -> f Bool
    f r :: LensRules
    r =
      (Bool -> LensRules) -> f Bool -> f LensRules
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Bool
    x -> LensRules
    r { _allowUpdates :: Bool
    _allowUpdates = Bool
    x}) (Bool -> f Bool
    f (LensRules -> Bool
    _allowUpdates LensRules
    r))

    -- | Generate optics using lazy pattern matches. This can
    -- allow fields of an undefined value to be initialized with lenses:
    --
    -- @
    -- data Foo = Foo {_x :: Int, _y :: Bool}
    --   deriving Show
    --
    -- 'makeLensesWith' ('lensRules' & 'generateLazyPatterns' .~ True) ''Foo
    -- @
    --
    -- @
    -- > undefined & x .~ 8 & y .~ True
    -- Foo {_x = 8, _y = True}
    -- @
    --
    -- The downside of this flag is that it can lead to space-leaks and
    -- code-size/compile-time increases when generated for large records. By
    -- default this flag is turned off, and strict optics are generated.
    --
    -- When using lazy optics the strict optic can be recovered by composing
    -- with '$!':
    --
    -- @
    -- strictOptic = ($!) . lazyOptic
    -- @
    generateLazyPatterns :: Lens' LensRules Bool
    generateLazyPatterns :: (Bool -> f Bool) -> LensRules -> f LensRules
    generateLazyPatterns f :: Bool -> f Bool
    f r :: LensRules
    r =
      (Bool -> LensRules) -> f Bool -> f LensRules
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Bool
    x -> LensRules
    r { _lazyPatterns :: Bool
    _lazyPatterns = Bool
    x}) (Bool -> f Bool
    f (LensRules -> Bool
    _lazyPatterns LensRules
    r))

    -- | Create the class if the constructor is 'Control.Lens.Type.Simple' and the
    -- 'lensClass' rule matches.
    createClass :: Lens' LensRules Bool
    createClass :: (Bool -> f Bool) -> LensRules -> f LensRules
    createClass f :: Bool -> f Bool
    f r :: LensRules
    r =
      (Bool -> LensRules) -> f Bool -> f LensRules
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Bool
    x -> LensRules
    r { _generateClasses :: Bool
    _generateClasses = Bool
    x}) (Bool -> f Bool
    f (LensRules -> Bool
    _generateClasses LensRules
    r))

    -- | 'Lens'' to access the convention for naming fields in our 'LensRules'.
    lensField :: Lens' LensRules FieldNamer
    lensField :: (FieldNamer -> f FieldNamer) -> LensRules -> f LensRules
    lensField f :: FieldNamer -> f FieldNamer
    f r :: LensRules
    r = (FieldNamer -> LensRules) -> f FieldNamer -> f LensRules
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: FieldNamer
    x -> LensRules
    r { _fieldToDef :: FieldNamer
    _fieldToDef = FieldNamer
    x}) (FieldNamer -> f FieldNamer
    f (LensRules -> FieldNamer
    _fieldToDef LensRules
    r))

    -- | 'Lens'' to access the option for naming "classy" lenses.
    lensClass :: Lens' LensRules ClassyNamer
    lensClass :: (ClassyNamer -> f ClassyNamer) -> LensRules -> f LensRules
    lensClass f :: ClassyNamer -> f ClassyNamer
    f r :: LensRules
    r = (ClassyNamer -> LensRules) -> f ClassyNamer -> f LensRules
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: ClassyNamer
    x -> LensRules
    r { _classyLenses :: ClassyNamer
    _classyLenses = ClassyNamer
    x }) (ClassyNamer -> f ClassyNamer
    f (LensRules -> ClassyNamer
    _classyLenses LensRules
    r))

    -- | Rules for making fairly simple partial lenses, ignoring the special cases
    -- for isomorphisms and traversals, and not making any classes.
    -- It uses 'underscoreNoPrefixNamer'.
    lensRules :: LensRules
    lensRules :: LensRules
    lensRules = LensRules :: Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> FieldNamer
    -> ClassyNamer
    -> LensRules
    LensRules
      { _simpleLenses :: Bool
    _simpleLenses    = Bool
    False
      , _generateSigs :: Bool
    _generateSigs    = Bool
    True
      , _generateClasses :: Bool
    _generateClasses = Bool
    False
      , _allowIsos :: Bool
    _allowIsos       = Bool
    True
      , _allowUpdates :: Bool
    _allowUpdates    = Bool
    True
      , _lazyPatterns :: Bool
    _lazyPatterns    = Bool
    False
      , _classyLenses :: ClassyNamer
    _classyLenses    = Maybe (Name, Name) -> ClassyNamer
    forall a b. a -> b -> a
    const Maybe (Name, Name)
    forall a. Maybe a
    Nothing
      , _fieldToDef :: FieldNamer
    _fieldToDef      = FieldNamer
    underscoreNoPrefixNamer
      }

    -- | A 'FieldNamer' that strips the _ off of the field name,
    -- lowercases the name, and skips the field if it doesn't start with
    -- an '_'.
    underscoreNoPrefixNamer :: FieldNamer
    underscoreNoPrefixNamer :: FieldNamer
    underscoreNoPrefixNamer _ _ n :: Name
    n =
      case Name -> String
    nameBase Name
    n of
        '_':x :: Char
    x:xs :: String
    xs -> [Name -> DefName
    TopName (String -> Name
    mkName (Char -> Char
    toLower Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    xs))]
        _        -> []

    -- | Construct a 'LensRules' value for generating top-level definitions
    -- using the given map from field names to definition names.
    lensRulesFor ::
      [(String, String)] {- ^ [(Field Name, Definition Name)] -} ->
      LensRules
    lensRulesFor :: [(String, String)] -> LensRules
    lensRulesFor fields :: [(String, String)]
    fields = LensRules
    lensRules LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (FieldNamer -> Identity FieldNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules FieldNamer
    lensField ((FieldNamer -> Identity FieldNamer)
     -> LensRules -> Identity LensRules)
    -> FieldNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ [(String, String)] -> FieldNamer
    lookingupNamer [(String, String)]
    fields

    -- | Create a 'FieldNamer' from explicit pairings of @(fieldName, lensName)@.
    lookingupNamer :: [(String,String)] -> FieldNamer
    lookingupNamer :: [(String, String)] -> FieldNamer
    lookingupNamer kvs :: [(String, String)]
    kvs _ _ field :: Name
    field =
      [ Name -> DefName
    TopName (String -> Name
    mkName String
    v) | (k :: String
    k,v :: String
    v) <- [(String, String)]
    kvs, String
    k String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> String
    nameBase Name
    field]

    -- | Create a 'FieldNamer' from a mapping function. If the function
    -- returns @[]@, it creates no lens for the field.
    mappingNamer :: (String -> [String]) -- ^ A function that maps a @fieldName@ to @lensName@s.
                 -> FieldNamer
    mappingNamer :: (String -> [String]) -> FieldNamer
    mappingNamer mapper :: String -> [String]
    mapper _ _ = (String -> DefName) -> [String] -> [DefName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Name -> DefName
    TopName (Name -> DefName) -> (String -> Name) -> String -> DefName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Name
    mkName) ([String] -> [DefName]) -> (Name -> [String]) -> Name -> [DefName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    mapper (String -> [String]) -> (Name -> String) -> Name -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase

    -- | Rules for making lenses and traversals that precompose another 'Lens'.
    classyRules :: LensRules
    classyRules :: LensRules
    classyRules = LensRules :: Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> FieldNamer
    -> ClassyNamer
    -> LensRules
    LensRules
      { _simpleLenses :: Bool
    _simpleLenses    = Bool
    True
      , _generateSigs :: Bool
    _generateSigs    = Bool
    True
      , _generateClasses :: Bool
    _generateClasses = Bool
    True
      , _allowIsos :: Bool
    _allowIsos       = Bool
    False -- generating Isos would hinder "subtyping"
      , _allowUpdates :: Bool
    _allowUpdates    = Bool
    True
      , _lazyPatterns :: Bool
    _lazyPatterns    = Bool
    False
      , _classyLenses :: ClassyNamer
    _classyLenses    = \n :: Name
    n ->
            case Name -> String
    nameBase Name
    n of
              x :: Char
    x:xs :: String
    xs -> (Name, Name) -> Maybe (Name, Name)
    forall a. a -> Maybe a
    Just (String -> Name
    mkName ("Has" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    xs), String -> Name
    mkName (Char -> Char
    toLower Char
    xChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    xs))
              []   -> Maybe (Name, Name)
    forall a. Maybe a
    Nothing
      , _fieldToDef :: FieldNamer
    _fieldToDef      = FieldNamer
    underscoreNoPrefixNamer
      }

    -- | Rules for making lenses and traversals that precompose another 'Lens'
    -- using a custom function for naming the class, main class method, and a
    -- mapping from field names to definition names.
    classyRulesFor
      :: (String -> Maybe (String, String)) {- ^ Type Name -> Maybe (Class Name, Method Name) -} ->
      [(String, String)] {- ^ [(Field Name, Method Name)] -} ->
      LensRules
    classyRulesFor :: (String -> Maybe (String, String))
    -> [(String, String)] -> LensRules
    classyRulesFor classFun :: String -> Maybe (String, String)
    classFun fields :: [(String, String)]
    fields = LensRules
    classyRules
      LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (ClassyNamer -> Identity ClassyNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules ClassyNamer
    lensClass ((ClassyNamer -> Identity ClassyNamer)
     -> LensRules -> Identity LensRules)
    -> ClassyNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ (ASetter (Maybe (String, String)) (Maybe (Name, Name)) String Name
    -> (String -> Name) -> Maybe (String, String) -> Maybe (Name, Name)
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over (((String, String) -> Identity (Name, Name))
    -> Maybe (String, String) -> Identity (Maybe (Name, Name))
    forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
    mapped (((String, String) -> Identity (Name, Name))
     -> Maybe (String, String) -> Identity (Maybe (Name, Name)))
    -> ((String -> Identity Name)
        -> (String, String) -> Identity (Name, Name))
    -> ASetter
         (Maybe (String, String)) (Maybe (Name, Name)) String Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Identity Name)
    -> (String, String) -> Identity (Name, Name)
    forall (r :: * -> * -> *) a b.
    Bitraversable r =>
    Traversal (r a a) (r b b) a b
    both) String -> Name
    mkName (Maybe (String, String) -> Maybe (Name, Name))
    -> (Name -> Maybe (String, String)) -> ClassyNamer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe (String, String)
    classFun (String -> Maybe (String, String))
    -> (Name -> String) -> Name -> Maybe (String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase)
      LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (FieldNamer -> Identity FieldNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules FieldNamer
    lensField ((FieldNamer -> Identity FieldNamer)
     -> LensRules -> Identity LensRules)
    -> FieldNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ [(String, String)] -> FieldNamer
    lookingupNamer [(String, String)]
    fields

    -- | A 'LensRules' used by 'makeClassy_'.
    classyRules_ :: LensRules
    classyRules_ :: LensRules
    classyRules_
      = LensRules
    classyRules LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (FieldNamer -> Identity FieldNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules FieldNamer
    lensField ((FieldNamer -> Identity FieldNamer)
     -> LensRules -> Identity LensRules)
    -> FieldNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ \_ _ n :: Name
    n -> [Name -> DefName
    TopName (String -> Name
    mkName ('_'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Name -> String
    nameBase Name
    n))]

    -- | Build lenses (and traversals) with a sensible default configuration.
    --
    -- /e.g./
    --
    -- @
    -- data FooBar
    --   = Foo { _x, _y :: 'Int' }
    --   | Bar { _x :: 'Int' }
    -- 'makeLenses' ''FooBar
    -- @
    --
    -- will create
    --
    -- @
    -- x :: 'Lens'' FooBar 'Int'
    -- x f (Foo a b) = (\\a\' -> Foo a\' b) \<$\> f a
    -- x f (Bar a)   = Bar \<$\> f a
    -- y :: 'Traversal'' FooBar 'Int'
    -- y f (Foo a b) = (\\b\' -> Foo a  b\') \<$\> f b
    -- y _ c\@(Bar _) = pure c
    -- @
    --
    -- @
    -- 'makeLenses' = 'makeLensesWith' 'lensRules'
    -- @
    makeLenses :: Name -> DecsQ
    makeLenses :: Name -> DecsQ
    makeLenses = LensRules -> Name -> DecsQ
    makeFieldOptics LensRules
    lensRules

    -- | Make lenses and traversals for a type, and create a class when the
    -- type has no arguments.
    --
    -- /e.g./
    --
    -- @
    -- data Foo = Foo { _fooX, _fooY :: 'Int' }
    -- 'makeClassy' ''Foo
    -- @
    --
    -- will create
    --
    -- @
    -- class HasFoo t where
    --   foo :: 'Lens'' t Foo
    --   fooX :: 'Lens'' t 'Int'
    --   fooX = foo . go where go f (Foo x y) = (\\x\' -> Foo x' y) \<$\> f x
    --   fooY :: 'Lens'' t 'Int'
    --   fooY = foo . go where go f (Foo x y) = (\\y\' -> Foo x y') \<$\> f y
    -- instance HasFoo Foo where
    --   foo = id
    -- @
    --
    -- @
    -- 'makeClassy' = 'makeLensesWith' 'classyRules'
    -- @
    makeClassy :: Name -> DecsQ
    makeClassy :: Name -> DecsQ
    makeClassy = LensRules -> Name -> DecsQ
    makeFieldOptics LensRules
    classyRules

    -- | Make lenses and traversals for a type, and create a class when the type
    -- has no arguments.  Works the same as 'makeClassy' except that (a) it
    -- expects that record field names do not begin with an underscore, (b) all
    -- record fields are made into lenses, and (c) the resulting lens is prefixed
    -- with an underscore.
    makeClassy_ :: Name -> DecsQ
    makeClassy_ :: Name -> DecsQ
    makeClassy_ = LensRules -> Name -> DecsQ
    makeFieldOptics LensRules
    classyRules_

    -- | Derive lenses and traversals, specifying explicit pairings
    -- of @(fieldName, lensName)@.
    --
    -- If you map multiple names to the same label, and it is present in the same
    -- constructor then this will generate a 'Traversal'.
    --
    -- /e.g./
    --
    -- @
    -- 'makeLensesFor' [(\"_foo\", \"fooLens\"), (\"baz\", \"lbaz\")] ''Foo
    -- 'makeLensesFor' [(\"_barX\", \"bar\"), (\"_barY\", \"bar\")] ''Bar
    -- @
    makeLensesFor :: [(String, String)] -> Name -> DecsQ
    makeLensesFor :: [(String, String)] -> Name -> DecsQ
    makeLensesFor fields :: [(String, String)]
    fields = LensRules -> Name -> DecsQ
    makeFieldOptics ([(String, String)] -> LensRules
    lensRulesFor [(String, String)]
    fields)

    -- | Derive lenses and traversals, using a named wrapper class, and
    -- specifying explicit pairings of @(fieldName, traversalName)@.
    --
    -- Example usage:
    --
    -- @
    -- 'makeClassyFor' \"HasFoo\" \"foo\" [(\"_foo\", \"fooLens\"), (\"bar\", \"lbar\")] ''Foo
    -- @
    makeClassyFor :: String -> String -> [(String, String)] -> Name -> DecsQ
    makeClassyFor :: String -> String -> [(String, String)] -> Name -> DecsQ
    makeClassyFor clsName :: String
    clsName funName :: String
    funName fields :: [(String, String)]
    fields = LensRules -> Name -> DecsQ
    makeFieldOptics (LensRules -> Name -> DecsQ) -> LensRules -> Name -> DecsQ
    forall a b. (a -> b) -> a -> b
    $
      (String -> Maybe (String, String))
    -> [(String, String)] -> LensRules
    classyRulesFor (Maybe (String, String) -> String -> Maybe (String, String)
    forall a b. a -> b -> a
    const ((String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (String
    clsName, String
    funName))) [(String, String)]
    fields

    -- | Build lenses with a custom configuration.
    makeLensesWith :: LensRules -> Name -> DecsQ
    makeLensesWith :: LensRules -> Name -> DecsQ
    makeLensesWith = LensRules -> Name -> DecsQ
    makeFieldOptics

    -- | Make lenses for all records in the given declaration quote. All record
    -- syntax in the input will be stripped off.
    --
    -- /e.g./
    --
    -- @
    -- declareLenses [d|
    --   data Foo = Foo { fooX, fooY :: 'Int' }
    --     deriving 'Show'
    --   |]
    -- @
    --
    -- will create
    --
    -- @
    -- data Foo = Foo 'Int' 'Int' deriving 'Show'
    -- fooX, fooY :: 'Lens'' Foo Int
    -- @
    declareLenses :: DecsQ -> DecsQ
    declareLenses :: DecsQ -> DecsQ
    declareLenses
      = LensRules -> DecsQ -> DecsQ
    declareLensesWith
      (LensRules -> DecsQ -> DecsQ) -> LensRules -> DecsQ -> DecsQ
    forall a b. (a -> b) -> a -> b
    $ LensRules
    lensRules
      LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (FieldNamer -> Identity FieldNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules FieldNamer
    lensField ((FieldNamer -> Identity FieldNamer)
     -> LensRules -> Identity LensRules)
    -> FieldNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ \_ _ n :: Name
    n -> [Name -> DefName
    TopName Name
    n]

    -- | Similar to 'makeLensesFor', but takes a declaration quote.
    declareLensesFor :: [(String, String)] -> DecsQ -> DecsQ
    declareLensesFor :: [(String, String)] -> DecsQ -> DecsQ
    declareLensesFor fields :: [(String, String)]
    fields
      = LensRules -> DecsQ -> DecsQ
    declareLensesWith
      (LensRules -> DecsQ -> DecsQ) -> LensRules -> DecsQ -> DecsQ
    forall a b. (a -> b) -> a -> b
    $ [(String, String)] -> LensRules
    lensRulesFor [(String, String)]
    fields
      LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (FieldNamer -> Identity FieldNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules FieldNamer
    lensField ((FieldNamer -> Identity FieldNamer)
     -> LensRules -> Identity LensRules)
    -> FieldNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ \_ _ n :: Name
    n -> [Name -> DefName
    TopName Name
    n]

    -- | For each record in the declaration quote, make lenses and traversals for
    -- it, and create a class when the type has no arguments. All record syntax
    -- in the input will be stripped off.
    --
    -- /e.g./
    --
    -- @
    -- declareClassy [d|
    --   data Foo = Foo { fooX, fooY :: 'Int' }
    --     deriving 'Show'
    --   |]
    -- @
    --
    -- will create
    --
    -- @
    -- data Foo = Foo 'Int' 'Int' deriving 'Show'
    -- class HasFoo t where
    --   foo :: 'Lens'' t Foo
    -- instance HasFoo Foo where foo = 'id'
    -- fooX, fooY :: HasFoo t => 'Lens'' t 'Int'
    -- @
    declareClassy :: DecsQ -> DecsQ
    declareClassy :: DecsQ -> DecsQ
    declareClassy
      = LensRules -> DecsQ -> DecsQ
    declareLensesWith
      (LensRules -> DecsQ -> DecsQ) -> LensRules -> DecsQ -> DecsQ
    forall a b. (a -> b) -> a -> b
    $ LensRules
    classyRules
      LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (FieldNamer -> Identity FieldNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules FieldNamer
    lensField ((FieldNamer -> Identity FieldNamer)
     -> LensRules -> Identity LensRules)
    -> FieldNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ \_ _ n :: Name
    n -> [Name -> DefName
    TopName Name
    n]

    -- | Similar to 'makeClassyFor', but takes a declaration quote.
    declareClassyFor ::
      [(String, (String, String))] -> [(String, String)] -> DecsQ -> DecsQ
    declareClassyFor :: [(String, (String, String))]
    -> [(String, String)] -> DecsQ -> DecsQ
    declareClassyFor classes :: [(String, (String, String))]
    classes fields :: [(String, String)]
    fields
      = LensRules -> DecsQ -> DecsQ
    declareLensesWith
      (LensRules -> DecsQ -> DecsQ) -> LensRules -> DecsQ -> DecsQ
    forall a b. (a -> b) -> a -> b
    $ (String -> Maybe (String, String))
    -> [(String, String)] -> LensRules
    classyRulesFor (String -> [(String, (String, String))] -> Maybe (String, String)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    `Prelude.lookup`[(String, (String, String))]
    classes) [(String, String)]
    fields
      LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (FieldNamer -> Identity FieldNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules FieldNamer
    lensField ((FieldNamer -> Identity FieldNamer)
     -> LensRules -> Identity LensRules)
    -> FieldNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ \_ _ n :: Name
    n -> [Name -> DefName
    TopName Name
    n]

    -- | Generate a 'Control.Lens.Type.Prism' for each constructor of each data type.
    --
    -- /e.g./
    --
    -- @
    -- declarePrisms [d|
    --   data Exp = Lit Int | Var String | Lambda{ bound::String, body::Exp }
    --   |]
    -- @
    --
    -- will create
    --
    -- @
    -- data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp }
    -- _Lit :: 'Prism'' Exp Int
    -- _Var :: 'Prism'' Exp String
    -- _Lambda :: 'Prism'' Exp (String, Exp)
    -- @
    declarePrisms :: DecsQ -> DecsQ
    declarePrisms :: DecsQ -> DecsQ
    declarePrisms = (Dec -> Declare Dec) -> DecsQ -> DecsQ
    declareWith ((Dec -> Declare Dec) -> DecsQ -> DecsQ)
    -> (Dec -> Declare Dec) -> DecsQ -> DecsQ
    forall a b. (a -> b) -> a -> b
    $ \dec :: Dec
    dec -> do
      [Dec] -> Declare ()
    emit ([Dec] -> Declare ())
    -> WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec] -> Declare ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< DecsQ -> WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec]
    forall a. Q a -> Declare a
    liftDeclare (Bool -> Dec -> DecsQ
    makeDecPrisms Bool
    True Dec
    dec)
      Dec -> Declare Dec
    forall (m :: * -> *) a. Monad m => a -> m a
    return Dec
    dec

    -- | Build 'Control.Lens.Wrapped.Wrapped' instance for each newtype.
    declareWrapped :: DecsQ -> DecsQ
    declareWrapped :: DecsQ -> DecsQ
    declareWrapped = (Dec -> Declare Dec) -> DecsQ -> DecsQ
    declareWith ((Dec -> Declare Dec) -> DecsQ -> DecsQ)
    -> (Dec -> Declare Dec) -> DecsQ -> DecsQ
    forall a b. (a -> b) -> a -> b
    $ \dec :: Dec
    dec -> do
      Maybe [Dec]
    maybeDecs <- Q (Maybe [Dec]) -> Declare (Maybe [Dec])
    forall a. Q a -> Declare a
    liftDeclare (Dec -> Q (Maybe [Dec])
    makeWrappedForDec Dec
    dec)
      Maybe [Dec] -> ([Dec] -> Declare ()) -> Declare ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Maybe [Dec]
    maybeDecs [Dec] -> Declare ()
    emit
      Dec -> Declare Dec
    forall (m :: * -> *) a. Monad m => a -> m a
    return Dec
    dec

    -- | @ declareFields = 'declareLensesWith' 'defaultFieldRules' @
    declareFields :: DecsQ -> DecsQ
    declareFields :: DecsQ -> DecsQ
    declareFields = LensRules -> DecsQ -> DecsQ
    declareLensesWith LensRules
    defaultFieldRules

    -- | Declare lenses for each records in the given declarations, using the
    -- specified 'LensRules'. Any record syntax in the input will be stripped
    -- off.
    declareLensesWith :: LensRules -> DecsQ -> DecsQ
    declareLensesWith :: LensRules -> DecsQ -> DecsQ
    declareLensesWith rules :: LensRules
    rules = (Dec -> Declare Dec) -> DecsQ -> DecsQ
    declareWith ((Dec -> Declare Dec) -> DecsQ -> DecsQ)
    -> (Dec -> Declare Dec) -> DecsQ -> DecsQ
    forall a b. (a -> b) -> a -> b
    $ \dec :: Dec
    dec -> do
      [Dec] -> Declare ()
    emit ([Dec] -> Declare ())
    -> WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec] -> Declare ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< StateT (Set Name) Q [Dec]
    -> WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (LensRules -> Dec -> StateT (Set Name) Q [Dec]
    makeFieldOpticsForDec' LensRules
    rules Dec
    dec)
      Dec -> Declare Dec
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Dec -> Declare Dec) -> Dec -> Declare Dec
    forall a b. (a -> b) -> a -> b
    $ Dec -> Dec
    stripFields Dec
    dec

    -----------------------------------------------------------------------------
    -- Internal TH Implementation
    -----------------------------------------------------------------------------

    -- | Transform @NewtypeD@s declarations to @DataD@s and @NewtypeInstD@s to
    -- @DataInstD@s.
    deNewtype :: Dec -> Dec
    #if MIN_VERSION_template_haskell(2,11,0)
    deNewtype :: Dec -> Dec
    deNewtype (NewtypeD ctx :: Cxt
    ctx tyName :: Name
    tyName args :: [TyVarBndr]
    args kind :: Maybe Kind
    kind c :: Con
    c d :: [DerivClause]
    d) = Cxt
    -> Name
    -> [TyVarBndr]
    -> Maybe Kind
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataD Cxt
    ctx Name
    tyName [TyVarBndr]
    args Maybe Kind
    kind [Con
    c] [DerivClause]
    d
    deNewtype (NewtypeInstD ctx :: Cxt
    ctx tyName :: Maybe [TyVarBndr]
    tyName args :: Kind
    args kind :: Maybe Kind
    kind c :: Con
    c d :: [DerivClause]
    d) = Cxt
    -> Maybe [TyVarBndr]
    -> Kind
    -> Maybe Kind
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataInstD Cxt
    ctx Maybe [TyVarBndr]
    tyName Kind
    args Maybe Kind
    kind [Con
    c] [DerivClause]
    d
    #else
    deNewtype (NewtypeD ctx tyName args c d) = DataD ctx tyName args [c] d
    deNewtype (NewtypeInstD ctx tyName args c d) = DataInstD ctx tyName args [c] d
    #endif
    deNewtype d :: Dec
    d = Dec
    d

    -- | Given a set of names, build a map from those names to a set of fresh names
    -- based on them.
    freshMap :: Set Name -> Q (Map Name Name)
    freshMap :: Set Name -> Q (Map Name Name)
    freshMap ns :: Set Name
    ns = [(Name, Name)] -> Map Name Name
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, Name)] -> Map Name Name)
    -> Q [(Name, Name)] -> Q (Map Name Name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Name] -> (Name -> Q (Name, Name)) -> Q [(Name, Name)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    t a -> (a -> f b) -> f (t b)
    for (Set Name -> [Name]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Set Name
    ns) (\ n :: Name
    n -> (,) Name
    n (Name -> (Name, Name)) -> Q Name -> Q (Name, Name)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Q Name
    newName (Name -> String
    nameBase Name
    n))

    apps :: Type -> [Type] -> Type
    apps :: Kind -> Cxt -> Kind
    apps = (Kind -> Kind -> Kind) -> Kind -> Cxt -> Kind
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    Prelude.foldl Kind -> Kind -> Kind
    AppT

    makeDataDecl :: Dec -> Maybe DataDecl
    makeDataDecl :: Dec -> Maybe DataDecl
    makeDataDecl dec :: Dec
    dec = case Dec -> Dec
    deNewtype Dec
    dec of
      DataD ctx :: Cxt
    ctx tyName :: Name
    tyName args :: [TyVarBndr]
    args
    #if MIN_VERSION_template_haskell(2,11,0)
            _
    #endif
            cons :: [Con]
    cons _ -> DataDecl -> Maybe DataDecl
    forall a. a -> Maybe a
    Just DataDecl :: Cxt
    -> Maybe Name -> [TyVarBndr] -> (Cxt -> Kind) -> [Con] -> DataDecl
    DataDecl
        { dataContext :: Cxt
    dataContext = Cxt
    ctx
        , tyConName :: Maybe Name
    tyConName = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    tyName
        , dataParameters :: [TyVarBndr]
    dataParameters = [TyVarBndr]
    args
        , fullType :: Cxt -> Kind
    fullType = Kind -> Cxt -> Kind
    apps (Kind -> Cxt -> Kind) -> Kind -> Cxt -> Kind
    forall a b. (a -> b) -> a -> b
    $ Name -> Kind
    ConT Name
    tyName
        , constructors :: [Con]
    constructors = [Con]
    cons
        }
    #if MIN_VERSION_template_haskell(2,15,0)
      DataInstD ctx :: Cxt
    ctx _ fnArgs :: Kind
    fnArgs _ cons :: [Con]
    cons _
    #else
      DataInstD ctx familyName args
    #if MIN_VERSION_template_haskell(2,11,0)
                _
    #endif
                cons _
    #endif
                        -> DataDecl -> Maybe DataDecl
    forall a. a -> Maybe a
    Just DataDecl :: Cxt
    -> Maybe Name -> [TyVarBndr] -> (Cxt -> Kind) -> [Con] -> DataDecl
    DataDecl
        { dataContext :: Cxt
    dataContext = Cxt
    ctx
        , tyConName :: Maybe Name
    tyConName = Maybe Name
    forall a. Maybe a
    Nothing
        , dataParameters :: [TyVarBndr]
    dataParameters = (Name -> TyVarBndr) -> [Name] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> TyVarBndr
    PlainTV [Name]
    vars
        , fullType :: Cxt -> Kind
    fullType = \tys :: Cxt
    tys -> Kind -> Cxt -> Kind
    apps (Name -> Kind
    ConT Name
    familyName) (Cxt -> Kind) -> Cxt -> Kind
    forall a b. (a -> b) -> a -> b
    $
            Map Name Kind -> Cxt -> Cxt
    forall t. SubstType t => Map Name Kind -> t -> t
    substType ([(Name, Kind)] -> Map Name Kind
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, Kind)] -> Map Name Kind)
    -> [(Name, Kind)] -> Map Name Kind
    forall a b. (a -> b) -> a -> b
    $ [Name] -> Cxt -> [(Name, Kind)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    vars Cxt
    tys) Cxt
    args
        , constructors :: [Con]
    constructors = [Con]
    cons
        }
        where
          -- The list of "type parameters" to a data family instance is not
          -- explicitly specified in the source. Here we define it to be
          -- the set of distinct type variables that appear in the LHS. e.g.
          --
          -- data instance F a Int (Maybe (a, b)) = G
          --
          -- has 2 type parameters: a and b.
          vars :: [Name]
    vars = Set Name -> [Name]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList (Set Name -> [Name]) -> Set Name -> [Name]
    forall a b. (a -> b) -> a -> b
    $ Getting (Set Name) Cxt Name -> Cxt -> Set Name
    forall a s. Getting (Set a) s a -> s -> Set a
    setOf Getting (Set Name) Cxt Name
    forall t. HasTypeVars t => Traversal' t Name
    typeVars Cxt
    args

    #if MIN_VERSION_template_haskell(2,15,0)
          (familyName :: Name
    familyName, args :: Cxt
    args) =
            case Kind -> (Kind, Cxt)
    unfoldType Kind
    fnArgs of
              (ConT familyName' :: Name
    familyName', args' :: Cxt
    args') -> (Name
    familyName', Cxt
    args')
              (_, _) -> String -> (Name, Cxt)
    forall a. HasCallStack => String -> a
    error (String -> (Name, Cxt)) -> String -> (Name, Cxt)
    forall a b. (a -> b) -> a -> b
    $ "Illegal data instance LHS: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Kind -> String
    forall a. Ppr a => a -> String
    pprint Kind
    fnArgs
    #endif
      _ -> Maybe DataDecl
    forall a. Maybe a
    Nothing

    -- | A data, newtype, data instance or newtype instance declaration.
    data DataDecl = DataDecl
      { DataDecl -> Cxt
    dataContext :: Cxt -- ^ Datatype context.
      , DataDecl -> Maybe Name
    tyConName :: Maybe Name
        -- ^ Type constructor name, or Nothing for a data family instance.
      , DataDecl -> [TyVarBndr]
    dataParameters :: [TyVarBndr] -- ^ List of type parameters
      , DataDecl -> Cxt -> Kind
    fullType :: [Type] -> Type
        -- ^ Create a concrete record type given a substitution to
        -- 'detaParameters'.
      , DataDecl -> [Con]
    constructors :: [Con] -- ^ Constructors
      -- , derivings :: [Name] -- currently not needed
      }

    -- | Build 'Wrapped' instance for a given newtype
    makeWrapped :: Name -> DecsQ
    makeWrapped :: Name -> DecsQ
    makeWrapped nm :: Name
    nm = do
      Info
    inf <- Name -> Q Info
    reify Name
    nm
      case Info
    inf of
        TyConI decl :: Dec
    decl -> do
          Maybe [Dec]
    maybeDecs <- Dec -> Q (Maybe [Dec])
    makeWrappedForDec Dec
    decl
          DecsQ -> ([Dec] -> DecsQ) -> Maybe [Dec] -> DecsQ
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> DecsQ
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "makeWrapped: Unsupported data type") [Dec] -> DecsQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Dec]
    maybeDecs
        _ -> String -> DecsQ
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "makeWrapped: Expected the name of a newtype or datatype"

    makeWrappedForDec :: Dec -> Q (Maybe [Dec])
    makeWrappedForDec :: Dec -> Q (Maybe [Dec])
    makeWrappedForDec decl :: Dec
    decl = case Dec -> Maybe DataDecl
    makeDataDecl Dec
    decl of
      Just dataDecl :: DataDecl
    dataDecl | [con :: Con
    con]   <- DataDecl -> [Con]
    constructors DataDecl
    dataDecl
                    , [field :: Kind
    field] <- Getting (Endo Cxt) Con Kind -> Con -> Cxt
    forall a s. Getting (Endo [a]) s a -> s -> [a]
    toListOf ((BangType -> Const (Endo Cxt) BangType)
    -> Con -> Const (Endo Cxt) Con
    Traversal' Con BangType
    conFields((BangType -> Const (Endo Cxt) BangType)
     -> Con -> Const (Endo Cxt) Con)
    -> ((Kind -> Const (Endo Cxt) Kind)
        -> BangType -> Const (Endo Cxt) BangType)
    -> Getting (Endo Cxt) Con Kind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Kind -> Const (Endo Cxt) Kind)
    -> BangType -> Const (Endo Cxt) BangType
    forall s t a b. Field2 s t a b => Lens s t a b
    _2) Con
    con
        -> do Dec
    wrapped   <- DataDecl -> Con -> Kind -> DecQ
    makeWrappedInstance DataDecl
    dataDecl Con
    con Kind
    field
              Dec
    rewrapped <- DataDecl -> DecQ
    makeRewrappedInstance DataDecl
    dataDecl
              Maybe [Dec] -> Q (Maybe [Dec])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Dec] -> Maybe [Dec]
    forall a. a -> Maybe a
    Just [Dec
    rewrapped, Dec
    wrapped])
      _ -> Maybe [Dec] -> Q (Maybe [Dec])
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Dec]
    forall a. Maybe a
    Nothing

    makeRewrappedInstance :: DataDecl -> DecQ
    makeRewrappedInstance :: DataDecl -> DecQ
    makeRewrappedInstance dataDecl :: DataDecl
    dataDecl = do

       TypeQ
    t <- Name -> TypeQ
    varT (Name -> TypeQ) -> Q Name -> Q TypeQ
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Q Name
    newName "t"

       let typeArgs :: [Name]
    typeArgs = (TyVarBndr -> Name) -> [TyVarBndr] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Getting Name TyVarBndr Name -> TyVarBndr -> Name
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting Name TyVarBndr Name
    forall t. HasName t => Lens' t Name
    name) (DataDecl -> [TyVarBndr]
    dataParameters DataDecl
    dataDecl)

       [Name]
    typeArgs' <- do
         Map Name Name
    m <- Set Name -> Q (Map Name Name)
    freshMap ([Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList [Name]
    typeArgs)
         [Name] -> Q [Name]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Name Name -> [Name] -> [Name]
    forall t. HasTypeVars t => Map Name Name -> t -> t
    substTypeVars Map Name Name
    m [Name]
    typeArgs)

           -- Con a b c...
       let appliedType :: TypeQ
    appliedType  = Kind -> TypeQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DataDecl -> Cxt -> Kind
    fullType DataDecl
    dataDecl ((Name -> Kind) -> [Name] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Kind
    VarT [Name]
    typeArgs))

           -- Con a' b' c'...
           appliedType' :: TypeQ
    appliedType' = Kind -> TypeQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DataDecl -> Cxt -> Kind
    fullType DataDecl
    dataDecl ((Name -> Kind) -> [Name] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Kind
    VarT [Name]
    typeArgs'))

           -- Con a' b' c'... ~ t
    #if MIN_VERSION_template_haskell(2,10,0)
           eq :: TypeQ
    eq = Kind -> Kind -> Kind
    AppT(Kind -> Kind -> Kind) -> (Kind -> Kind) -> Kind -> Kind -> Kind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Kind -> Kind -> Kind
    AppT Kind
    EqualityT (Kind -> Kind -> Kind) -> TypeQ -> Q (Kind -> Kind)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TypeQ
    appliedType' Q (Kind -> Kind) -> TypeQ -> TypeQ
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> TypeQ
    t
    #else
           eq = equalP appliedType' t
    #endif

           -- Rewrapped (Con a b c...) t
           klass :: TypeQ
    klass = Name -> TypeQ
    conT Name
    rewrappedTypeName TypeQ -> [TypeQ] -> TypeQ
    `appsT` [TypeQ
    appliedType, TypeQ
    t]

       -- instance (Con a' b' c'... ~ t) => Rewrapped (Con a b c...) t
       CxtQ -> TypeQ -> [DecQ] -> DecQ
    instanceD ([TypeQ] -> CxtQ
    cxt [TypeQ
    eq]) TypeQ
    klass []

    makeWrappedInstance :: DataDecl-> Con -> Type -> DecQ
    makeWrappedInstance :: DataDecl -> Con -> Kind -> DecQ
    makeWrappedInstance dataDecl :: DataDecl
    dataDecl con :: Con
    con fieldType :: Kind
    fieldType = do

      let conName :: Name
    conName = Getting Name Con Name -> Con -> Name
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting Name Con Name
    forall t. HasName t => Lens' t Name
    name Con
    con
      let typeArgs :: [Name]
    typeArgs = Getting (Endo [Name]) [TyVarBndr] Name -> [TyVarBndr] -> [Name]
    forall a s. Getting (Endo [a]) s a -> s -> [a]
    toListOf Getting (Endo [Name]) [TyVarBndr] Name
    forall t. HasTypeVars t => Traversal' t Name
    typeVars (DataDecl -> [TyVarBndr]
    dataParameters DataDecl
    dataDecl)

      -- Con a b c...
      let appliedType :: Kind
    appliedType  = DataDecl -> Cxt -> Kind
    fullType DataDecl
    dataDecl ((Name -> Kind) -> [Name] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Kind
    VarT [Name]
    typeArgs)

      -- type Unwrapped (Con a b c...) = $fieldType
      let unwrappedATF :: DecQ
    unwrappedATF = Name -> Maybe [Q TyVarBndr] -> [TypeQ] -> TypeQ -> DecQ
    tySynInstDCompat Name
    unwrappedTypeName Maybe [Q TyVarBndr]
    forall a. Maybe a
    Nothing
                           [Kind -> TypeQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Kind
    appliedType] (Kind -> TypeQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Kind
    fieldType)

      -- Wrapped (Con a b c...)
      let klass :: TypeQ
    klass        = Name -> TypeQ
    conT Name
    wrappedTypeName TypeQ -> TypeQ -> TypeQ
    `appT` Kind -> TypeQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Kind
    appliedType

      -- _Wrapped' = iso (\(Con x) -> x) Con
      let wrapFun :: ExpQ
    wrapFun      = Name -> ExpQ
    conE Name
    conName
      let unwrapFun :: ExpQ
    unwrapFun    = String -> Q Name
    newName "x" Q Name -> (Name -> ExpQ) -> ExpQ
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \x :: Name
    x -> PatQ -> ExpQ -> ExpQ
    lam1E (Name -> [PatQ] -> PatQ
    conP Name
    conName [Name -> PatQ
    varP Name
    x]) (Name -> ExpQ
    varE Name
    x)
      let body :: ExpQ
    body         = [ExpQ] -> ExpQ
    appsE [Name -> ExpQ
    varE Name
    isoValName, ExpQ
    unwrapFun, ExpQ
    wrapFun]
      let isoMethod :: DecQ
    isoMethod    = Name -> [ClauseQ] -> DecQ
    funD Name
    _wrapped'ValName [[PatQ] -> BodyQ -> [DecQ] -> ClauseQ
    clause [] (ExpQ -> BodyQ
    normalB ExpQ
    body) []]

      -- instance Wrapped (Con a b c...) where
      --   type Unwrapped (Con a b c...) = fieldType
      --   _Wrapped' = iso (\(Con x) -> x) Con
      CxtQ -> TypeQ -> [DecQ] -> DecQ
    instanceD ([TypeQ] -> CxtQ
    cxt []) TypeQ
    klass [DecQ
    unwrappedATF, DecQ
    isoMethod]

    #if !(MIN_VERSION_template_haskell(2,7,0))
    -- | The orphan instance for old versions is bad, but programming without 'Applicative' is worse.
    instance Applicative Q where
      pure = return
      (<*>) = ap
    #endif

    overHead :: (a -> a) -> [a] -> [a]
    overHead :: (a -> a) -> [a] -> [a]
    overHead _ []     = []
    overHead f :: a -> a
    f (x :: a
    x:xs :: [a]
    xs) = a -> a
    f a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    xs

    -- | Field rules for fields in the form @ _prefix_fieldname @
    underscoreFields :: LensRules
    underscoreFields :: LensRules
    underscoreFields = LensRules
    defaultFieldRules LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (FieldNamer -> Identity FieldNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules FieldNamer
    lensField ((FieldNamer -> Identity FieldNamer)
     -> LensRules -> Identity LensRules)
    -> FieldNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ FieldNamer
    underscoreNamer

    -- | A 'FieldNamer' for 'underscoreFields'.
    underscoreNamer :: FieldNamer
    underscoreNamer :: FieldNamer
    underscoreNamer _ _ field :: Name
    field = Maybe DefName -> [DefName]
    forall a. Maybe a -> [a]
    maybeToList (Maybe DefName -> [DefName]) -> Maybe DefName -> [DefName]
    forall a b. (a -> b) -> a -> b
    $ do
      String
    _      <- String -> Maybe String
    prefix String
    field'
      String
    method <- Maybe String
    niceLens
      String
    cls    <- Maybe String
    classNaming
      DefName -> Maybe DefName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Name -> DefName
    MethodName (String -> Name
    mkName String
    cls) (String -> Name
    mkName String
    method))
      where
        field' :: String
    field' = Name -> String
    nameBase Name
    field
        prefix :: String -> Maybe String
    prefix ('_':xs :: String
    xs) | '_' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `List.elem` String
    xs = String -> Maybe String
    forall a. a -> Maybe a
    Just ((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '_') String
    xs)
        prefix _                             = Maybe String
    forall a. Maybe a
    Nothing
        niceLens :: Maybe String
    niceLens    = String -> Maybe String
    prefix String
    field' Maybe String -> (String -> String) -> Maybe String
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> \n :: String
    n -> Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop (String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 2) String
    field'
        classNaming :: Maybe String
    classNaming = Maybe String
    niceLens Maybe String -> (String -> String) -> Maybe String
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> ("Has_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)

    -- | Field rules for fields in the form @ prefixFieldname or _prefixFieldname @
    -- If you want all fields to be lensed, then there is no reason to use an @_@ before the prefix.
    -- If any of the record fields leads with an @_@ then it is assume a field without an @_@ should not have a lens created.
    --
    -- __Note__: The @prefix@ must be the same as the typename (with the first
    -- letter lowercased). This is a change from lens versions before lens 4.5.
    -- If you want the old behaviour, use 'makeLensesWith' 'abbreviatedFields'
    camelCaseFields :: LensRules
    camelCaseFields :: LensRules
    camelCaseFields = LensRules
    defaultFieldRules

    -- | A 'FieldNamer' for 'camelCaseFields'.
    camelCaseNamer :: FieldNamer
    camelCaseNamer :: FieldNamer
    camelCaseNamer tyName :: Name
    tyName fields :: [Name]
    fields field :: Name
    field = Maybe DefName -> [DefName]
    forall a. Maybe a -> [a]
    maybeToList (Maybe DefName -> [DefName]) -> Maybe DefName -> [DefName]
    forall a b. (a -> b) -> a -> b
    $ do

      String
    fieldPart <- String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    expectedPrefix (Name -> String
    nameBase Name
    field)
      String
    method    <- String -> Maybe String
    computeMethod String
    fieldPart
      let cls :: String
    cls = "Has" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fieldPart
      DefName -> Maybe DefName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Name -> DefName
    MethodName (String -> Name
    mkName String
    cls) (String -> Name
    mkName String
    method))

      where
      expectedPrefix :: String
    expectedPrefix = String
    optUnderscore String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char -> Char) -> String -> String
    forall a. (a -> a) -> [a] -> [a]
    overHead Char -> Char
    toLower (Name -> String
    nameBase Name
    tyName)

      optUnderscore :: String
    optUnderscore  = ['_' | (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf "_" (String -> Bool) -> (Name -> String) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase) [Name]
    fields ]

      computeMethod :: String -> Maybe String
    computeMethod (x :: Char
    x:xs :: String
    xs) | Char -> Bool
    isUpper Char
    x = String -> Maybe String
    forall a. a -> Maybe a
    Just (Char -> Char
    toLower Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    xs)
      computeMethod _                  = Maybe String
    forall a. Maybe a
    Nothing

    -- | Field rules for fields in the form @ _fieldname @ (the leading
    -- underscore is mandatory).
    --
    -- __Note__: The primary difference to 'camelCaseFields' is that for
    -- @classUnderscoreNoPrefixFields@ the field names are not expected to
    -- be prefixed with the type name. This might be the desired behaviour
    -- when the @DuplicateRecordFields@ extension is enabled.
    classUnderscoreNoPrefixFields :: LensRules
    classUnderscoreNoPrefixFields :: LensRules
    classUnderscoreNoPrefixFields =
      LensRules
    defaultFieldRules LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & (FieldNamer -> Identity FieldNamer)
    -> LensRules -> Identity LensRules
    Lens' LensRules FieldNamer
    lensField ((FieldNamer -> Identity FieldNamer)
     -> LensRules -> Identity LensRules)
    -> FieldNamer -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ FieldNamer
    classUnderscoreNoPrefixNamer

    -- | A 'FieldNamer' for 'classUnderscoreNoPrefixFields'.
    classUnderscoreNoPrefixNamer :: FieldNamer
    classUnderscoreNoPrefixNamer :: FieldNamer
    classUnderscoreNoPrefixNamer _ _ field :: Name
    field = Maybe DefName -> [DefName]
    forall a. Maybe a -> [a]
    maybeToList (Maybe DefName -> [DefName]) -> Maybe DefName -> [DefName]
    forall a b. (a -> b) -> a -> b
    $ do
      String
    fieldUnprefixed <- String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix "_" (Name -> String
    nameBase Name
    field)
      let className :: String
    className  = "Has" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char -> Char) -> String -> String
    forall a. (a -> a) -> [a] -> [a]
    overHead Char -> Char
    toUpper String
    fieldUnprefixed
          methodName :: String
    methodName = String
    fieldUnprefixed
      DefName -> Maybe DefName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Name -> DefName
    MethodName (String -> Name
    mkName String
    className) (String -> Name
    mkName String
    methodName))

    -- | Field rules fields in the form @ prefixFieldname or _prefixFieldname @
    -- If you want all fields to be lensed, then there is no reason to use an @_@ before the prefix.
    -- If any of the record fields leads with an @_@ then it is assume a field without an @_@ should not have a lens created.
    --
    -- Note that @prefix@ may be any string of characters that are not uppercase
    -- letters. (In particular, it may be arbitrary string of lowercase letters
    -- and numbers) This is the behavior that 'defaultFieldRules' had in lens
    -- 4.4 and earlier.
    abbreviatedFields :: LensRules
    abbreviatedFields :: LensRules
    abbreviatedFields = LensRules
    defaultFieldRules { _fieldToDef :: FieldNamer
    _fieldToDef = FieldNamer
    abbreviatedNamer }

    -- | A 'FieldNamer' for 'abbreviatedFields'.
    abbreviatedNamer :: FieldNamer
    abbreviatedNamer :: FieldNamer
    abbreviatedNamer _ fields :: [Name]
    fields field :: Name
    field = Maybe DefName -> [DefName]
    forall a. Maybe a -> [a]
    maybeToList (Maybe DefName -> [DefName]) -> Maybe DefName -> [DefName]
    forall a b. (a -> b) -> a -> b
    $ do

      String
    fieldPart <- String -> Maybe String
    stripMaxLc (Name -> String
    nameBase Name
    field)
      String
    method    <- String -> Maybe String
    computeMethod String
    fieldPart
      let cls :: String
    cls = "Has" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fieldPart
      DefName -> Maybe DefName
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Name -> DefName
    MethodName (String -> Name
    mkName String
    cls) (String -> Name
    mkName String
    method))

      where
      stripMaxLc :: String -> Maybe String
    stripMaxLc f :: String
    f = do String
    x <- String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    optUnderscore String
    f
                        case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isUpper String
    x of
                          (p :: String
    p,s :: String
    s) | String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    List.null String
    p Bool -> Bool -> Bool
    || String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    List.null String
    s -> Maybe String
    forall a. Maybe a
    Nothing
                                | Bool
    otherwise                  -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s
      optUnderscore :: String
    optUnderscore  = ['_' | (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf "_" (String -> Bool) -> (Name -> String) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase) [Name]
    fields ]

      computeMethod :: String -> Maybe String
    computeMethod (x :: Char
    x:xs :: String
    xs) | Char -> Bool
    isUpper Char
    x = String -> Maybe String
    forall a. a -> Maybe a
    Just (Char -> Char
    toLower Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    xs)
      computeMethod _                  = Maybe String
    forall a. Maybe a
    Nothing

    -- | Generate overloaded field accessors.
    --
    -- /e.g/
    --
    -- @
    -- data Foo a = Foo { _fooX :: 'Int', _fooY :: a }
    -- newtype Bar = Bar { _barX :: 'Char' }
    -- makeFields ''Foo
    -- makeFields ''Bar
    -- @
    --
    -- will create
    --
    -- @
    -- _fooXLens :: Lens' (Foo a) Int
    -- _fooYLens :: Lens (Foo a) (Foo b) a b
    -- class HasX s a | s -> a where
    --   x :: Lens' s a
    -- instance HasX (Foo a) Int where
    --   x = _fooXLens
    -- class HasY s a | s -> a where
    --   y :: Lens' s a
    -- instance HasY (Foo a) a where
    --   y = _fooYLens
    -- _barXLens :: Iso' Bar Char
    -- instance HasX Bar Char where
    --   x = _barXLens
    -- @
    --
    -- For details, see 'camelCaseFields'.
    --
    -- @
    -- makeFields = 'makeLensesWith' 'defaultFieldRules'
    -- @
    makeFields :: Name -> DecsQ
    makeFields :: Name -> DecsQ
    makeFields = LensRules -> Name -> DecsQ
    makeFieldOptics LensRules
    camelCaseFields

    -- | Generate overloaded field accessors based on field names which
    -- are only prefixed with an underscore (e.g. '_name'), not
    -- additionally with the type name (e.g. '_fooName').
    --
    -- This might be the desired behaviour in case the
    -- @DuplicateRecordFields@ language extension is used in order to get
    -- rid of the necessity to prefix each field name with the type name.
    --
    -- As an example:
    --
    -- @
    -- data Foo a  = Foo { _x :: 'Int', _y :: a }
    -- newtype Bar = Bar { _x :: 'Char' }
    -- makeFieldsNoPrefix ''Foo
    -- makeFieldsNoPrefix ''Bar
    -- @
    --
    -- will create classes
    --
    -- @
    -- class HasX s a | s -> a where
    --   x :: Lens' s a
    -- class HasY s a | s -> a where
    --   y :: Lens' s a
    -- @
    --
    -- together with instances
    --
    -- @
    -- instance HasX (Foo a) Int
    -- instance HasY (Foo a) a where
    -- instance HasX Bar Char where
    -- @
    --
    -- For details, see 'classUnderscoreNoPrefixFields'.
    --
    -- @
    -- makeFieldsNoPrefix = 'makeLensesWith' 'classUnderscoreNoPrefixFields'
    -- @
    makeFieldsNoPrefix :: Name -> DecsQ
    makeFieldsNoPrefix :: Name -> DecsQ
    makeFieldsNoPrefix = LensRules -> Name -> DecsQ
    makeFieldOptics LensRules
    classUnderscoreNoPrefixFields

    defaultFieldRules :: LensRules
    defaultFieldRules :: LensRules
    defaultFieldRules = LensRules :: Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> FieldNamer
    -> ClassyNamer
    -> LensRules
    LensRules
      { _simpleLenses :: Bool
    _simpleLenses    = Bool
    True
      , _generateSigs :: Bool
    _generateSigs    = Bool
    True
      , _generateClasses :: Bool
    _generateClasses = Bool
    True  -- classes will still be skipped if they already exist
      , _allowIsos :: Bool
    _allowIsos       = Bool
    False -- generating Isos would hinder field class reuse
      , _allowUpdates :: Bool
    _allowUpdates    = Bool
    True
      , _lazyPatterns :: Bool
    _lazyPatterns    = Bool
    False
      , _classyLenses :: ClassyNamer
    _classyLenses    = Maybe (Name, Name) -> ClassyNamer
    forall a b. a -> b -> a
    const Maybe (Name, Name)
    forall a. Maybe a
    Nothing
      , _fieldToDef :: FieldNamer
    _fieldToDef      = FieldNamer
    camelCaseNamer
      }

    -- Declaration quote stuff

    declareWith :: (Dec -> Declare Dec) -> DecsQ -> DecsQ
    declareWith :: (Dec -> Declare Dec) -> DecsQ -> DecsQ
    declareWith fun :: Dec -> Declare Dec
    fun = (WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec] -> DecsQ
    runDeclare (WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec] -> DecsQ)
    -> ([Dec] -> WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec])
    -> [Dec]
    -> DecsQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Dec -> Declare Dec)
    -> [Dec] -> WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec]
    forall (f :: * -> *).
    Applicative f =>
    (Dec -> f Dec) -> [Dec] -> f [Dec]
    traverseDataAndNewtype Dec -> Declare Dec
    fun ([Dec] -> DecsQ) -> DecsQ -> DecsQ
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<)

    -- | Monad for emitting top-level declarations as a side effect. We also track
    -- the set of field class 'Name's that have been created and consult them to
    -- avoid creating duplicate classes.

    -- See #463 for more information.
    type Declare = WriterT (Endo [Dec]) (StateT (Set Name) Q)

    liftDeclare :: Q a -> Declare a
    liftDeclare :: Q a -> Declare a
    liftDeclare = StateT (Set Name) Q a -> Declare a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT (Set Name) Q a -> Declare a)
    -> (Q a -> StateT (Set Name) Q a) -> Q a -> Declare a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q a -> StateT (Set Name) Q a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift

    runDeclare :: Declare [Dec] -> DecsQ
    runDeclare :: WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec] -> DecsQ
    runDeclare dec :: WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec]
    dec = do
      (out :: [Dec]
    out, endo :: Endo [Dec]
    endo) <- StateT (Set Name) Q ([Dec], Endo [Dec])
    -> Set Name -> Q ([Dec], Endo [Dec])
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT (WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec]
    -> StateT (Set Name) Q ([Dec], Endo [Dec])
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    runWriterT WriterT (Endo [Dec]) (StateT (Set Name) Q) [Dec]
    dec) Set Name
    forall a. Set a
    Set.empty
      [Dec] -> DecsQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Dec] -> DecsQ) -> [Dec] -> DecsQ
    forall a b. (a -> b) -> a -> b
    $ [Dec]
    out [Dec] -> [Dec] -> [Dec]
    forall a. [a] -> [a] -> [a]
    ++ Endo [Dec] -> [Dec] -> [Dec]
    forall a. Endo a -> a -> a
    appEndo Endo [Dec]
    endo []

    emit :: [Dec] -> Declare ()
    emit :: [Dec] -> Declare ()
    emit decs :: [Dec]
    decs = Endo [Dec] -> Declare ()
    forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
    tell (Endo [Dec] -> Declare ()) -> Endo [Dec] -> Declare ()
    forall a b. (a -> b) -> a -> b
    $ ([Dec] -> [Dec]) -> Endo [Dec]
    forall a. (a -> a) -> Endo a
    Endo ([Dec]
    decs[Dec] -> [Dec] -> [Dec]
    forall a. [a] -> [a] -> [a]
    ++)

    -- | Traverse each data, newtype, data instance or newtype instance
    -- declaration.
    traverseDataAndNewtype :: (Applicative f) => (Dec -> f Dec) -> [Dec] -> f [Dec]
    traverseDataAndNewtype :: (Dec -> f Dec) -> [Dec] -> f [Dec]
    traverseDataAndNewtype f :: Dec -> f Dec
    f decs :: [Dec]
    decs = (Dec -> f Dec) -> [Dec] -> f [Dec]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Dec -> f Dec
    go [Dec]
    decs
      where
        go :: Dec -> f Dec
    go dec :: Dec
    dec = case Dec
    dec of
          DataD{} -> Dec -> f Dec
    f Dec
    dec
          NewtypeD{} -> Dec -> f Dec
    f Dec
    dec
          DataInstD{} -> Dec -> f Dec
    f Dec
    dec
          NewtypeInstD{} -> Dec -> f Dec
    f Dec
    dec

          -- Recurse into instance declarations because they main contain
          -- associated data family instances.
    #if MIN_VERSION_template_haskell(2,11,0)
          InstanceD moverlap :: Maybe Overlap
    moverlap ctx :: Cxt
    ctx inst :: Kind
    inst body :: [Dec]
    body -> Maybe Overlap -> Cxt -> Kind -> [Dec] -> Dec
    InstanceD Maybe Overlap
    moverlap Cxt
    ctx Kind
    inst ([Dec] -> Dec) -> f [Dec] -> f Dec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Dec -> f Dec) -> [Dec] -> f [Dec]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Dec -> f Dec
    go [Dec]
    body
    #else
          InstanceD ctx inst body -> InstanceD  ctx inst <$> traverse go body
    #endif
          _ -> Dec -> f Dec
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Dec
    dec

    stripFields :: Dec -> Dec
    stripFields :: Dec -> Dec
    stripFields dec :: Dec
    dec = case Dec
    dec of
    #if MIN_VERSION_template_haskell(2,11,0)
      DataD ctx :: Cxt
    ctx tyName :: Name
    tyName tyArgs :: [TyVarBndr]
    tyArgs kind :: Maybe Kind
    kind cons :: [Con]
    cons derivings :: [DerivClause]
    derivings ->
        Cxt
    -> Name
    -> [TyVarBndr]
    -> Maybe Kind
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataD Cxt
    ctx Name
    tyName [TyVarBndr]
    tyArgs Maybe Kind
    kind ((Con -> Con) -> [Con] -> [Con]
    forall a b. (a -> b) -> [a] -> [b]
    map Con -> Con
    deRecord [Con]
    cons) [DerivClause]
    derivings
      NewtypeD ctx :: Cxt
    ctx tyName :: Name
    tyName tyArgs :: [TyVarBndr]
    tyArgs kind :: Maybe Kind
    kind con :: Con
    con derivings :: [DerivClause]
    derivings ->
        Cxt
    -> Name -> [TyVarBndr] -> Maybe Kind -> Con -> [DerivClause] -> Dec
    NewtypeD Cxt
    ctx Name
    tyName [TyVarBndr]
    tyArgs Maybe Kind
    kind (Con -> Con
    deRecord Con
    con) [DerivClause]
    derivings
      DataInstD ctx :: Cxt
    ctx tyName :: Maybe [TyVarBndr]
    tyName tyArgs :: Kind
    tyArgs kind :: Maybe Kind
    kind cons :: [Con]
    cons derivings :: [DerivClause]
    derivings ->
        Cxt
    -> Maybe [TyVarBndr]
    -> Kind
    -> Maybe Kind
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataInstD Cxt
    ctx Maybe [TyVarBndr]
    tyName Kind
    tyArgs Maybe Kind
    kind ((Con -> Con) -> [Con] -> [Con]
    forall a b. (a -> b) -> [a] -> [b]
    map Con -> Con
    deRecord [Con]
    cons) [DerivClause]
    derivings
      NewtypeInstD ctx :: Cxt
    ctx tyName :: Maybe [TyVarBndr]
    tyName tyArgs :: Kind
    tyArgs kind :: Maybe Kind
    kind con :: Con
    con derivings :: [DerivClause]
    derivings ->
        Cxt
    -> Maybe [TyVarBndr]
    -> Kind
    -> Maybe Kind
    -> Con
    -> [DerivClause]
    -> Dec
    NewtypeInstD Cxt
    ctx Maybe [TyVarBndr]
    tyName Kind
    tyArgs Maybe Kind
    kind (Con -> Con
    deRecord Con
    con) [DerivClause]
    derivings
    #else
      DataD ctx tyName tyArgs cons derivings ->
        DataD ctx tyName tyArgs (map deRecord cons) derivings
      NewtypeD ctx tyName tyArgs con derivings ->
        NewtypeD ctx tyName tyArgs (deRecord con) derivings
      DataInstD ctx tyName tyArgs cons derivings ->
        DataInstD ctx tyName tyArgs (map deRecord cons) derivings
      NewtypeInstD ctx tyName tyArgs con derivings ->
        NewtypeInstD ctx tyName tyArgs (deRecord con) derivings
    #endif
      _ -> Dec
    dec

    deRecord :: Con -> Con
    deRecord :: Con -> Con
    deRecord con :: Con
    con@NormalC{} = Con
    con
    deRecord con :: Con
    con@InfixC{} = Con
    con
    deRecord (ForallC tyVars :: [TyVarBndr]
    tyVars ctx :: Cxt
    ctx con :: Con
    con) = [TyVarBndr] -> Cxt -> Con -> Con
    ForallC [TyVarBndr]
    tyVars Cxt
    ctx (Con -> Con) -> Con -> Con
    forall a b. (a -> b) -> a -> b
    $ Con -> Con
    deRecord Con
    con
    deRecord (RecC conName :: Name
    conName fields :: [VarBangType]
    fields) = Name -> [BangType] -> Con
    NormalC Name
    conName ((VarBangType -> BangType) -> [VarBangType] -> [BangType]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> BangType
    dropFieldName [VarBangType]
    fields)
    #if MIN_VERSION_template_haskell(2,11,0)
    deRecord con :: Con
    con@GadtC{} = Con
    con
    deRecord (RecGadtC ns :: [Name]
    ns fields :: [VarBangType]
    fields retTy :: Kind
    retTy) = [Name] -> [BangType] -> Kind -> Con
    GadtC [Name]
    ns ((VarBangType -> BangType) -> [VarBangType] -> [BangType]
    forall a b. (a -> b) -> [a] -> [b]
    map VarBangType -> BangType
    dropFieldName [VarBangType]
    fields) Kind
    retTy
    #endif

    #if MIN_VERSION_template_haskell(2,11,0)
    dropFieldName :: VarBangType   -> BangType
    #else
    dropFieldName :: VarStrictType -> StrictType
    #endif
    dropFieldName :: VarBangType -> BangType
    dropFieldName (_, str :: Bang
    str, typ :: Kind
    typ) = (Bang
    str, Kind
    typ)