    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE Trustworthy #-}

    #ifndef MIN_VERSION_template_haskell
    #define MIN_VERSION_template_haskell(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706)
    #endif

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

    #if __GLASGOW_HASKELL__ >= 800
    {-# LANGUAGE TemplateHaskellQuotes #-}
    #else
    {-# LANGUAGE TemplateHaskell #-}
    #endif

    {- |
    Module      :  Lens.Micro.TH
    Copyright   :  (C) 2013-2016 Eric Mertens, Edward Kmett, Artyom Kazak; 2018 Monadfix
    License     :  BSD-style (see the file LICENSE)
    -}
    module Lens.Micro.TH
    (
      -- * Dealing with “not in scope” errors
      -- $errors-note

      -- * Using this module in GHCi
      -- $ghci-note

      -- * 'SimpleGetter' and 'SimpleFold'
      -- $getter-fold-note

      -- * Generating lenses
      makeLenses,
      makeLensesFor,
      makeLensesWith,
      makeFields,
      makeClassy,

      -- * Default lens rules
      LensRules,
      DefName(..),
      lensRules,
      lensRulesFor,
      classyRules,
      camelCaseFields,
      abbreviatedFields,

      -- * Configuring lens rules
      lensField,
      lensClass,
      createClass,
      simpleLenses,
      generateSignatures,
      generateUpdateableOptics,
      generateLazyPatterns,
    )
    where

    import           Control.Monad
    import           Control.Monad.Trans.State
    import           Data.Char
    import           Data.Data
    import           Data.Either
    import qualified Data.Map as Map
    import           Data.Map (Map)
    import qualified Data.Set as Set
    import           Data.Set (Set)
    import           Data.List (nub, findIndices, stripPrefix, isPrefixOf)
    import           Data.Maybe
    import           Lens.Micro
    import           Lens.Micro.Internal (phantom)
    import           Lens.Micro.TH.Internal
    import           Language.Haskell.TH
    import qualified Language.Haskell.TH.Datatype as D

    #if __GLASGOW_HASKELL__ < 710
    import           Control.Applicative
    import           Data.Traversable (traverse, sequenceA)
    #endif

    {- $errors-note

    When you use Template Haskell, the order of declarations suddenly starts to matter. For instance, if you try to use 'makeLenses', 'makeFields', etc before the type is defined, you'll get a “not in scope” error:

    @
    'makeLenses' ''Foo

    data Foo = Foo {_foo :: Int}
    @

    @
    Not in scope: type constructor or class ‘Foo’ …
        In the Template Haskell quotation ''Foo
    @

    You can't refer to generated lenses before you call 'makeLenses', either:

    @
    data Foo = Foo {_foo :: Int}

    bar :: Lens' Foo Int
    bar = foo

    'makeLenses' ''Foo
    @

    @
    Not in scope: ‘foo’ …
        Perhaps you meant one of these:
          data constructor ‘Foo’ (line 1), ‘_foo’ (line 1)
    @
    -}

    {- $ghci-note

    You can use 'makeLenses' and friends to define lenses right from GHCi, but it's slightly tricky.

    First, enable Template Haskell:

    >>> :set -XTemplateHaskell

    Then define a bogus type (you can use any name in place of @M@, and you can use the same name many times), and follow the definition by the actual Template Haskell command you want to use:

    >>> data M; makeLenses ''Foo

    This will generate lenses for @Foo@ and you'll be able to use them from GHCi.

    If you want, you can define the type and lenses for it simultaneously with @:{@ and @:}@:

    @
    >>> :{
    data Foobar = Foobar {
      _foo :: Int,
      _bar :: Bool }
      deriving (Eq, Show)

    makeLenses ''Foobar
    :}
    @
    -}

    {- $getter-fold-note

    When updates are forbidden (by using 'generateUpdateableOptics'), or when a field simply can't be updated (for instance, in the presence of @forall@), instead of 'Lens' and 'Traversal' we generate 'SimpleGetter' and 'SimpleFold'. These aren't true @Getter@ and @Fold@ from lens, so beware. (Still, they're compatible, it's just that you can't do some things with them that you can do with original ones – for instance, @backwards@ and @takingWhile@ don't work on 'SimpleFold'.)

    If you want to export true folds, it's recommended that you depend on <http://hackage.haskell.org/package/microlens-contra microlens-contra>, use 'makeLensesFor' to generate 'SimpleFold's with prefixes, and then export versions of those folds with @<http://hackage.haskell.org/package/microlens-contra/docs/Lens-Micro-Contra.html#v:fromSimpleFold fromSimpleFold>@ applied.
    -}

    -- Utilities

    -- @fromSet@ wasn't always there, and we need compatibility with
    -- containers-0.4 to compile on GHC 7.4.
    fromSet :: (k -> v) -> Set.Set k -> Map.Map k v
    #if MIN_VERSION_containers(0,5,0)
    fromSet :: (k -> v) -> Set k -> Map k v
    fromSet = (k -> v) -> Set k -> Map k v
    forall k a. (k -> a) -> Set k -> Map k a
    Map.fromSet
    #else
    fromSet f x = Map.fromDistinctAscList [ (k,f k) | k <- Set.toAscList x ]
    #endif

    -- like 'rewrite' from uniplate
    rewrite :: (Data a, Data b) => (a -> Maybe a) -> b -> b
    rewrite :: (a -> Maybe a) -> b -> b
    rewrite f :: a -> Maybe a
    f mbA :: b
    mbA = case b -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast b
    mbA of
      Nothing -> (forall b. Data b => b -> b) -> b -> b
    forall a. Data a => (forall b. Data b => b -> b) -> a -> a
    gmapT ((a -> Maybe a) -> b -> b
    forall a b. (Data a, Data b) => (a -> Maybe a) -> b -> b
    rewrite a -> Maybe a
    f) b
    mbA
      Just a :: a
    a  -> let a' :: a
    a' = (forall b. Data b => b -> b) -> a -> a
    forall a. Data a => (forall b. Data b => b -> b) -> a -> a
    gmapT ((a -> Maybe a) -> b -> b
    forall a b. (Data a, Data b) => (a -> Maybe a) -> b -> b
    rewrite a -> Maybe a
    f) a
    a
                 in  Maybe b -> b
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe b -> b) -> (a -> Maybe b) -> a -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe b
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast (a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    a' (a -> Maybe a
    f a
    a')

    -- like 'children' from uniplate
    children :: Data a => a -> [a]
    children :: a -> [a]
    children = [Maybe a] -> [a]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe a] -> [a]) -> (a -> [Maybe a]) -> a -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall d. Data d => d -> Maybe a) -> a -> [Maybe a]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ forall d. Data d => d -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast

    -- Control.Lens.TH

    {- |
    Generate lenses for a data type or a newtype.

    To use it, you have to enable Template Haskell first:

    @
    \{\-\# LANGUAGE TemplateHaskell \#\-\}
    @

    Then, after declaring the datatype (let's say @Foo@), add @makeLenses ''Foo@ on a separate line (if you do it before the type is declared, you'll get a “not in scope” error – see the section at the top of this page):

    @
    data Foo = Foo {
      _x :: Int,
      _y :: Bool }

    'makeLenses' ''Foo
    @

    This would generate the following lenses, which can be used to access the fields of @Foo@:

    @
    x :: 'Lens'' Foo Int
    x f foo = (\\x' -> foo {_x = x'}) '<$>' f (_x foo)

    y :: 'Lens'' Foo Bool
    y f foo = (\\y' -> foo {_y = y'}) '<$>' f (_y foo)
    @

    (If you don't want a lens to be generated for some field, don't prefix it with “_”.)

    If you want to create lenses for many types, you can do it all in one place like this (of course, instead you just can use 'makeLenses' several times if you feel it would be more readable):

    @
    data Foo = ...
    data Bar = ...
    data Quux = ...

    'concat' '<$>' 'mapM' 'makeLenses' [''Foo, ''Bar, ''Quux]
    @

    When the data type has type parameters, it's possible for a lens to do a polymorphic update – i.e. change the type of the thing along with changing the type of the field. For instance, with this type

    @
    data Foo a = Foo {
      _x :: a,
      _y :: Bool }
    @

    the following lenses would be generated:

    @
    x :: 'Lens' (Foo a) (Foo b) a b
    y :: 'Lens'' (Foo a) Bool
    @

    However, when there are several fields using the same type parameter, type-changing updates are no longer possible:

    @
    data Foo a = Foo {
      _x :: a,
      _y :: a }
    @

    generates

    @
    x :: 'Lens'' (Foo a) a
    y :: 'Lens'' (Foo a) a
    @

    Finally, when the type has several constructors, some of fields may not be /always/ present – for those, a 'Traversal' is generated instead. For instance, in this example @y@ can be present or absent:

    @
    data FooBar
      = Foo { _x :: Int, _y :: Bool }
      | Bar { _x :: Int }
    @

    and the following accessors would be generated:

    @
    x :: 'Lens'' FooBar Int
    y :: 'Traversal'' FooBar Bool
    @

    So, to get @_y@, you'd have to either use ('^?') if you're not sure it's there, or ('^?!') if you're absolutely sure (and if you're wrong, you'll get an exception). Setting and updating @_y@ can be done as usual.
    -}
    makeLenses :: Name -> DecsQ
    makeLenses :: Name -> DecsQ
    makeLenses = LensRules -> Name -> DecsQ
    makeFieldOptics LensRules
    lensRules

    {- |
    Like 'makeLenses', but lets you choose your own names for lenses:

    @
    data Foo = Foo {foo :: Int, bar :: Bool}

    'makeLensesFor' [(\"foo\", \"fooLens\"), (\"bar\", \"_bar\")] ''Foo
    @

    would create lenses called @fooLens@ and @_bar@. This is useful, for instance, when you don't want to prefix your fields with underscores and want to prefix /lenses/ with underscores instead.

    If you give the same name to different fields, it will generate a 'Traversal' instead:

    @
    data Foo = Foo {slot1, slot2, slot3 :: Int}

    'makeLensesFor' [(\"slot1\", \"slots\"),
                   (\"slot2\", \"slots\"),
                   (\"slot3\", \"slots\")] ''Foo
    @

    would generate

    @
    slots :: 'Traversal'' Foo Int
    slots f foo = Foo '<$>' f (slot1 foo)
                      '<*>' f (slot2 foo)
                      '<*>' f (slot3 foo)
    @
    -}
    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)

    {- |
    Generate lenses with custom parameters.

    To see what exactly you can customise, look at the “Configuring lens rules” section. Usually you would build upon the 'lensRules' configuration, which is used by 'makeLenses':

    @
    'makeLenses' = 'makeLensesWith' 'lensRules'
    @

    Here's an example of generating lenses that would use lazy patterns:

    @
    data Foo = Foo {_x, _y :: Int}

    'makeLensesWith' ('lensRules' '&' 'generateLazyPatterns' '.~' True) ''Foo
    @

    When there are several modifications to the rules, the code looks nicer when you use 'flip':

    @
    'flip' 'makeLensesWith' ''Foo $
      'lensRules'
        '&' 'generateLazyPatterns' '.~' True
        '&' 'generateSignatures'   '.~' False
    @
    -}
    makeLensesWith :: LensRules -> Name -> DecsQ
    makeLensesWith :: LensRules -> Name -> DecsQ
    makeLensesWith = LensRules -> Name -> DecsQ
    makeFieldOptics

    {- |
    Generate overloaded lenses.

    This lets you deal with several data types having same fields. For instance, let's say you have @Foo@ and @Bar@, and both have a field named @x@. To avoid those fields clashing, you would have to use prefixes:

    @
    data Foo a = Foo {
      fooX :: Int,
      fooY :: a }

    data Bar = Bar {
      barX :: Char }
    @

    However, if you use 'makeFields' on both @Foo@ and @Bar@ now, it would generate lenses called @x@ and @y@ – and @x@ would be able to access both @fooX@ and @barX@! This is done by generating a separate class for each field, and making relevant types instances of that class:

    @
    class HasX s a | s -> a where
      x :: 'Lens'' s a

    instance HasX (Foo a) Int where
      x :: 'Lens'' (Foo a) Int
      x = ...

    instance HasX Bar Char where
      x :: 'Lens'' Bar Char
      x = ...

    class HasY s a | s -> a where
      y :: 'Lens'' s a

    instance HasY (Foo a) a where
      y :: 'Lens'' (Foo a) a
      y = ...
    @

    (There's a minor drawback, though: you can't perform type-changing updates with these lenses.)

    If you only want to make lenses for some fields, you can prefix them with underscores – the rest would be untouched. If no fields are prefixed with underscores, lenses would be created for all fields.

    The prefix must be the same as the name of the name of the data type (/not/ the constructor). If you don't like this behavior, use @'makeLensesWith' 'abbreviatedFields'@ – it allows any prefix (and even different prefixes).

    If you want to use 'makeFields' on types declared in different modules, you can do it, but then you would have to export the @Has*@ classes from one of the modules – 'makeFields' creates a class if it's not in scope yet, so the class must be in scope or else there would be duplicate classes and you would get an “Ambiguous occurrence” error.

    Finally, 'makeFields' is implemented as @'makeLensesWith' 'camelCaseFields'@, so you can build on 'camelCaseFields' if you want to customise behavior of 'makeFields'.
    -}
    makeFields :: Name -> DecsQ
    makeFields :: Name -> DecsQ
    makeFields = LensRules -> Name -> DecsQ
    makeFieldOptics LensRules
    camelCaseFields

    {- |
    Generate overloaded lenses without ad-hoc classes; useful when there's a collection of fields that you want to make common for several types.

    Like 'makeFields', each lens is a member of a class. However, the classes are per-type and not per-field. Let's take the following type:

    @
    data Person = Person {
      _name :: String,
      _age :: Double }
    @

    'makeClassy' would generate a single class with 3 methods:

    @
    class HasPerson c where
      person :: Lens' c Person

      age :: Lens' c Double
      age = person.age

      name :: Lens' c String
      name = person.name
    @

    And an instance:

    @
    instance HasPerson Person where
      person = id

      name = ...
      age = ...
    @

    So, you can use @name@ and @age@ to refer to the @_name@ and @_age@ fields, as usual. However, the extra lens – @person@ – allows you to do a kind of subtyping. Let's say that there's a type called @Worker@ and every worker has the same fields that a person has, but also a @job@. If you were using 'makeFields', you'd do the following:

    @
    data Worker = Worker {
      _workerName :: String,
      _workerAge :: Double,
      _workerJob :: String }
    @

    However, with 'makeClassy' you can say “every worker is a person” in a more principled way:

    @
    data Worker = Worker {
      _workerPerson :: Person,
      _job :: String }

    makeClassy ''Worker

    instance HasPerson Worker where person = workerPerson
    @

    Now you can use @age@ and @name@ to access name\/age of a @Worker@, but you also can use @person@ to “downgrade” a @Worker@ to a @Person@ (and e.g. apply some @Person@-specific function to it).

    Unlike 'makeFields', 'makeClassy' doesn't make use of prefixes. @_workerPerson@ could've just as well been named @_foobar@.

    'makeClassy' is implemented as @'makeLensesWith' 'classyRules'@, so you can build on 'classyRules' if you want to customise behavior of 'makeClassy'.
    -}
    makeClassy :: Name -> DecsQ
    makeClassy :: Name -> DecsQ
    makeClassy = LensRules -> Name -> DecsQ
    makeFieldOptics LensRules
    classyRules

    {- |
    Generate simple (monomorphic) lenses even when type-changing lenses are possible – i.e. 'Lens'' instead of 'Lens' and 'Traversal'' instead of 'Traversal'. Just in case, here's an example of a situation when type-changing lenses would be normally generated:

    @
    data Foo a = Foo { _foo :: a }
    @

    Generated lens:

    @
    foo :: 'Lens' (Foo a) (Foo b) a b
    @

    Generated lens with 'simpleLenses' turned on:

    @
    foo :: 'Lens'' (Foo a) a
    @

    This option is disabled by default.
    -}
    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))

    {- |
    Supply type signatures for the generated lenses.

    This option is enabled by default. Disable it if you want to write the signature by yourself – for instance, if the signature should be more restricted, or if you want to write haddocks for the lens (as haddocks are attached to the signature and not to the definition).
    -}
    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 turned off, 'SimpleFold's will be generated instead of 'Traversal's and 'SimpleGetter's will be generated instead of 'Lens'es.

    This option is enabled by default. Disabling it can be useful for types with invariants (also known as “types with smart constructors”) – if you generate updateable optics, anyone would be able to use them to break your invariants.
    -}
    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 lenses 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}
    @

    (Without 'generateLazyPatterns', the result would be just 'undefined'.)

    This option is disabled by default. The downside of enabling it is that it can lead to space-leaks and code-size\/compile-time increases when lenses are generated for large records.

    When you have a lazy lens, you can get a strict lens from it by composing with ('$!'):

    @
    strictLens = ('$!') . lazyLens
    @
    -}
    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))

    {- |
    This lets you choose which fields would have lenses generated for them and how would those lenses be called. To do that, you provide a function that would take a field name and output a list (possibly empty) of lenses that should be generated for that field.

    Here's the full type of the function you have to provide:

    @
    'Name' ->     -- The datatype lenses are being generated for
    ['Name'] ->   -- A list of all fields of the datatype
    'Name' ->     -- The current field
    ['DefName']   -- A list of lens names
    @

    Most of the time you won't need the first 2 parameters, but sometimes they are useful – for instance, the list of all fields would be useful if you wanted to implement a slightly more complicated rule like “if some fields are prefixed with underscores, generate lenses for them, but if no fields are prefixed with underscores, generate lenses for /all/ fields”.

    As an example, here's a function used by default. It strips “_” off the field name, lowercases the next character after “_”, and skips the field entirely if it doesn't start with “_”:

    @
    \\_ _ n ->
      case 'nameBase' n of
        \'_\':x:xs -> ['TopName' ('mkName' ('toLower' x : xs))]
        _        -> []
    @

    You can also generate classes (i.e. what 'makeFields' does) by using @'MethodName' className lensName@ instead of @'TopName' lensName@.
    -}
    lensField :: Lens' LensRules (Name -> [Name] -> Name -> [DefName])
    lensField :: ((Name -> [Name] -> Name -> [DefName])
     -> f (Name -> [Name] -> Name -> [DefName]))
    -> LensRules -> f LensRules
    lensField f :: (Name -> [Name] -> Name -> [DefName])
    -> f (Name -> [Name] -> Name -> [DefName])
    f r :: LensRules
    r = ((Name -> [Name] -> Name -> [DefName]) -> LensRules)
    -> f (Name -> [Name] -> Name -> [DefName]) -> f LensRules
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Name -> [Name] -> Name -> [DefName]
    x -> LensRules
    r { _fieldToDef :: Name -> [Name] -> Name -> [DefName]
    _fieldToDef = Name -> [Name] -> Name -> [DefName]
    x}) ((Name -> [Name] -> Name -> [DefName])
    -> f (Name -> [Name] -> Name -> [DefName])
    f (LensRules -> Name -> [Name] -> Name -> [DefName]
    _fieldToDef LensRules
    r))

    {- |
    This lets you choose whether a class would be generated for the type itself (like 'makeClassy' does). If so, you can choose the name of the class and the name of the type-specific lens.

    For 'makeLenses' and 'makeFields' this is just @const Nothing@. For 'makeClassy' this function is defined like this:

    @
    \\n ->
      case 'nameBase' n of
        x:xs -> Just ('mkName' ("Has" ++ x:xs), 'mkName' ('toLower' x : xs))
        []   -> Nothing
    @
    -}
    lensClass :: Lens' LensRules (Name -> Maybe (Name, Name))
    lensClass :: ((Name -> Maybe (Name, Name)) -> f (Name -> Maybe (Name, Name)))
    -> LensRules -> f LensRules
    lensClass f :: (Name -> Maybe (Name, Name)) -> f (Name -> Maybe (Name, Name))
    f r :: LensRules
    r = ((Name -> Maybe (Name, Name)) -> LensRules)
    -> f (Name -> Maybe (Name, Name)) -> f LensRules
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\x :: Name -> Maybe (Name, Name)
    x -> LensRules
    r { _classyLenses :: Name -> Maybe (Name, Name)
    _classyLenses = Name -> Maybe (Name, Name)
    x }) ((Name -> Maybe (Name, Name)) -> f (Name -> Maybe (Name, Name))
    f (LensRules -> Name -> Maybe (Name, Name)
    _classyLenses LensRules
    r))

    {- |
    Decide whether generation of classes is allowed at all.

    If this is disabled, neither 'makeFields' nor 'makeClassy' would work, regardless of values of 'lensField' or 'lensClass'. On the other hand, if 'lensField' and 'lensClass' don't generate any classes, enabling this won't have any effect.
    -}
    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 rules used by default (i.e. in 'makeLenses'):

    * 'generateSignatures' is turned on
    * 'generateUpdateableOptics' is turned on
    * 'generateLazyPatterns' is turned off
    * 'simpleLenses' is turned off
    * 'lensField' strips “_” off the field name, lowercases the next character after “_”, and skips the field entirely if it doesn't start with “_” (you can see how it's implemented in the docs for 'lensField')
    * 'lensClass' isn't used (i.e. defined as @const Nothing@)
    -}
    lensRules :: LensRules
    lensRules :: LensRules
    lensRules = LensRules :: Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> (Name -> [Name] -> Name -> [DefName])
    -> (Name -> Maybe (Name, Name))
    -> LensRules
    LensRules
      { _simpleLenses :: Bool
    _simpleLenses    = Bool
    False
      , _generateSigs :: Bool
    _generateSigs    = Bool
    True
      , _generateClasses :: Bool
    _generateClasses = Bool
    False
      -- , _allowIsos       = True
      , _allowUpdates :: Bool
    _allowUpdates    = Bool
    True
      , _lazyPatterns :: Bool
    _lazyPatterns    = Bool
    False
      , _classyLenses :: Name -> Maybe (Name, Name)
    _classyLenses    = Maybe (Name, Name) -> Name -> Maybe (Name, Name)
    forall a b. a -> b -> a
    const Maybe (Name, Name)
    forall a. Maybe a
    Nothing
      , _fieldToDef :: Name -> [Name] -> Name -> [DefName]
    _fieldToDef      = \_ _ 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))]
             _        -> []
      }

    {- |
    A modification of 'lensRules' used by 'makeLensesFor' (the only difference is that a simple lookup function is used for 'lensField').
    -}
    lensRulesFor
      :: [(String, String)] -- ^ @[(fieldName, lensName)]@
      -> LensRules
    lensRulesFor :: [(String, String)] -> LensRules
    lensRulesFor fields :: [(String, String)]
    fields = LensRules
    lensRules LensRules -> (LensRules -> LensRules) -> LensRules
    forall a b. a -> (a -> b) -> b
    & ((Name -> [Name] -> Name -> [DefName])
     -> Identity (Name -> [Name] -> Name -> [DefName]))
    -> LensRules -> Identity LensRules
    Lens' LensRules (Name -> [Name] -> Name -> [DefName])
    lensField (((Name -> [Name] -> Name -> [DefName])
      -> Identity (Name -> [Name] -> Name -> [DefName]))
     -> LensRules -> Identity LensRules)
    -> (Name -> [Name] -> Name -> [DefName]) -> LensRules -> LensRules
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ [(String, String)] -> Name -> [Name] -> Name -> [DefName]
    mkNameLookup [(String, String)]
    fields

    mkNameLookup :: [(String,String)] -> Name -> [Name] -> Name -> [DefName]
    mkNameLookup :: [(String, String)] -> Name -> [Name] -> Name -> [DefName]
    mkNameLookup 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]

    {- |
    Lens rules used by 'makeFields':

    * 'generateSignatures' is turned on
    * 'generateUpdateableOptics' is turned on
    * 'generateLazyPatterns' is turned off
    * 'simpleLenses' is turned on (unlike in 'lensRules')
    * 'lensField' is more complicated – it takes fields which are prefixed with the name of the type they belong to (e.g. “fooFieldName” for “Foo”), strips that prefix, and generates a class called “HasFieldName” with a single method called “fieldName”. If some fields are prefixed with underscores, underscores would be stripped too, but then fields without underscores won't have any lenses generated for them. Also note that e.g. “foolish” won't have a lens called “lish” generated for it – the prefix must be followed by a capital letter (or else it wouldn't be camel case).
    * 'lensClass' isn't used (i.e. defined as @const Nothing@)
    -}
    camelCaseFields :: LensRules
    camelCaseFields :: LensRules
    camelCaseFields = LensRules
    defaultFieldRules

    camelCaseNamer :: Name -> [Name] -> Name -> [DefName]
    camelCaseNamer :: Name -> [Name] -> Name -> [DefName]
    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]
    ++ ASetter String String Char Char
    -> (Char -> Char) -> String -> String
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ASetter String String Char Char
    forall s a. Cons s s a a => Traversal' s a
    _head 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

    {- |
    Like standard rules used by 'makeFields', but doesn't put any restrictions on the prefix. I.e. if you have fields called

    * @_fooBarBaz@
    * @_someX@
    * @someY@

    then the generated lenses would be called @barBaz@ and @x@.
    -}
    abbreviatedFields :: LensRules
    abbreviatedFields :: LensRules
    abbreviatedFields = LensRules
    defaultFieldRules { _fieldToDef :: Name -> [Name] -> Name -> [DefName]
    _fieldToDef = Name -> [Name] -> Name -> [DefName]
    abbreviatedNamer }

    abbreviatedNamer :: Name -> [Name] -> Name -> [DefName]
    abbreviatedNamer :: Name -> [Name] -> Name -> [DefName]
    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
    null String
    p Bool -> Bool -> Bool
    || String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    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

    defaultFieldRules :: LensRules
    defaultFieldRules :: LensRules
    defaultFieldRules = LensRules :: Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> (Name -> [Name] -> Name -> [DefName])
    -> (Name -> Maybe (Name, Name))
    -> 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       = False -- generating Isos would hinder field class reuse
      , _allowUpdates :: Bool
    _allowUpdates    = Bool
    True
      , _lazyPatterns :: Bool
    _lazyPatterns    = Bool
    False
      , _classyLenses :: Name -> Maybe (Name, Name)
    _classyLenses    = Maybe (Name, Name) -> Name -> Maybe (Name, Name)
    forall a b. a -> b -> a
    const Maybe (Name, Name)
    forall a. Maybe a
    Nothing
      , _fieldToDef :: Name -> [Name] -> Name -> [DefName]
    _fieldToDef      = Name -> [Name] -> Name -> [DefName]
    camelCaseNamer
      }

    underscoreNoPrefixNamer :: Name -> [Name] -> Name -> [DefName]
    underscoreNoPrefixNamer :: Name -> [Name] -> Name -> [DefName]
    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))]
        _        -> []

    {- |
    Lens rules used by 'makeClassy':

    * 'generateSignatures' is turned on
    * 'generateUpdateableOptics' is turned on
    * 'generateLazyPatterns' is turned off
    * 'simpleLenses' is turned on (unlike in 'lensRules')
    * 'lensField' is the same as in 'lensRules'
    * 'lensClass' just adds “Has” to the name of the type (so for “Person” the generated class would be called “HasPerson” and the type-specific lens in that class would be called “person”)
    -}
    classyRules :: LensRules
    classyRules :: LensRules
    classyRules = LensRules :: Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> (Name -> [Name] -> Name -> [DefName])
    -> (Name -> Maybe (Name, Name))
    -> LensRules
    LensRules
      { _simpleLenses :: Bool
    _simpleLenses    = Bool
    True
      , _generateSigs :: Bool
    _generateSigs    = Bool
    True
      , _generateClasses :: Bool
    _generateClasses = Bool
    True
      -- , _allowIsos       = False -- generating Isos would hinder "subtyping"
      , _allowUpdates :: Bool
    _allowUpdates    = Bool
    True
      , _lazyPatterns :: Bool
    _lazyPatterns    = Bool
    False
      , _classyLenses :: Name -> Maybe (Name, Name)
    _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 :: Name -> [Name] -> Name -> [DefName]
    _fieldToDef      = Name -> [Name] -> Name -> [DefName]
    underscoreNoPrefixNamer
      }

    -- FieldTH.hs

    ------------------------------------------------------------------------
    -- Field generation entry point
    ------------------------------------------------------------------------

    -- Compute the field optics for the type identified by the given type name.
    -- Lenses will be computed when possible, Traversals otherwise.
    makeFieldOptics :: LensRules -> Name -> DecsQ
    makeFieldOptics :: LensRules -> Name -> DecsQ
    makeFieldOptics rules :: LensRules
    rules = (StateT (Set Name) Q [Dec] -> Set Name -> DecsQ
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    `evalStateT` Set Name
    forall a. Set a
    Set.empty) (StateT (Set Name) Q [Dec] -> DecsQ)
    -> (DatatypeInfo -> StateT (Set Name) Q [Dec])
    -> DatatypeInfo
    -> DecsQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LensRules -> DatatypeInfo -> StateT (Set Name) Q [Dec]
    makeFieldOpticsForDatatype LensRules
    rules (DatatypeInfo -> DecsQ)
    -> (Name -> Q DatatypeInfo) -> Name -> DecsQ
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Name -> Q DatatypeInfo
    D.reifyDatatype

    type HasFieldClasses = StateT (Set Name) Q

    addFieldClassName :: Name -> HasFieldClasses ()
    addFieldClassName :: Name -> HasFieldClasses ()
    addFieldClassName n :: Name
    n = (Set Name -> Set Name) -> HasFieldClasses ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify ((Set Name -> Set Name) -> HasFieldClasses ())
    -> (Set Name -> Set Name) -> HasFieldClasses ()
    forall a b. (a -> b) -> a -> b
    $ Name -> Set Name -> Set Name
    forall a. Ord a => a -> Set a -> Set a
    Set.insert Name
    n

    -- | Compute the field optics for a deconstructed datatype Dec
    -- When possible build an Iso otherwise build one optic per field.
    makeFieldOpticsForDatatype :: LensRules -> D.DatatypeInfo -> HasFieldClasses [Dec]
    makeFieldOpticsForDatatype :: LensRules -> DatatypeInfo -> StateT (Set Name) Q [Dec]
    makeFieldOpticsForDatatype rules :: LensRules
    rules info :: DatatypeInfo
    info =
      do Map DefName (OpticType, OpticStab, [(Name, Int, [Int])])
    perDef <- Q (Map DefName (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> StateT
         (Set Name)
         Q
         (Map DefName (OpticType, OpticStab, [(Name, Int, [Int])]))
    forall (m :: * -> *) a s. Monad m => m a -> StateT s m a
    liftState (Q (Map DefName (OpticType, OpticStab, [(Name, Int, [Int])]))
     -> StateT
          (Set Name)
          Q
          (Map DefName (OpticType, OpticStab, [(Name, Int, [Int])])))
    -> Q (Map DefName (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> StateT
         (Set Name)
         Q
         (Map DefName (OpticType, OpticStab, [(Name, Int, [Int])]))
    forall a b. (a -> b) -> a -> b
    $ do
           [(Name, [(Maybe Name, Type)])]
    fieldCons <- (ConstructorInfo -> Q (Name, [(Maybe Name, Type)]))
    -> [ConstructorInfo] -> Q [(Name, [(Maybe Name, Type)])]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ConstructorInfo -> Q (Name, [(Maybe Name, Type)])
    normalizeConstructor [ConstructorInfo]
    cons
           let allFields :: [Name]
    allFields  = Getting (Endo [Name]) [(Name, [(Maybe Name, Type)])] Name
    -> [(Name, [(Maybe Name, Type)])] -> [Name]
    forall a s. Getting (Endo [a]) s a -> s -> [a]
    toListOf (Getting
      (Endo [Name])
      [(Name, [(Maybe Name, Type)])]
      (Name, [(Maybe Name, Type)])
    forall (f :: * -> *) a. Foldable f => SimpleFold (f a) a
    folded Getting
      (Endo [Name])
      [(Name, [(Maybe Name, Type)])]
      (Name, [(Maybe Name, Type)])
    -> ((Name -> Const (Endo [Name]) Name)
        -> (Name, [(Maybe Name, Type)])
        -> Const (Endo [Name]) (Name, [(Maybe Name, Type)]))
    -> Getting (Endo [Name]) [(Name, [(Maybe Name, Type)])] Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(Maybe Name, Type)] -> Const (Endo [Name]) [(Maybe Name, Type)])
    -> (Name, [(Maybe Name, Type)])
    -> Const (Endo [Name]) (Name, [(Maybe Name, Type)])
    forall s t a b. Field2 s t a b => Lens s t a b
    _2 (([(Maybe Name, Type)] -> Const (Endo [Name]) [(Maybe Name, Type)])
     -> (Name, [(Maybe Name, Type)])
     -> Const (Endo [Name]) (Name, [(Maybe Name, Type)]))
    -> ((Name -> Const (Endo [Name]) Name)
        -> [(Maybe Name, Type)]
        -> Const (Endo [Name]) [(Maybe Name, Type)])
    -> (Name -> Const (Endo [Name]) Name)
    -> (Name, [(Maybe Name, Type)])
    -> Const (Endo [Name]) (Name, [(Maybe Name, Type)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Getting (Endo [Name]) [(Maybe Name, Type)] (Maybe Name, Type)
    forall (f :: * -> *) a. Foldable f => SimpleFold (f a) a
    folded Getting (Endo [Name]) [(Maybe Name, Type)] (Maybe Name, Type)
    -> ((Name -> Const (Endo [Name]) Name)
        -> (Maybe Name, Type) -> Const (Endo [Name]) (Maybe Name, Type))
    -> (Name -> Const (Endo [Name]) Name)
    -> [(Maybe Name, Type)]
    -> Const (Endo [Name]) [(Maybe Name, Type)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe Name -> Const (Endo [Name]) (Maybe Name))
    -> (Maybe Name, Type) -> Const (Endo [Name]) (Maybe Name, Type)
    forall s t a b. Field1 s t a b => Lens s t a b
    _1 ((Maybe Name -> Const (Endo [Name]) (Maybe Name))
     -> (Maybe Name, Type) -> Const (Endo [Name]) (Maybe Name, Type))
    -> ((Name -> Const (Endo [Name]) Name)
        -> Maybe Name -> Const (Endo [Name]) (Maybe Name))
    -> (Name -> Const (Endo [Name]) Name)
    -> (Maybe Name, Type)
    -> Const (Endo [Name]) (Maybe Name, Type)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name -> Const (Endo [Name]) Name)
    -> Maybe Name -> Const (Endo [Name]) (Maybe Name)
    forall (f :: * -> *) a. Foldable f => SimpleFold (f a) a
    folded) [(Name, [(Maybe Name, Type)])]
    fieldCons
           let defCons :: [(Name, [([DefName], Type)])]
    defCons    = ASetter
      [(Name, [(Maybe Name, Type)])]
      [(Name, [([DefName], Type)])]
      (Maybe Name)
      [DefName]
    -> (Maybe Name -> [DefName])
    -> [(Name, [(Maybe Name, Type)])]
    -> [(Name, [([DefName], Type)])]
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ASetter
      [(Name, [(Maybe Name, Type)])]
      [(Name, [([DefName], Type)])]
      (Maybe Name)
      [DefName]
    forall a b.
    Traversal [(Name, [(a, Type)])] [(Name, [(b, Type)])] a b
    normFieldLabels ([Name] -> Maybe Name -> [DefName]
    expandName [Name]
    allFields) [(Name, [(Maybe Name, Type)])]
    fieldCons
               allDefs :: Set DefName
    allDefs    = Getting (Endo [DefName]) [(Name, [([DefName], Type)])] DefName
    -> [(Name, [([DefName], Type)])] -> Set DefName
    forall a s. Ord a => Getting (Endo [a]) s a -> s -> Set a
    setOf (([DefName] -> Const (Endo [DefName]) [DefName])
    -> [(Name, [([DefName], Type)])]
    -> Const (Endo [DefName]) [(Name, [([DefName], Type)])]
    forall a b.
    Traversal [(Name, [(a, Type)])] [(Name, [(b, Type)])] a b
    normFieldLabels (([DefName] -> Const (Endo [DefName]) [DefName])
     -> [(Name, [([DefName], Type)])]
     -> Const (Endo [DefName]) [(Name, [([DefName], Type)])])
    -> ((DefName -> Const (Endo [DefName]) DefName)
        -> [DefName] -> Const (Endo [DefName]) [DefName])
    -> Getting (Endo [DefName]) [(Name, [([DefName], Type)])] DefName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DefName -> Const (Endo [DefName]) DefName)
    -> [DefName] -> Const (Endo [DefName]) [DefName]
    forall (f :: * -> *) a. Foldable f => SimpleFold (f a) a
    folded) [(Name, [([DefName], Type)])]
    defCons
           Map DefName (Q (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> Q (Map DefName (OpticType, OpticStab, [(Name, Int, [Int])]))
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    sequenceA ((DefName -> Q (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> Set DefName
    -> Map DefName (Q (OpticType, OpticStab, [(Name, Int, [Int])]))
    forall k a. (k -> a) -> Set k -> Map k a
    fromSet (LensRules
    -> Type
    -> [(Name, [([DefName], Type)])]
    -> DefName
    -> Q (OpticType, OpticStab, [(Name, Int, [Int])])
    buildScaffold LensRules
    rules Type
    s [(Name, [([DefName], Type)])]
    defCons) Set DefName
    allDefs)

         let defs :: [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs = Map DefName (OpticType, OpticStab, [(Name, Int, [Int])])
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map DefName (OpticType, OpticStab, [(Name, Int, [Int])])
    perDef
         case LensRules -> Name -> Maybe (Name, Name)
    _classyLenses LensRules
    rules Name
    tyName of
           Just (className :: Name
    className, methodName :: Name
    methodName) ->
             LensRules
    -> Name
    -> Name
    -> Type
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    -> StateT (Set Name) Q [Dec]
    makeClassyDriver LensRules
    rules Name
    className Name
    methodName Type
    s [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs
           Nothing -> do [[Dec]]
    decss <- ((DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
     -> StateT (Set Name) Q [Dec])
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    -> StateT (Set Name) Q [[Dec]]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (LensRules
    -> (DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> StateT (Set Name) Q [Dec]
    makeFieldOptic LensRules
    rules) [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs
                         [Dec] -> StateT (Set Name) Q [Dec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Dec]] -> [Dec]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Dec]]
    decss)

      where
      tyName :: Name
    tyName = DatatypeInfo -> Name
    D.datatypeName DatatypeInfo
    info
      s :: Type
    s      = DatatypeInfo -> Type
    D.datatypeType DatatypeInfo
    info
      cons :: [ConstructorInfo]
    cons   = DatatypeInfo -> [ConstructorInfo]
    D.datatypeCons DatatypeInfo
    info

      -- Traverse the field labels of a normalized constructor
      normFieldLabels :: Traversal [(Name,[(a,Type)])] [(Name,[(b,Type)])] a b
      normFieldLabels :: (a -> f b) -> [(Name, [(a, Type)])] -> f [(Name, [(b, Type)])]
    normFieldLabels = ((Name, [(a, Type)]) -> f (Name, [(b, Type)]))
    -> [(Name, [(a, Type)])] -> f [(Name, [(b, Type)])]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (((Name, [(a, Type)]) -> f (Name, [(b, Type)]))
     -> [(Name, [(a, Type)])] -> f [(Name, [(b, Type)])])
    -> ((a -> f b) -> (Name, [(a, Type)]) -> f (Name, [(b, Type)]))
    -> (a -> f b)
    -> [(Name, [(a, Type)])]
    -> f [(Name, [(b, Type)])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(a, Type)] -> f [(b, Type)])
    -> (Name, [(a, Type)]) -> f (Name, [(b, Type)])
    forall s t a b. Field2 s t a b => Lens s t a b
    _2 (([(a, Type)] -> f [(b, Type)])
     -> (Name, [(a, Type)]) -> f (Name, [(b, Type)]))
    -> ((a -> f b) -> [(a, Type)] -> f [(b, Type)])
    -> (a -> f b)
    -> (Name, [(a, Type)])
    -> f (Name, [(b, Type)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, Type) -> f (b, Type)) -> [(a, Type)] -> f [(b, Type)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (((a, Type) -> f (b, Type)) -> [(a, Type)] -> f [(b, Type)])
    -> ((a -> f b) -> (a, Type) -> f (b, Type))
    -> (a -> f b)
    -> [(a, Type)]
    -> f [(b, Type)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> f b) -> (a, Type) -> f (b, Type)
    forall s t a b. Field1 s t a b => Lens s t a b
    _1

      -- Map a (possibly missing) field's name to zero-to-many optic definitions
      expandName :: [Name] -> Maybe Name -> [DefName]
      expandName :: [Name] -> Maybe Name -> [DefName]
    expandName allFields :: [Name]
    allFields = (Name -> [DefName]) -> [Name] -> [DefName]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (LensRules -> Name -> [Name] -> Name -> [DefName]
    _fieldToDef LensRules
    rules Name
    tyName [Name]
    allFields) ([Name] -> [DefName])
    -> (Maybe Name -> [Name]) -> Maybe Name -> [DefName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Name -> [Name]
    forall a. Maybe a -> [a]
    maybeToList

    normalizeConstructor ::
      D.ConstructorInfo ->
      Q (Name, [(Maybe Name, Type)]) -- ^ constructor name, field name, field type

    normalizeConstructor :: ConstructorInfo -> Q (Name, [(Maybe Name, Type)])
    normalizeConstructor con :: ConstructorInfo
    con =
      (Name, [(Maybe Name, Type)]) -> Q (Name, [(Maybe Name, Type)])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConstructorInfo -> Name
    D.constructorName ConstructorInfo
    con,
              (Maybe Name -> Type -> (Maybe Name, Type))
    -> [Maybe Name] -> [Type] -> [(Maybe Name, Type)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Maybe Name -> Type -> (Maybe Name, Type)
    forall s a. HasTypeVars s => Maybe a -> s -> (Maybe a, s)
    checkForExistentials [Maybe Name]
    fieldNames (ConstructorInfo -> [Type]
    D.constructorFields ConstructorInfo
    con))
      where
        fieldNames :: [Maybe Name]
    fieldNames =
          case ConstructorInfo -> ConstructorVariant
    D.constructorVariant ConstructorInfo
    con of
            D.RecordConstructor xs :: [Name]
    xs -> (Name -> Maybe Name) -> [Name] -> [Maybe Name]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Name -> Maybe Name
    forall a. a -> Maybe a
    Just [Name]
    xs
            D.NormalConstructor    -> Maybe Name -> [Maybe Name]
    forall a. a -> [a]
    repeat Maybe Name
    forall a. Maybe a
    Nothing
            D.InfixConstructor     -> Maybe Name -> [Maybe Name]
    forall a. a -> [a]
    repeat Maybe Name
    forall a. Maybe a
    Nothing

        -- Fields mentioning existentially quantified types are not
        -- elligible for TH generated optics.
        checkForExistentials :: Maybe a -> s -> (Maybe a, s)
    checkForExistentials _ fieldtype :: s
    fieldtype
          | (TyVarBndr -> Bool) -> [TyVarBndr] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\tv :: TyVarBndr
    tv -> TyVarBndr -> Name
    D.tvName TyVarBndr
    tv Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set Name
    used) [TyVarBndr]
    unallowable
          = (Maybe a
    forall a. Maybe a
    Nothing, s
    fieldtype)
          where
            used :: Set Name
    used        = Getting (Endo [Name]) s Name -> s -> Set Name
    forall a s. Ord a => Getting (Endo [a]) s a -> s -> Set a
    setOf Getting (Endo [Name]) s Name
    forall t. HasTypeVars t => Traversal' t Name
    typeVars s
    fieldtype
            unallowable :: [TyVarBndr]
    unallowable = ConstructorInfo -> [TyVarBndr]
    D.constructorVars ConstructorInfo
    con
        checkForExistentials fieldname :: Maybe a
    fieldname fieldtype :: s
    fieldtype = (Maybe a
    fieldname, s
    fieldtype)

    makeClassyDriver ::
      LensRules ->
      Name ->
      Name ->
      Type {- ^ Outer 's' type -} ->
      [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->
      HasFieldClasses [Dec]
    makeClassyDriver :: LensRules
    -> Name
    -> Name
    -> Type
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    -> StateT (Set Name) Q [Dec]
    makeClassyDriver rules :: LensRules
    rules className :: Name
    className methodName :: Name
    methodName s :: Type
    s defs :: [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs = [StateT (Set Name) Q Dec] -> StateT (Set Name) Q [Dec]
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    sequenceA ([StateT (Set Name) Q Dec]
    forall s. [StateT s Q Dec]
    cls [StateT (Set Name) Q Dec]
    -> [StateT (Set Name) Q Dec] -> [StateT (Set Name) Q Dec]
    forall a. [a] -> [a] -> [a]
    ++ [StateT (Set Name) Q Dec]
    inst)

      where
      cls :: [StateT s Q Dec]
    cls | LensRules -> Bool
    _generateClasses LensRules
    rules = [Q Dec -> StateT s Q Dec
    forall (m :: * -> *) a s. Monad m => m a -> StateT s m a
    liftState (Q Dec -> StateT s Q Dec) -> Q Dec -> StateT s Q Dec
    forall a b. (a -> b) -> a -> b
    $ Name
    -> Name
    -> Type
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    -> Q Dec
    makeClassyClass Name
    className Name
    methodName Type
    s [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs]
          | Bool
    otherwise = []

      inst :: [StateT (Set Name) Q Dec]
    inst = [LensRules
    -> Name
    -> Name
    -> Type
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    -> StateT (Set Name) Q Dec
    makeClassyInstance LensRules
    rules Name
    className Name
    methodName Type
    s [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs]

    makeClassyClass ::
      Name ->
      Name ->
      Type {- ^ Outer 's' type -} ->
      [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->
      DecQ
    makeClassyClass :: Name
    -> Name
    -> Type
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    -> Q Dec
    makeClassyClass className :: Name
    className methodName :: Name
    methodName s :: Type
    s defs :: [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs = do
      let ss :: [Type]
    ss   = ((DefName, (OpticType, OpticStab, [(Name, Int, [Int])])) -> Type)
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (OpticStab -> Type
    stabToS (OpticStab -> Type)
    -> ((DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
        -> OpticStab)
    -> (DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> Getting
         OpticStab
         (DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
         OpticStab
    -> OpticStab
    forall s a. s -> Getting a s a -> a
    ^. ((OpticType, OpticStab, [(Name, Int, [Int])])
     -> Const OpticStab (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> (DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> Const
         OpticStab (DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
    forall s t a b. Field2 s t a b => Lens s t a b
    _2(((OpticType, OpticStab, [(Name, Int, [Int])])
      -> Const OpticStab (OpticType, OpticStab, [(Name, Int, [Int])]))
     -> (DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
     -> Const
          OpticStab (DefName, (OpticType, OpticStab, [(Name, Int, [Int])])))
    -> ((OpticStab -> Const OpticStab OpticStab)
        -> (OpticType, OpticStab, [(Name, Int, [Int])])
        -> Const OpticStab (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> Getting
         OpticStab
         (DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
         OpticStab
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(OpticStab -> Const OpticStab OpticStab)
    -> (OpticType, OpticStab, [(Name, Int, [Int])])
    -> Const OpticStab (OpticType, OpticStab, [(Name, Int, [Int])])
    forall s t a b. Field2 s t a b => Lens s t a b
    _2)) [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs
      (sub :: Map Name Type
    sub,s' :: Type
    s') <- [Type] -> Q (Map Name Type, Type)
    unifyTypes (Type
    s Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : [Type]
    ss)
      Name
    c <- String -> Q Name
    newName "c"
      let vars :: [Name]
    vars = Getting (Endo [Name]) Type Name -> Type -> [Name]
    forall a s. Getting (Endo [a]) s a -> s -> [a]
    toListOf Getting (Endo [Name]) Type Name
    forall t. HasTypeVars t => Traversal' t Name
    typeVars Type
    s'
          fd :: [FunDep]
    fd   | [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    vars = []
               | Bool
    otherwise = [[Name] -> [Name] -> FunDep
    FunDep [Name
    c] [Name]
    vars]

      CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [Q Dec] -> Q Dec
    classD ([PredQ] -> CxtQ
    cxt[]) Name
    className ((Name -> TyVarBndr) -> [Name] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> TyVarBndr
    PlainTV (Name
    cName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :[Name]
    vars)) [FunDep]
    fd
        ([Q Dec] -> Q Dec) -> [Q Dec] -> Q Dec
    forall a b. (a -> b) -> a -> b
    $ Name -> PredQ -> Q Dec
    sigD Name
    methodName (Type -> PredQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return (''Lens' Name -> [Type] -> Type
    `conAppsT` [Name -> Type
    VarT Name
    c, Type
    s']))
        Q Dec -> [Q Dec] -> [Q Dec]
    forall a. a -> [a] -> [a]
    : [[Q Dec]] -> [Q Dec]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          [ [Name -> PredQ -> Q Dec
    sigD Name
    defName (Type -> PredQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    ty)
            ,PatQ -> BodyQ -> [Q Dec] -> Q Dec
    valD (Name -> PatQ
    varP Name
    defName) (ExpQ -> BodyQ
    normalB ExpQ
    body) []
            ] [Q Dec] -> [Q Dec] -> [Q Dec]
    forall a. [a] -> [a] -> [a]
    ++
            Name -> [Q Dec]
    inlinePragma Name
    defName
          | (TopName defName :: Name
    defName, (_, stab :: OpticStab
    stab, _)) <- [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs
          , let body :: ExpQ
    body = [ExpQ] -> ExpQ
    appsE [Name -> ExpQ
    varE '(.), Name -> ExpQ
    varE Name
    methodName, Name -> ExpQ
    varE Name
    defName]
          , let ty :: Type
    ty   = Set Name -> [Type] -> Type -> Type
    quantifyType' ([Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList (Name
    cName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :[Name]
    vars))
                                     (OpticStab -> [Type]
    stabToContext OpticStab
    stab)
                     (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ OpticStab -> Name
    stabToOptic OpticStab
    stab Name -> [Type] -> Type
    `conAppsT`
                           [Name -> Type
    VarT Name
    c, Map Name Type -> Type -> Type
    applyTypeSubst Map Name Type
    sub (OpticStab -> Type
    stabToA OpticStab
    stab)]
          ]

    makeClassyInstance ::
      LensRules ->
      Name ->
      Name ->
      Type {- ^ Outer 's' type -} ->
      [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->
      HasFieldClasses Dec
    makeClassyInstance :: LensRules
    -> Name
    -> Name
    -> Type
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    -> StateT (Set Name) Q Dec
    makeClassyInstance rules :: LensRules
    rules className :: Name
    className methodName :: Name
    methodName s :: Type
    s defs :: [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs = do
      [[Dec]]
    methodss <- ((DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
     -> StateT (Set Name) Q [Dec])
    -> [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    -> StateT (Set Name) Q [[Dec]]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (LensRules
    -> (DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> StateT (Set Name) Q [Dec]
    makeFieldOptic LensRules
    rules') [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))]
    defs

      Q Dec -> StateT (Set Name) Q Dec
    forall (m :: * -> *) a s. Monad m => m a -> StateT s m a
    liftState (Q Dec -> StateT (Set Name) Q Dec)
    -> Q Dec -> StateT (Set Name) Q Dec
    forall a b. (a -> b) -> a -> b
    $ CxtQ -> PredQ -> [Q Dec] -> Q Dec
    instanceD ([PredQ] -> CxtQ
    cxt[]) (Type -> PredQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    instanceHead)
        ([Q Dec] -> Q Dec) -> [Q Dec] -> Q Dec
    forall a b. (a -> b) -> a -> b
    $ PatQ -> BodyQ -> [Q Dec] -> Q Dec
    valD (Name -> PatQ
    varP Name
    methodName) (ExpQ -> BodyQ
    normalB (Name -> ExpQ
    varE 'id)) []
        Q Dec -> [Q Dec] -> [Q Dec]
    forall a. a -> [a] -> [a]
    : (Dec -> Q Dec) -> [Dec] -> [Q Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map Dec -> Q Dec
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Dec]] -> [Dec]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Dec]]
    methodss)

      where
      instanceHead :: Type
    instanceHead = Name
    className Name -> [Type] -> Type
    `conAppsT` (Type
    s Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    : (Name -> Type) -> [Name] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Type
    VarT [Name]
    vars)
      vars :: [Name]
    vars         = Getting (Endo [Name]) Type Name -> Type -> [Name]
    forall a s. Getting (Endo [a]) s a -> s -> [a]
    toListOf Getting (Endo [Name]) Type Name
    forall t. HasTypeVars t => Traversal' t Name
    typeVars Type
    s
      rules' :: LensRules
    rules'       = LensRules
    rules { _generateSigs :: Bool
    _generateSigs    = Bool
    False
                           , _generateClasses :: Bool
    _generateClasses = Bool
    False
                           }

    data OpticType = GetterType | LensType -- or IsoType

    -- Compute the positional location of the fields involved in
    -- each constructor for a given optic definition as well as the
    -- type of clauses to generate and the type to annotate the declaration
    -- with.
    buildScaffold ::
      LensRules                                                                ->
      Type                              {- outer type                       -} ->
      [(Name, [([DefName], Type)])]     {- normalized constructors          -} ->
      DefName                           {- target definition                -} ->
      Q (OpticType, OpticStab, [(Name, Int, [Int])])
                  {- ^ optic type, definition type, field count, target fields -}
    buildScaffold :: LensRules
    -> Type
    -> [(Name, [([DefName], Type)])]
    -> DefName
    -> Q (OpticType, OpticStab, [(Name, Int, [Int])])
    buildScaffold rules :: LensRules
    rules s :: Type
    s cons :: [(Name, [([DefName], Type)])]
    cons defName :: DefName
    defName =

      do (s' :: Type
    s',t :: Type
    t,a :: Type
    a,b :: Type
    b) <- Type -> [Either Type Type] -> Q (Type, Type, Type, Type)
    buildStab Type
    s (((Name, [Either Type Type]) -> [Either Type Type])
    -> [(Name, [Either Type Type])] -> [Either Type Type]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Name, [Either Type Type]) -> [Either Type Type]
    forall a b. (a, b) -> b
    snd [(Name, [Either Type Type])]
    consForDef)

         let defType :: OpticStab
    defType
               | Just (_,cx :: [Type]
    cx,a' :: Type
    a') <- Type
    a Type
    -> Getting
         (First ([TyVarBndr], [Type], Type))
         Type
         ([TyVarBndr], [Type], Type)
    -> Maybe ([TyVarBndr], [Type], Type)
    forall s a. s -> Getting (First a) s a -> Maybe a
    ^? Getting
      (First ([TyVarBndr], [Type], Type))
      Type
      ([TyVarBndr], [Type], Type)
    Traversal' Type ([TyVarBndr], [Type], Type)
    _ForallT =
                   let optic :: Name
    optic | Bool
    lensCase  = ''SimpleGetter
                             | Bool
    otherwise = ''SimpleFold
                   in [Type] -> Name -> Type -> Type -> OpticStab
    OpticSa [Type]
    cx Name
    optic Type
    s' Type
    a'

               -- Getter and Fold are always simple
               | Bool -> Bool
    not (LensRules -> Bool
    _allowUpdates LensRules
    rules) =
                   let optic :: Name
    optic | Bool
    lensCase  = ''SimpleGetter
                             | Bool
    otherwise = ''SimpleFold
                   in [Type] -> Name -> Type -> Type -> OpticStab
    OpticSa [] Name
    optic Type
    s' Type
    a

               -- Generate simple Lens and Traversal where possible
               | LensRules -> Bool
    _simpleLenses LensRules
    rules Bool -> Bool -> Bool
    || Type
    s' Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    t Bool -> Bool -> Bool
    && Type
    a Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    b =
                   let optic :: Name
    optic -- isoCase && _allowIsos rules = ''Iso'
                             | Bool
    lensCase                    = ''Lens'
                             | Bool
    otherwise                   = ''Traversal'
                   in [Type] -> Name -> Type -> Type -> OpticStab
    OpticSa [] Name
    optic Type
    s' Type
    a

               -- Generate type-changing Lens and Traversal otherwise
               | Bool
    otherwise =
                   let optic :: Name
    optic -- isoCase && _allowIsos rules = ''Iso
                             | Bool
    lensCase                    = ''Lens
                             | Bool
    otherwise                   = ''Traversal
                   in Name -> Type -> Type -> Type -> Type -> OpticStab
    OpticStab Name
    optic Type
    s' Type
    t Type
    a Type
    b

             opticType :: OpticType
    opticType | Getting Any Type ([TyVarBndr], [Type], Type) -> Type -> Bool
    forall s a. Getting Any s a -> s -> Bool
    has Getting Any Type ([TyVarBndr], [Type], Type)
    Traversal' Type ([TyVarBndr], [Type], Type)
    _ForallT Type
    a            = OpticType
    GetterType
                       | Bool -> Bool
    not (LensRules -> Bool
    _allowUpdates LensRules
    rules) = OpticType
    GetterType
                       -- isoCase                   = IsoType
                       | Bool
    otherwise                 = OpticType
    LensType

         (OpticType, OpticStab, [(Name, Int, [Int])])
    -> Q (OpticType, OpticStab, [(Name, Int, [Int])])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OpticType
    opticType, OpticStab
    defType, [(Name, Int, [Int])]
    scaffolds)
      where
      consForDef :: [(Name, [Either Type Type])]
      consForDef :: [(Name, [Either Type Type])]
    consForDef = ASetter
      [(Name, [([DefName], Type)])]
      [(Name, [Either Type Type])]
      ([DefName], Type)
      (Either Type Type)
    -> (([DefName], Type) -> Either Type Type)
    -> [(Name, [([DefName], Type)])]
    -> [(Name, [Either Type Type])]
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over (ASetter
      [(Name, [([DefName], Type)])]
      [(Name, [Either Type Type])]
      (Name, [([DefName], Type)])
      (Name, [Either Type Type])
    forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
    mapped ASetter
      [(Name, [([DefName], Type)])]
      [(Name, [Either Type Type])]
      (Name, [([DefName], Type)])
      (Name, [Either Type Type])
    -> ((([DefName], Type) -> Identity (Either Type Type))
        -> (Name, [([DefName], Type)])
        -> Identity (Name, [Either Type Type]))
    -> ASetter
         [(Name, [([DefName], Type)])]
         [(Name, [Either Type Type])]
         ([DefName], Type)
         (Either Type Type)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([([DefName], Type)] -> Identity [Either Type Type])
    -> (Name, [([DefName], Type)])
    -> Identity (Name, [Either Type Type])
    forall s t a b. Field2 s t a b => Lens s t a b
    _2 (([([DefName], Type)] -> Identity [Either Type Type])
     -> (Name, [([DefName], Type)])
     -> Identity (Name, [Either Type Type]))
    -> ((([DefName], Type) -> Identity (Either Type Type))
        -> [([DefName], Type)] -> Identity [Either Type Type])
    -> (([DefName], Type) -> Identity (Either Type Type))
    -> (Name, [([DefName], Type)])
    -> Identity (Name, [Either Type Type])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([DefName], Type) -> Identity (Either Type Type))
    -> [([DefName], Type)] -> Identity [Either Type Type]
    forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
    mapped) ([DefName], Type) -> Either Type Type
    categorize [(Name, [([DefName], Type)])]
    cons

      scaffolds :: [(Name, Int, [Int])]
      scaffolds :: [(Name, Int, [Int])]
    scaffolds = [ (Name
    n, [Either Type Type] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Either Type Type]
    ts, [Either Type Type] -> [Int]
    rightIndices [Either Type Type]
    ts) | (n :: Name
    n,ts :: [Either Type Type]
    ts) <- [(Name, [Either Type Type])]
    consForDef ]

      rightIndices :: [Either Type Type] -> [Int]
      rightIndices :: [Either Type Type] -> [Int]
    rightIndices = (Either Type Type -> Bool) -> [Either Type Type] -> [Int]
    forall a. (a -> Bool) -> [a] -> [Int]
    findIndices (Getting Any (Either Type Type) Type -> Either Type Type -> Bool
    forall s a. Getting Any s a -> s -> Bool
    has Getting Any (Either Type Type) Type
    forall a b b'. Traversal (Either a b) (Either a b') b b'
    _Right)

      -- Right: types for this definition
      -- Left : other types
      categorize :: ([DefName], Type) -> Either Type Type
      categorize :: ([DefName], Type) -> Either Type Type
    categorize (defNames :: [DefName]
    defNames, t :: Type
    t)
        | DefName
    defName DefName -> [DefName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [DefName]
    defNames = Type -> Either Type Type
    forall a b. b -> Either a b
    Right Type
    t
        | Bool
    otherwise               = Type -> Either Type Type
    forall a b. a -> Either a b
    Left  Type
    t

      lensCase :: Bool
      lensCase :: Bool
    lensCase = ((Name, [Either Type Type]) -> Bool)
    -> [(Name, [Either Type Type])] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\x :: (Name, [Either Type Type])
    x -> Getting (Endo [Type]) (Name, [Either Type Type]) Type
    -> (Name, [Either Type Type]) -> Int
    forall a s. Getting (Endo [a]) s a -> s -> Int
    lengthOf (([Either Type Type] -> Const (Endo [Type]) [Either Type Type])
    -> (Name, [Either Type Type])
    -> Const (Endo [Type]) (Name, [Either Type Type])
    forall s t a b. Field2 s t a b => Lens s t a b
    _2 (([Either Type Type] -> Const (Endo [Type]) [Either Type Type])
     -> (Name, [Either Type Type])
     -> Const (Endo [Type]) (Name, [Either Type Type]))
    -> ((Type -> Const (Endo [Type]) Type)
        -> [Either Type Type] -> Const (Endo [Type]) [Either Type Type])
    -> Getting (Endo [Type]) (Name, [Either Type Type]) Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Getting (Endo [Type]) [Either Type Type] (Either Type Type)
    forall (f :: * -> *) a. Foldable f => SimpleFold (f a) a
    folded Getting (Endo [Type]) [Either Type Type] (Either Type Type)
    -> ((Type -> Const (Endo [Type]) Type)
        -> Either Type Type -> Const (Endo [Type]) (Either Type Type))
    -> (Type -> Const (Endo [Type]) Type)
    -> [Either Type Type]
    -> Const (Endo [Type]) [Either Type Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Type -> Const (Endo [Type]) Type)
    -> Either Type Type -> Const (Endo [Type]) (Either Type Type)
    forall a b b'. Traversal (Either a b) (Either a b') b b'
    _Right) (Name, [Either Type Type])
    x Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1) [(Name, [Either Type Type])]
    consForDef

      -- isoCase :: Bool
      -- isoCase = case scaffolds of
      --             [(_,1,[0])] -> True
      --             _           -> False

    data OpticStab = OpticStab     Name Type Type Type Type
                   | OpticSa   Cxt Name Type Type

    stabToType :: OpticStab -> Type
    stabToType :: OpticStab -> Type
    stabToType (OpticStab  c :: Name
    c s :: Type
    s t :: Type
    t a :: Type
    a b :: Type
    b) = [Type] -> Type -> Type
    quantifyType [] (Name
    c Name -> [Type] -> Type
    `conAppsT` [Type
    s,Type
    t,Type
    a,Type
    b])
    stabToType (OpticSa cx :: [Type]
    cx c :: Name
    c s :: Type
    s   a :: Type
    a  ) = [Type] -> Type -> Type
    quantifyType [Type]
    cx (Name
    c Name -> [Type] -> Type
    `conAppsT` [Type
    s,Type
    a])

    stabToContext :: OpticStab -> Cxt
    stabToContext :: OpticStab -> [Type]
    stabToContext OpticStab{}        = []
    stabToContext (OpticSa cx :: [Type]
    cx _ _ _) = [Type]
    cx

    stabToOptic :: OpticStab -> Name
    stabToOptic :: OpticStab -> Name
    stabToOptic (OpticStab c :: Name
    c _ _ _ _) = Name
    c
    stabToOptic (OpticSa _ c :: Name
    c _ _) = Name
    c

    stabToS :: OpticStab -> Type
    stabToS :: OpticStab -> Type
    stabToS (OpticStab _ s :: Type
    s _ _ _) = Type
    s
    stabToS (OpticSa _ _ s :: Type
    s _) = Type
    s

    stabToA :: OpticStab -> Type
    stabToA :: OpticStab -> Type
    stabToA (OpticStab _ _ _ a :: Type
    a _) = Type
    a
    stabToA (OpticSa _ _ _ a :: Type
    a) = Type
    a

    -- Compute the s t a b types given the outer type 's' and the
    -- categorized field types. Left for fixed and Right for visited.
    -- These types are "raw" and will be packaged into an 'OpticStab'
    -- shortly after creation.
    buildStab :: Type -> [Either Type Type] -> Q (Type,Type,Type,Type)
    buildStab :: Type -> [Either Type Type] -> Q (Type, Type, Type, Type)
    buildStab s :: Type
    s categorizedFields :: [Either Type Type]
    categorizedFields =
      do (subA :: Map Name Type
    subA,a :: Type
    a) <- [Type] -> Q (Map Name Type, Type)
    unifyTypes [Type]
    targetFields
         let s' :: Type
    s' = Map Name Type -> Type -> Type
    applyTypeSubst Map Name Type
    subA Type
    s

         -- compute possible type changes
         Map Name Name
    sub <- Map Name (Q Name) -> Q (Map Name Name)
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    sequenceA ((Name -> Q Name) -> Set Name -> Map Name (Q Name)
    forall k a. (k -> a) -> Set k -> Map k a
    fromSet (String -> Q Name
    newName (String -> Q Name) -> (Name -> String) -> Name -> Q Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase) Set Name
    unfixedTypeVars)
         let (t :: Type
    t,b :: Type
    b) = ASetter (Type, Type) (Type, Type) Type Type
    -> (Type -> Type) -> (Type, Type) -> (Type, Type)
    forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
    over ASetter (Type, Type) (Type, Type) Type Type
    forall a b. Traversal (a, a) (b, b) a b
    both (Map Name Name -> Type -> Type
    forall t. HasTypeVars t => Map Name Name -> t -> t
    substTypeVars Map Name Name
    sub) (Type
    s',Type
    a)

         (Type, Type, Type, Type) -> Q (Type, Type, Type, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type
    s',Type
    t,Type
    a,Type
    b)

      where
      (fixedFields :: [Type]
    fixedFields, targetFields :: [Type]
    targetFields) = [Either Type Type] -> ([Type], [Type])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either Type Type]
    categorizedFields
      fixedTypeVars :: Set Name
    fixedTypeVars               = Getting (Endo [Name]) [Type] Name -> [Type] -> Set Name
    forall a s. Ord a => Getting (Endo [a]) s a -> s -> Set a
    setOf Getting (Endo [Name]) [Type] Name
    forall t. HasTypeVars t => Traversal' t Name
    typeVars [Type]
    fixedFields
      unfixedTypeVars :: Set Name
    unfixedTypeVars             = Getting (Endo [Name]) Type Name -> Type -> Set Name
    forall a s. Ord a => Getting (Endo [a]) s a -> s -> Set a
    setOf Getting (Endo [Name]) Type Name
    forall t. HasTypeVars t => Traversal' t Name
    typeVars Type
    s Set Name -> Set Name -> Set Name
    forall a. Ord a => Set a -> Set a -> Set a
    Set.\\ Set Name
    fixedTypeVars

    -- Build the signature and definition for a single field optic.
    -- In the case of a singleton constructor irrefutable matches are
    -- used to enable the resulting lenses to be used on a bottom value.
    makeFieldOptic ::
      LensRules ->
      (DefName, (OpticType, OpticStab, [(Name, Int, [Int])])) ->
      HasFieldClasses [Dec]
    makeFieldOptic :: LensRules
    -> (DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))
    -> StateT (Set Name) Q [Dec]
    makeFieldOptic rules :: LensRules
    rules (defName :: DefName
    defName, (opticType :: OpticType
    opticType, defType :: OpticStab
    defType, cons :: [(Name, Int, [Int])]
    cons)) = do
      Set Name
    locals <- StateT (Set Name) Q (Set Name)
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
      HasFieldClasses ()
    addName
      DecsQ -> StateT (Set Name) Q [Dec]
    forall (m :: * -> *) a s. Monad m => m a -> StateT s m a
    liftState (DecsQ -> StateT (Set Name) Q [Dec])
    -> DecsQ -> StateT (Set Name) Q [Dec]
    forall a b. (a -> b) -> a -> b
    $ do
        [Q Dec]
    cls <- Set Name -> Q [Q Dec]
    mkCls Set Name
    locals
        [Q Dec] -> DecsQ
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    sequenceA ([Q Dec]
    cls [Q Dec] -> [Q Dec] -> [Q Dec]
    forall a. [a] -> [a] -> [a]
    ++ [Q Dec]
    sig [Q Dec] -> [Q Dec] -> [Q Dec]
    forall a. [a] -> [a] -> [a]
    ++ [Q Dec]
    def)
      where
      mkCls :: Set Name -> Q [Q Dec]
    mkCls locals :: Set Name
    locals = case DefName
    defName of
                     MethodName c :: Name
    c n :: Name
    n | LensRules -> Bool
    _generateClasses LensRules
    rules ->
                      do Bool
    classExists <- Maybe Name -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Name -> Bool) -> Q (Maybe Name) -> Q Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Q (Maybe Name)
    lookupTypeName (Name -> String
    forall a. Show a => a -> String
    show Name
    c)
                         [Q Dec] -> Q [Q Dec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (if Bool
    classExists Bool -> Bool -> Bool
    || Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member Name
    c Set Name
    locals then [] else [OpticStab -> Name -> Name -> Q Dec
    makeFieldClass OpticStab
    defType Name
    c Name
    n])
                     _ -> [Q Dec] -> Q [Q Dec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

      addName :: HasFieldClasses ()
    addName = case DefName
    defName of
                MethodName c :: Name
    c _ -> Name -> HasFieldClasses ()
    addFieldClassName Name
    c
                _              -> () -> HasFieldClasses ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      sig :: [Q Dec]
    sig = case DefName
    defName of
              _ | Bool -> Bool
    not (LensRules -> Bool
    _generateSigs LensRules
    rules) -> []
              TopName n :: Name
    n -> [Name -> PredQ -> Q Dec
    sigD Name
    n (Type -> PredQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OpticStab -> Type
    stabToType OpticStab
    defType))]
              MethodName{} -> []

      fun :: Name -> [Q Dec]
    fun n :: Name
    n = Name -> [ClauseQ] -> Q Dec
    funD Name
    n [ClauseQ]
    clauses Q Dec -> [Q Dec] -> [Q Dec]
    forall a. a -> [a] -> [a]
    : Name -> [Q Dec]
    inlinePragma Name
    n

      def :: [Q Dec]
    def = case DefName
    defName of
              TopName n :: Name
    n      -> Name -> [Q Dec]
    fun Name
    n
              MethodName c :: Name
    c n :: Name
    n -> [OpticStab -> Name -> [Q Dec] -> Q Dec
    makeFieldInstance OpticStab
    defType Name
    c (Name -> [Q Dec]
    fun Name
    n)]

      clauses :: [ClauseQ]
    clauses = LensRules -> OpticType -> [(Name, Int, [Int])] -> [ClauseQ]
    makeFieldClauses LensRules
    rules OpticType
    opticType [(Name, Int, [Int])]
    cons

    ------------------------------------------------------------------------
    -- Field class generation
    ------------------------------------------------------------------------

    makeFieldClass :: OpticStab -> Name -> Name -> DecQ
    makeFieldClass :: OpticStab -> Name -> Name -> Q Dec
    makeFieldClass defType :: OpticStab
    defType className :: Name
    className methodName :: Name
    methodName =
      CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [Q Dec] -> Q Dec
    classD ([PredQ] -> CxtQ
    cxt []) Name
    className [Name -> TyVarBndr
    PlainTV Name
    s, Name -> TyVarBndr
    PlainTV Name
    a] [[Name] -> [Name] -> FunDep
    FunDep [Name
    s] [Name
    a]]
             [Name -> PredQ -> Q Dec
    sigD Name
    methodName (Type -> PredQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    methodType)]
      where
      methodType :: Type
    methodType = Set Name -> [Type] -> Type -> Type
    quantifyType' ([Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList [Name
    s,Name
    a])
                                 (OpticStab -> [Type]
    stabToContext OpticStab
    defType)
                 (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ OpticStab -> Name
    stabToOptic OpticStab
    defType Name -> [Type] -> Type
    `conAppsT` [Name -> Type
    VarT Name
    s,Name -> Type
    VarT Name
    a]
      s :: Name
    s = String -> Name
    mkName "s"
      a :: Name
    a = String -> Name
    mkName "a"

    -- | Build an instance for a field. If the field’s type contains any type
    -- families, will produce an equality constraint to avoid a type family
    -- application in the instance head.
    makeFieldInstance :: OpticStab -> Name -> [DecQ] -> DecQ
    makeFieldInstance :: OpticStab -> Name -> [Q Dec] -> Q Dec
    makeFieldInstance defType :: OpticStab
    defType className :: Name
    className decs :: [Q Dec]
    decs =
      Type -> Q Bool
    containsTypeFamilies Type
    a Q Bool -> (Bool -> Q Dec) -> Q Dec
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Q Dec
    pickInstanceDec
      where
      s :: Type
    s = OpticStab -> Type
    stabToS OpticStab
    defType
      a :: Type
    a = OpticStab -> Type
    stabToA OpticStab
    defType

      containsTypeFamilies :: Type -> Q Bool
    containsTypeFamilies = Type -> Q Bool
    go (Type -> Q Bool) -> (Type -> PredQ) -> Type -> Q Bool
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Type -> PredQ
    D.resolveTypeSynonyms
        where
        go :: Type -> Q Bool
    go (ConT nm :: Name
    nm) = (\i :: Info
    i -> case Info
    i of FamilyI d :: Dec
    d _ -> Dec -> Bool
    isTypeFamily Dec
    d; _ -> Bool
    False)
                       (Info -> Bool) -> Q Info -> Q Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> Q Info
    reify Name
    nm
        go ty :: Type
    ty = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or ([Bool] -> Bool) -> Q [Bool] -> Q Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Type -> Q Bool) -> [Type] -> Q [Bool]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Type -> Q Bool
    go (Type -> [Type]
    forall a. Data a => a -> [a]
    children Type
    ty)

    #if MIN_VERSION_template_haskell(2,11,0)
      isTypeFamily :: Dec -> Bool
    isTypeFamily OpenTypeFamilyD{}       = Bool
    True
      isTypeFamily ClosedTypeFamilyD{}     = Bool
    True
    #elif MIN_VERSION_template_haskell(2,9,0)
      isTypeFamily (FamilyD TypeFam _ _ _) = True
      isTypeFamily ClosedTypeFamilyD{}     = True
    #else
      isTypeFamily (FamilyD TypeFam _ _ _) = True
    #endif
      isTypeFamily _ = Bool
    False

      pickInstanceDec :: Bool -> Q Dec
    pickInstanceDec hasFamilies :: Bool
    hasFamilies
        | Bool
    hasFamilies = do
            Type
    placeholder <- Name -> Type
    VarT (Name -> Type) -> Q Name -> PredQ
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Q Name
    newName "a"
            [PredQ] -> [Type] -> Q Dec
    mkInstanceDec
              [Type -> PredQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> Type -> Type
    D.equalPred Type
    placeholder Type
    a)]
              [Type
    s, Type
    placeholder]
        | Bool
    otherwise = [PredQ] -> [Type] -> Q Dec
    mkInstanceDec [] [Type
    s, Type
    a]

      mkInstanceDec :: [PredQ] -> [Type] -> Q Dec
    mkInstanceDec context :: [PredQ]
    context headTys :: [Type]
    headTys =
        CxtQ -> PredQ -> [Q Dec] -> Q Dec
    instanceD ([PredQ] -> CxtQ
    cxt [PredQ]
    context) (Type -> PredQ
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    className Name -> [Type] -> Type
    `conAppsT` [Type]
    headTys)) [Q Dec]
    decs

    ------------------------------------------------------------------------
    -- Optic clause generators
    ------------------------------------------------------------------------

    makeFieldClauses :: LensRules -> OpticType -> [(Name, Int, [Int])] -> [ClauseQ]
    makeFieldClauses :: LensRules -> OpticType -> [(Name, Int, [Int])] -> [ClauseQ]
    makeFieldClauses rules :: LensRules
    rules opticType :: OpticType
    opticType cons :: [(Name, Int, [Int])]
    cons =
      case OpticType
    opticType of

        -- IsoType    -> [ makeIsoClause conName | (conName, _, _) <- cons ]

        GetterType -> [ Name -> Int -> [Int] -> ClauseQ
    makeGetterClause Name
    conName Int
    fieldCount [Int]
    fields
                        | (conName :: Name
    conName, fieldCount :: Int
    fieldCount, fields :: [Int]
    fields) <- [(Name, Int, [Int])]
    cons ]

        LensType   -> [ Name -> Int -> [Int] -> Bool -> ClauseQ
    makeFieldOpticClause Name
    conName Int
    fieldCount [Int]
    fields Bool
    irref
                        | (conName :: Name
    conName, fieldCount :: Int
    fieldCount, fields :: [Int]
    fields) <- [(Name, Int, [Int])]
    cons ]
          where
          irref :: Bool
    irref = LensRules -> Bool
    _lazyPatterns LensRules
    rules
               Bool -> Bool -> Bool
    && [(Name, Int, [Int])] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Name, Int, [Int])]
    cons Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1

    -- Construct an optic clause that returns an unmodified value
    -- given a constructor name and the number of fields on that
    -- constructor.
    makePureClause :: Name -> Int -> ClauseQ
    makePureClause :: Name -> Int -> ClauseQ
    makePureClause conName :: Name
    conName fieldCount :: Int
    fieldCount =
      do [Name]
    xs <- String -> Int -> Q [Name]
    newNames "x" Int
    fieldCount
         -- clause: _ (Con x1..xn) = pure (Con x1..xn)
         [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [PatQ
    wildP, Name -> [PatQ] -> PatQ
    conP Name
    conName ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    xs)]
                (ExpQ -> BodyQ
    normalB (ExpQ -> ExpQ -> ExpQ
    appE (Name -> ExpQ
    varE 'pure) ([ExpQ] -> ExpQ
    appsE (Name -> ExpQ
    conE Name
    conName ExpQ -> [ExpQ] -> [ExpQ]
    forall a. a -> [a] -> [a]
    : (Name -> ExpQ) -> [Name] -> [ExpQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> ExpQ
    varE [Name]
    xs))))
                []

    -- Construct an optic clause suitable for a Getter or Fold
    -- by visited the fields identified by their 0 indexed positions
    makeGetterClause :: Name -> Int -> [Int] -> ClauseQ
    makeGetterClause :: Name -> Int -> [Int] -> ClauseQ
    makeGetterClause conName :: Name
    conName fieldCount :: Int
    fieldCount []     = Name -> Int -> ClauseQ
    makePureClause Name
    conName Int
    fieldCount
    makeGetterClause conName :: Name
    conName fieldCount :: Int
    fieldCount fields :: [Int]
    fields =
      do Name
    f  <- String -> Q Name
    newName "f"
         [Name]
    xs <- String -> Int -> Q [Name]
    newNames "x" ([Int] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Int]
    fields)

         let pats :: [Int] -> [Name] -> [PatQ]
    pats (i :: Int
    i:is :: [Int]
    is) (y :: Name
    y:ys :: [Name]
    ys)
               | Int
    i Int -> [Int] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Int]
    fields = Name -> PatQ
    varP Name
    y PatQ -> [PatQ] -> [PatQ]
    forall a. a -> [a] -> [a]
    : [Int] -> [Name] -> [PatQ]
    pats [Int]
    is [Name]
    ys
               | Bool
    otherwise = PatQ
    wildP PatQ -> [PatQ] -> [PatQ]
    forall a. a -> [a] -> [a]
    : [Int] -> [Name] -> [PatQ]
    pats [Int]
    is (Name
    yName -> [Name] -> [Name]
    forall a. a -> [a] -> [a]
    :[Name]
    ys)
             pats is :: [Int]
    is     _  = (Int -> PatQ) -> [Int] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map (PatQ -> Int -> PatQ
    forall a b. a -> b -> a
    const PatQ
    wildP) [Int]
    is

             fxs :: [ExpQ]
    fxs   = [ ExpQ -> ExpQ -> ExpQ
    appE (Name -> ExpQ
    varE Name
    f) (Name -> ExpQ
    varE Name
    x) | Name
    x <- [Name]
    xs ]
             body :: ExpQ
    body  = (ExpQ -> ExpQ -> ExpQ) -> ExpQ -> [ExpQ] -> ExpQ
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\a :: ExpQ
    a b :: ExpQ
    b -> [ExpQ] -> ExpQ
    appsE [Name -> ExpQ
    varE '(<*>), ExpQ
    a, ExpQ
    b])
                           (ExpQ -> ExpQ -> ExpQ
    appE (Name -> ExpQ
    varE 'phantom) ([ExpQ] -> ExpQ
    forall a. [a] -> a
    head [ExpQ]
    fxs))
                           ([ExpQ] -> [ExpQ]
    forall a. [a] -> [a]
    tail [ExpQ]
    fxs)

         -- clause f (Con x1..xn) = coerce (f x1) <*> ... <*> f xn
         [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    f, Name -> [PatQ] -> PatQ
    conP Name
    conName ([Int] -> [Name] -> [PatQ]
    pats [0..Int
    fieldCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1] [Name]
    xs)]
                (ExpQ -> BodyQ
    normalB ExpQ
    body)
                []

    -- Build a clause that updates the field at the given indexes
    -- When irref is 'True' the value with me matched with an irrefutable
    -- pattern. This is suitable for Lens and Traversal construction
    makeFieldOpticClause :: Name -> Int -> [Int] -> Bool -> ClauseQ
    makeFieldOpticClause :: Name -> Int -> [Int] -> Bool -> ClauseQ
    makeFieldOpticClause conName :: Name
    conName fieldCount :: Int
    fieldCount [] _ =
      Name -> Int -> ClauseQ
    makePureClause Name
    conName Int
    fieldCount
    makeFieldOpticClause conName :: Name
    conName fieldCount :: Int
    fieldCount (field :: Int
    field:fields :: [Int]
    fields) irref :: Bool
    irref =
      do Name
    f  <- String -> Q Name
    newName "f"
         [Name]
    xs <- String -> Int -> Q [Name]
    newNames "x" Int
    fieldCount
         [Name]
    ys <- String -> Int -> Q [Name]
    newNames "y" (1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Int]
    fields)

         let xs' :: [Name]
    xs' = ((Int, Name) -> [Name] -> [Name])
    -> [Name] -> [(Int, Name)] -> [Name]
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\(i :: Int
    i,x :: Name
    x) -> ASetter [Name] [Name] Name Name -> Name -> [Name] -> [Name]
    forall s t a b. ASetter s t a b -> b -> s -> t
    set (Index [Name] -> Traversal' [Name] (IxValue [Name])
    forall m. Ixed m => Index m -> Traversal' m (IxValue m)
    ix Int
    Index [Name]
    i) Name
    x) [Name]
    xs ([Int] -> [Name] -> [(Int, Name)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Int
    fieldInt -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    fields) [Name]
    ys)

             mkFx :: Int -> ExpQ
    mkFx i :: Int
    i = ExpQ -> ExpQ -> ExpQ
    appE (Name -> ExpQ
    varE Name
    f) (Name -> ExpQ
    varE ([Name]
    xs [Name] -> Int -> Name
    forall a. [a] -> Int -> a
    !! Int
    i))

             body0 :: ExpQ
    body0 = [ExpQ] -> ExpQ
    appsE [ Name -> ExpQ
    varE 'fmap
                           , [PatQ] -> ExpQ -> ExpQ
    lamE ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    ys) ([ExpQ] -> ExpQ
    appsE (Name -> ExpQ
    conE Name
    conName ExpQ -> [ExpQ] -> [ExpQ]
    forall a. a -> [a] -> [a]
    : (Name -> ExpQ) -> [Name] -> [ExpQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> ExpQ
    varE [Name]
    xs'))
                           , Int -> ExpQ
    mkFx Int
    field
                           ]

             body :: ExpQ
    body = (ExpQ -> Int -> ExpQ) -> ExpQ -> [Int] -> ExpQ
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\a :: ExpQ
    a b :: Int
    b -> [ExpQ] -> ExpQ
    appsE [Name -> ExpQ
    varE '(<*>), ExpQ
    a, Int -> ExpQ
    mkFx Int
    b]) ExpQ
    body0 [Int]
    fields

         let wrap :: PatQ -> PatQ
    wrap = if Bool
    irref then PatQ -> PatQ
    tildeP else PatQ -> PatQ
    forall a. a -> a
    id

         [PatQ] -> BodyQ -> [Q Dec] -> ClauseQ
    clause [Name -> PatQ
    varP Name
    f, PatQ -> PatQ
    wrap (Name -> [PatQ] -> PatQ
    conP Name
    conName ((Name -> PatQ) -> [Name] -> [PatQ]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> PatQ
    varP [Name]
    xs))]
                (ExpQ -> BodyQ
    normalB ExpQ
    body)
                []

    ------------------------------------------------------------------------
    -- Unification logic
    ------------------------------------------------------------------------

    -- The field-oriented optic generation supports incorporating fields
    -- with distinct but unifiable types into a single definition.

    -- Unify the given list of types, if possible, and return the
    -- substitution used to unify the types for unifying the outer
    -- type when building a definition's type signature.
    unifyTypes :: [Type] -> Q (Map Name Type, Type)
    unifyTypes :: [Type] -> Q (Map Name Type, Type)
    unifyTypes (x :: Type
    x:xs :: [Type]
    xs) = ((Map Name Type, Type) -> Type -> Q (Map Name Type, Type))
    -> (Map Name Type, Type) -> [Type] -> Q (Map Name Type, Type)
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ((Map Name Type -> Type -> Type -> Q (Map Name Type, Type))
    -> (Map Name Type, Type) -> Type -> Q (Map Name Type, Type)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Map Name Type -> Type -> Type -> Q (Map Name Type, Type)
    unify1) (Map Name Type
    forall k a. Map k a
    Map.empty, Type
    x) [Type]
    xs
    unifyTypes []     = String -> Q (Map Name Type, Type)
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "unifyTypes: Bug: Unexpected empty list"

    -- Attempt to unify two given types using a running substitution
    unify1 :: Map Name Type -> Type -> Type -> Q (Map Name Type, Type)
    unify1 :: Map Name Type -> Type -> Type -> Q (Map Name Type, Type)
    unify1 sub :: Map Name Type
    sub (VarT x :: Name
    x) y :: Type
    y
      | Just r :: Type
    r <- Name -> Map Name Type -> Maybe Type
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    x Map Name Type
    sub = Map Name Type -> Type -> Type -> Q (Map Name Type, Type)
    unify1 Map Name Type
    sub Type
    r Type
    y
    unify1 sub :: Map Name Type
    sub x :: Type
    x (VarT y :: Name
    y)
      | Just r :: Type
    r <- Name -> Map Name Type -> Maybe Type
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    y Map Name Type
    sub = Map Name Type -> Type -> Type -> Q (Map Name Type, Type)
    unify1 Map Name Type
    sub Type
    x Type
    r
    unify1 sub :: Map Name Type
    sub x :: Type
    x y :: Type
    y
      | Type
    x Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    y = (Map Name Type, Type) -> Q (Map Name Type, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Name Type
    sub, Type
    x)
    unify1 sub :: Map Name Type
    sub (AppT f1 :: Type
    f1 x1 :: Type
    x1) (AppT f2 :: Type
    f2 x2 :: Type
    x2) =
      do (sub1 :: Map Name Type
    sub1, f :: Type
    f) <- Map Name Type -> Type -> Type -> Q (Map Name Type, Type)
    unify1 Map Name Type
    sub  Type
    f1 Type
    f2
         (sub2 :: Map Name Type
    sub2, x :: Type
    x) <- Map Name Type -> Type -> Type -> Q (Map Name Type, Type)
    unify1 Map Name Type
    sub1 Type
    x1 Type
    x2
         (Map Name Type, Type) -> Q (Map Name Type, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Name Type
    sub2, Type -> Type -> Type
    AppT (Map Name Type -> Type -> Type
    applyTypeSubst Map Name Type
    sub2 Type
    f) Type
    x)
    unify1 sub :: Map Name Type
    sub x :: Type
    x (VarT y :: Name
    y)
      | Getting (Endo [Name]) Type Name -> Name -> Type -> Bool
    forall a s. Eq a => Getting (Endo [a]) s a -> a -> s -> Bool
    elemOf Getting (Endo [Name]) Type Name
    forall t. HasTypeVars t => Traversal' t Name
    typeVars Name
    y (Map Name Type -> Type -> Type
    applyTypeSubst Map Name Type
    sub Type
    x) =
          String -> Q (Map Name Type, Type)
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Failed to unify types: occurs check"
      | Bool
    otherwise = (Map Name Type, Type) -> Q (Map Name Type, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Type -> Map Name Type -> Map Name Type
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert Name
    y Type
    x Map Name Type
    sub, Type
    x)
    unify1 sub :: Map Name Type
    sub (VarT x :: Name
    x) y :: Type
    y = Map Name Type -> Type -> Type -> Q (Map Name Type, Type)
    unify1 Map Name Type
    sub Type
    y (Name -> Type
    VarT Name
    x)

    -- TODO: Unify contexts
    unify1 sub :: Map Name Type
    sub (ForallT v1 :: [TyVarBndr]
    v1 [] t1 :: Type
    t1) (ForallT v2 :: [TyVarBndr]
    v2 [] t2 :: Type
    t2) =
         -- This approach works out because by the time this code runs
         -- all of the type variables have been renamed. No risk of shadowing.
      do (sub1 :: Map Name Type
    sub1,t :: Type
    t) <- Map Name Type -> Type -> Type -> Q (Map Name Type, Type)
    unify1 Map Name Type
    sub Type
    t1 Type
    t2
         [TyVarBndr]
    v <- ([TyVarBndr] -> [TyVarBndr]) -> Q [TyVarBndr] -> Q [TyVarBndr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [TyVarBndr] -> [TyVarBndr]
    forall a. Eq a => [a] -> [a]
    nub ((TyVarBndr -> Q TyVarBndr) -> [TyVarBndr] -> Q [TyVarBndr]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (Map Name Type -> TyVarBndr -> Q TyVarBndr
    limitedSubst Map Name Type
    sub1) ([TyVarBndr]
    v1[TyVarBndr] -> [TyVarBndr] -> [TyVarBndr]
    forall a. [a] -> [a] -> [a]
    ++[TyVarBndr]
    v2))
         (Map Name Type, Type) -> Q (Map Name Type, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Name Type
    sub1, [TyVarBndr] -> [Type] -> Type -> Type
    ForallT [TyVarBndr]
    v [] Type
    t)

    unify1 _ x :: Type
    x y :: Type
    y = String -> Q (Map Name Type, Type)
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail ("Failed to unify types: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Type, Type) -> String
    forall a. Show a => a -> String
    show (Type
    x,Type
    y))

    -- Perform a limited substitution on type variables. This is used
    -- when unifying rank-2 fields when trying to achieve a Getter or Fold.
    limitedSubst :: Map Name Type -> TyVarBndr -> Q TyVarBndr
    limitedSubst :: Map Name Type -> TyVarBndr -> Q TyVarBndr
    limitedSubst sub :: Map Name Type
    sub (PlainTV n :: Name
    n)
      | Just r :: Type
    r <- Name -> Map Name Type -> Maybe Type
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    n Map Name Type
    sub =
           case Type
    r of
             VarT m :: Name
    m -> Map Name Type -> TyVarBndr -> Q TyVarBndr
    limitedSubst Map Name Type
    sub (Name -> TyVarBndr
    PlainTV Name
    m)
             _ -> String -> Q TyVarBndr
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Unable to unify exotic higher-rank type"
    limitedSubst sub :: Map Name Type
    sub (KindedTV n :: Name
    n k :: Type
    k)
      | Just r :: Type
    r <- Name -> Map Name Type -> Maybe Type
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    n Map Name Type
    sub =
           case Type
    r of
             VarT m :: Name
    m -> Map Name Type -> TyVarBndr -> Q TyVarBndr
    limitedSubst Map Name Type
    sub (Name -> Type -> TyVarBndr
    KindedTV Name
    m Type
    k)
             _ -> String -> Q TyVarBndr
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Unable to unify exotic higher-rank type"
    limitedSubst _ tv :: TyVarBndr
    tv = TyVarBndr -> Q TyVarBndr
    forall (m :: * -> *) a. Monad m => a -> m a
    return TyVarBndr
    tv

    -- Apply a substitution to a type. This is used after unifying
    -- the types of the fields in unifyTypes.
    applyTypeSubst :: Map Name Type -> Type -> Type
    applyTypeSubst :: Map Name Type -> Type -> Type
    applyTypeSubst sub :: Map Name Type
    sub = (Type -> Maybe Type) -> Type -> Type
    forall a b. (Data a, Data b) => (a -> Maybe a) -> b -> b
    rewrite Type -> Maybe Type
    aux
      where
      aux :: Type -> Maybe Type
    aux (VarT n :: Name
    n) = Name -> Map Name Type -> Maybe Type
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    n Map Name Type
    sub
      aux _        = Maybe Type
    forall a. Maybe a
    Nothing

    ------------------------------------------------------------------------
    -- Field generation parameters
    ------------------------------------------------------------------------

    {- |
    Rules used to generate lenses. The fields are intentionally not exported; to create your own rules, see lenses in the “Configuring lens rules” section. You'd have to customise one of the existing rulesets; for an example of doing that, see 'makeLensesWith'.
    -}
    data LensRules = LensRules
      { LensRules -> Bool
    _simpleLenses    :: Bool
      , LensRules -> Bool
    _generateSigs    :: Bool
      , LensRules -> Bool
    _generateClasses :: Bool
      -- , _allowIsos       :: Bool
      , LensRules -> Bool
    _allowUpdates    :: Bool -- Allow Lens/Traversal (otherwise Getter/Fold)
      , LensRules -> Bool
    _lazyPatterns    :: Bool
      -- Type Name -> Field Names -> Target Field Name -> Definition Names
      , LensRules -> Name -> [Name] -> Name -> [DefName]
    _fieldToDef      :: Name -> [Name] -> Name -> [DefName]
      -- Type Name -> (Class Name, Top Method)
      , LensRules -> Name -> Maybe (Name, Name)
    _classyLenses    :: Name -> Maybe (Name, Name)
      }

    {- |
    Name to give to a generated lens (used in 'lensField').
    -}
    data DefName
      = TopName Name          -- ^ Simple top-level definiton name
      | MethodName Name Name  -- ^ 'makeFields'-style class name and method name
      deriving (Int -> DefName -> String -> String
    [DefName] -> String -> String
    DefName -> String
    (Int -> DefName -> String -> String)
    -> (DefName -> String)
    -> ([DefName] -> String -> String)
    -> Show DefName
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    showList :: [DefName] -> String -> String
    $cshowList :: [DefName] -> String -> String
    show :: DefName -> String
    $cshow :: DefName -> String
    showsPrec :: Int -> DefName -> String -> String
    $cshowsPrec :: Int -> DefName -> String -> String
    Show, DefName -> DefName -> Bool
    (DefName -> DefName -> Bool)
    -> (DefName -> DefName -> Bool) -> Eq DefName
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: DefName -> DefName -> Bool
    $c/= :: DefName -> DefName -> Bool
    == :: DefName -> DefName -> Bool
    $c== :: DefName -> DefName -> Bool
    Eq, Eq DefName
    Eq DefName =>
    (DefName -> DefName -> Ordering)
    -> (DefName -> DefName -> Bool)
    -> (DefName -> DefName -> Bool)
    -> (DefName -> DefName -> Bool)
    -> (DefName -> DefName -> Bool)
    -> (DefName -> DefName -> DefName)
    -> (DefName -> DefName -> DefName)
    -> Ord DefName
    DefName -> DefName -> Bool
    DefName -> DefName -> Ordering
    DefName -> DefName -> DefName
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: DefName -> DefName -> DefName
    $cmin :: DefName -> DefName -> DefName
    max :: DefName -> DefName -> DefName
    $cmax :: DefName -> DefName -> DefName
    >= :: DefName -> DefName -> Bool
    $c>= :: DefName -> DefName -> Bool
    > :: DefName -> DefName -> Bool
    $c> :: DefName -> DefName -> Bool
    <= :: DefName -> DefName -> Bool
    $c<= :: DefName -> DefName -> Bool
    < :: DefName -> DefName -> Bool
    $c< :: DefName -> DefName -> Bool
    compare :: DefName -> DefName -> Ordering
    $ccompare :: DefName -> DefName -> Ordering
    $cp1Ord :: Eq DefName
    Ord)

    ------------------------------------------------------------------------
    -- Miscellaneous utility functions
    ------------------------------------------------------------------------

    liftState :: Monad m => m a -> StateT s m a
    liftState :: m a -> StateT s m a
    liftState act :: m a
    act = (s -> m (a, s)) -> StateT s m a
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
    StateT (\s :: s
    s -> (a -> (a, s)) -> m a -> m (a, s)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ((a -> s -> (a, s)) -> s -> a -> (a, s)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (,) s
    s) m a
    act)