    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE UnboxedTuples #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE GADTs #-}
    #ifdef TRUSTWORTHY
    {-# LANGUAGE Trustworthy #-}
    #endif
    {-# OPTIONS_GHC -fno-full-laziness #-}
    #if __GLASGOW_HASKELL__ >= 810
    -- Use -fbyte-code explicitly to ensure that -fobject-code isn't automatically
    -- implied on GHCi 8.10+ by the use of UnboxedTuples, as this breaks the
    -- doctests. See #874 for more details.
    {-# OPTIONS_GHC -fbyte-code #-}
    #endif
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Data.Lens
    -- Copyright   :  (C) 2012-2016 Edward Kmett, (C) 2006-2012 Neil Mitchell
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  experimental
    -- Portability :  Rank2Types
    --
    -- Smart and naïve generic traversals given 'Data' instances.
    --
    -- 'template', 'uniplate', and 'biplate' each build up information about what
    -- types can be contained within another type to speed up 'Traversal'.
    --
    ----------------------------------------------------------------------------
    module Data.Data.Lens
      (
      -- * Generic Traversal
        template
      , tinplate
      , uniplate
      , biplate
      -- * Field Accessor Traversal
      , upon
      , upon'
      , onceUpon
      , onceUpon'
      -- * Data Traversal
      , gtraverse
      ) where

    import           Control.Applicative
    import           Control.Exception as E
    import           Control.Lens.Internal.Context
    import           Control.Lens.Internal.Indexed
    import           Control.Lens.Lens
    import           Control.Lens.Setter
    import           Control.Lens.Traversal
    import           Control.Lens.Type
    import           Data.Data
    import           GHC.IO
    import           Data.Maybe
    import           Data.Foldable
    import qualified Data.HashMap.Strict as M
    import           Data.HashMap.Strict (HashMap, (!))
    import qualified Data.HashSet as S
    import           Data.HashSet (HashSet)
    import           Data.IORef
    import           Data.Monoid
    import           GHC.Exts (realWorld#)
    import           Prelude

    import qualified Data.Proxy as X (Proxy (..))
    import qualified Data.Typeable as X (typeRep, eqT)
    import qualified Data.Type.Equality as X

    -- $setup
    -- >>> :set -XNoOverloadedStrings
    -- >>> import Control.Lens
    -- >>> import Control.Lens.Internal.Doctest
    -- >>> import Prelude hiding (head, tail)

    -------------------------------------------------------------------------------
    -- Generic Traversal
    -------------------------------------------------------------------------------

    -- | A generic applicative transformation that maps over the immediate subterms.
    --
    -- 'gtraverse' is to 'traverse' what 'gmapM' is to 'mapM'
    --
    -- This really belongs in @Data.Data@.
    gtraverse :: (Applicative f, Data a) => (forall d. Data d => d -> f d) -> a -> f a
    gtraverse :: forall (f :: * -> *) a.
    (Applicative f, Data a) =>
    (forall d. Data d => d -> f d) -> a -> f a
    gtraverse forall d. Data d => d -> f d
    f = (forall d b. Data d => f (d -> b) -> d -> f b)
    -> (forall g. g -> f g) -> a -> f a
    forall a (c :: * -> *).
    Data a =>
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a
    gfoldl (\f (d -> b)
    x d
    y -> f (d -> b)
    x f (d -> b) -> f d -> f b
    forall a b. f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> d -> f d
    forall d. Data d => d -> f d
    f d
    y) g -> f g
    forall g. g -> f g
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
    {-# INLINE gtraverse #-}

    -------------------------------------------------------------------------------
    -- Naïve Traversal
    -------------------------------------------------------------------------------

    -- | Naïve 'Traversal' using 'Data'. This does not attempt to optimize the traversal.
    --
    -- This is primarily useful when the children are immediately obvious, and for benchmarking.
    tinplate :: (Data s, Typeable a) => Traversal' s a
    tinplate :: forall s a. (Data s, Typeable a) => Traversal' s a
    tinplate a -> f a
    f = (forall d b. Data d => f (d -> b) -> d -> f b)
    -> (forall g. g -> f g) -> s -> f s
    forall a (c :: * -> *).
    Data a =>
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> s -> c s
    gfoldl ((a -> f a) -> f (d -> b) -> d -> f b
    forall s a (f :: * -> *) r.
    (Applicative f, Typeable a, Data s) =>
    (a -> f a) -> f (s -> r) -> s -> f r
    step a -> f a
    f) g -> f g
    forall g. g -> f g
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
    {-# INLINE tinplate #-}

    step :: forall s a f r. (Applicative f, Typeable a, Data s) => (a -> f a) -> f (s -> r) -> s -> f r
    step :: forall s a (f :: * -> *) r.
    (Applicative f, Typeable a, Data s) =>
    (a -> f a) -> f (s -> r) -> s -> f r
    step a -> f a
    f f (s -> r)
    w s
    s = f (s -> r)
    w f (s -> r) -> f s -> f r
    forall a b. f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> case Maybe (s :~: a)
    forall {k} (a :: k) (b :: k).
    (Typeable a, Typeable b) =>
    Maybe (a :~: b)
    X.eqT :: Maybe (s X.:~: a) of
      Just s :~: a
    X.Refl -> a -> f a
    f s
    a
    s
      Maybe (s :~: a)
    Nothing   -> (a -> f a) -> s -> f s
    forall s a. (Data s, Typeable a) => Traversal' s a
    Traversal' s a
    tinplate a -> f a
    f s
    s
    {-# INLINE step #-}

    -------------------------------------------------------------------------------
    -- Smart Traversal
    -------------------------------------------------------------------------------

    -- | Find every occurrence of a given type @a@ recursively that doesn't require
    -- passing through something of type @a@ using 'Data', while avoiding traversal
    -- of areas that cannot contain a value of type @a@.
    --
    -- This is 'uniplate' with a more liberal signature.
    template :: forall s a. (Data s, Typeable a) => Traversal' s a
    template :: forall s a. (Data s, Typeable a) => Traversal' s a
    template = (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s
    forall (f :: * -> *) s a.
    (Applicative f, Data s) =>
    (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s
    uniplateData (Oracle a -> forall c. Typeable c => c -> Answer c a
    forall a. Oracle a -> forall t. Typeable t => t -> Answer t a
    fromOracle Oracle a
    answer) where
      answer :: Oracle a
    answer = s -> a -> Oracle a
    forall a b. (Data a, Typeable b) => a -> b -> Oracle b
    hitTest (s
    forall a. HasCallStack => a
    undefined :: s) (a
    forall a. HasCallStack => a
    undefined :: a)
    {-# INLINE template #-}

    -- | Find descendants of type @a@ non-transitively, while avoiding computation of areas that cannot contain values of
    -- type @a@ using 'Data'.
    --
    -- 'uniplate' is a useful default definition for 'Control.Lens.Plated.plate'
    uniplate :: Data a => Traversal' a a
    uniplate :: forall a. Data a => Traversal' a a
    uniplate = (a -> f a) -> a -> f a
    forall s a. (Data s, Typeable a) => Traversal' s a
    Traversal' a a
    template
    {-# INLINE uniplate #-}

    -- | 'biplate' performs like 'template', except when @s ~ a@, it returns itself and nothing else.
    biplate :: forall s a. (Data s, Typeable a) => Traversal' s a
    biplate :: forall s a. (Data s, Typeable a) => Traversal' s a
    biplate = (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s
    forall (f :: * -> *) s a.
    (Applicative f, Data s) =>
    (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s
    biplateData (Oracle a -> forall c. Typeable c => c -> Answer c a
    forall a. Oracle a -> forall t. Typeable t => t -> Answer t a
    fromOracle Oracle a
    answer) where
      answer :: Oracle a
    answer = s -> a -> Oracle a
    forall a b. (Data a, Typeable b) => a -> b -> Oracle b
    hitTest (s
    forall a. HasCallStack => a
    undefined :: s) (a
    forall a. HasCallStack => a
    undefined :: a)
    {-# INLINE biplate #-}

    ------------------------------------------------------------------------------
    -- Automatic Traversal construction from field accessors
    ------------------------------------------------------------------------------

    data FieldException a = FieldException !Int a

    instance Show (FieldException a) where
      showsPrec :: Int -> FieldException a -> ShowS
    showsPrec Int
    d (FieldException Int
    i a
    _) = Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $
        String -> ShowS
    showString String
    "<field " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    11 Int
    i ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    '>'

    instance Typeable a => Exception (FieldException a)

    lookupon :: Typeable a => LensLike' (Indexing Identity) s a -> (s -> a) -> s -> Maybe (Int, Context a a s)
    lookupon :: forall a s.
    Typeable a =>
    LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    lookupon LensLike' (Indexing Identity) s a
    l s -> a
    field s
    s = case IO (Either SomeException a) -> Either SomeException a
    forall a. IO a -> a
    unsafePerformIO (IO (Either SomeException a) -> Either SomeException a)
    -> IO (Either SomeException a) -> Either SomeException a
    forall a b. (a -> b) -> a -> b
    $ IO a -> IO (Either SomeException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO a -> IO (Either SomeException a))
    -> IO a -> IO (Either SomeException a)
    forall a b. (a -> b) -> a -> b
    $ a -> IO a
    forall a. a -> IO a
    evaluate (a -> IO a) -> a -> IO a
    forall a b. (a -> b) -> a -> b
    $ s -> a
    field (s -> a) -> s -> a
    forall a b. (a -> b) -> a -> b
    $ s
    s s -> (s -> s) -> s
    forall a b. a -> (a -> b) -> b
    & LensLike' (Indexing Identity) s a
    -> Indexed Int a (Identity a) -> s -> Identity s
    forall (p :: * -> * -> *) a (f :: * -> *) b s t.
    Indexable Int p =>
    ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
    indexing LensLike' (Indexing Identity) s a
    l (Indexed Int a (Identity a) -> s -> Identity s)
    -> (Int -> a -> a) -> s -> s
    forall i s t a b.
    AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
    %@~ \Int
    i (a
    a::a) -> FieldException a -> a
    forall a e. (HasCallStack, Exception e) => e -> a
    E.throw (Int -> a -> FieldException a
    forall a. Int -> a -> FieldException a
    FieldException Int
    i a
    a) of
      Right a
    _ -> Maybe (Int, Context a a s)
    forall a. Maybe a
    Nothing
      Left SomeException
    e -> case SomeException -> Maybe (FieldException a)
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e of
        Maybe (FieldException a)
    Nothing -> Maybe (Int, Context a a s)
    forall a. Maybe a
    Nothing
        Just (FieldException Int
    i a
    a) -> (Int, Context a a s) -> Maybe (Int, Context a a s)
    forall a. a -> Maybe a
    Just (Int
    i, (a -> s) -> a -> Context a a s
    forall a b t. (b -> t) -> a -> Context a b t
    Context (\a
    a' -> ASetter s s a a -> a -> s -> s
    forall s t a b. ASetter s t a b -> b -> s -> t
    set (LensLike' (Indexing Identity) s a
    -> Int -> IndexedLensLike Int Identity s s a a
    forall (f :: * -> *) s t a.
    Applicative f =>
    LensLike (Indexing f) s t a a
    -> Int -> IndexedLensLike Int f s t a a
    elementOf LensLike' (Indexing Identity) s a
    l Int
    i) a
    a' s
    s) a
    a)
    {-# INLINE lookupon #-}

    -- | This automatically constructs a 'Traversal'' from an function.
    --
    -- >>> (2,4) & upon fst *~ 5
    -- (10,4)
    --
    -- There are however, caveats on how this function can be used!
    --
    -- First, the user supplied function must access only one field of the specified type. That is to say the target
    -- must be a single element that would be visited by @'holesOnOf' 'template' 'uniplate'@
    --
    -- Note: this even permits a number of functions to be used directly.
    --
    -- >>> [1,2,3,4] & upon head .~ 0
    -- [0,2,3,4]
    --
    -- >>> [1,2,3,4] & upon last .~ 5
    -- [1,2,3,5]
    --
    -- >>> [1,2,3,4] ^? upon tail
    -- Just [2,3,4]
    --
    -- >>> "" ^? upon tail
    -- Nothing
    --
    -- Accessing parents on the way down to children is okay:
    --
    -- >>> [1,2,3,4] & upon (tail.tail) .~ [10,20]
    -- [1,2,10,20]
    --
    -- Second, the structure must not contain strict or unboxed fields of the same type that will be visited by 'Data'
    --
    -- @'upon' :: ('Data' s, 'Data' a) => (s -> a) -> 'IndexedTraversal'' [Int] s a@
    upon :: forall p f s a. (Indexable [Int] p, Applicative f, Data s, Data a) => (s -> a) -> p a (f a) -> s -> f s
    upon :: forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Indexable [Int] p, Applicative f, Data s, Data a) =>
    (s -> a) -> p a (f a) -> s -> f s
    upon s -> a
    field p a (f a)
    f s
    s = case LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    forall a s.
    Typeable a =>
    LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    lookupon LensLike' (Indexing Identity) s a
    forall s a. (Data s, Typeable a) => Traversal' s a
    Traversal' s a
    template s -> a
    field s
    s of
      Maybe (Int, Context a a s)
    Nothing -> s -> f s
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure s
    s
      Just (Int
    i, Context a -> s
    k0 a
    a0) ->
        let
          go :: [Int] -> Traversal' s a -> (a -> s) -> a -> f s
          go :: [Int] -> Traversal' s a -> (a -> s) -> a -> f s
    go [Int]
    is Traversal' s a
    l a -> s
    k a
    a = case LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    forall a s.
    Typeable a =>
    LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    lookupon (LensLike' (Indexing Identity) s a
    Traversal' s a
    lLensLike' (Indexing Identity) s a
    -> ((a -> Indexing Identity a) -> a -> Indexing Identity a)
    -> LensLike' (Indexing Identity) s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(a -> Indexing Identity a) -> a -> Indexing Identity a
    forall a. Data a => Traversal' a a
    Traversal' a a
    uniplate) s -> a
    field s
    s of
            Maybe (Int, Context a a s)
    Nothing                 -> a -> s
    k (a -> s) -> f a -> f s
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> p a (f a) -> [Int] -> a -> f a
    forall a b. p a b -> [Int] -> a -> b
    forall i (p :: * -> * -> *) a b.
    Indexable i p =>
    p a b -> i -> a -> b
    indexed p a (f a)
    f ([Int] -> [Int]
    forall a. [a] -> [a]
    reverse [Int]
    is) a
    a
            Just (Int
    j, Context a -> s
    k' a
    a') -> [Int] -> Traversal' s a -> (a -> s) -> a -> f s
    go (Int
    jInt -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    is) ((a -> f a) -> s -> f s
    Traversal' s a
    l((a -> f a) -> s -> f s)
    -> ((a -> f a) -> a -> f a) -> (a -> f a) -> s -> f s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .LensLike (Indexing f) a a a a
    -> Int -> IndexedLensLike Int f a a a a
    forall (f :: * -> *) s t a.
    Applicative f =>
    LensLike (Indexing f) s t a a
    -> Int -> IndexedLensLike Int f s t a a
    elementOf LensLike (Indexing f) a a a a
    forall a. Data a => Traversal' a a
    Traversal' a a
    uniplate Int
    j) a -> s
    k' a
    a'
        in [Int] -> Traversal' s a -> (a -> s) -> a -> f s
    go [Int
    i] (LensLike (Indexing f) s s a a
    -> Int -> IndexedLensLike Int f s s a a
    forall (f :: * -> *) s t a.
    Applicative f =>
    LensLike (Indexing f) s t a a
    -> Int -> IndexedLensLike Int f s t a a
    elementOf LensLike (Indexing f) s s a a
    forall s a. (Data s, Typeable a) => Traversal' s a
    Traversal' s a
    template Int
    i) a -> s
    k0 a
    a0
    {-# INLINE upon #-}

    -- | The design of 'onceUpon'' doesn't allow it to search inside of values of type 'a' for other values of type 'a'.
    -- 'upon'' provides this additional recursion.
    --
    -- Like 'onceUpon'', 'upon'' trusts the user supplied function more than 'upon' using it directly
    -- as the accessor. This enables reading from the resulting 'Lens' to be considerably faster at the risk of
    -- generating an illegal lens.
    --
    -- >>> upon' (tail.tail) .~ [10,20] $ [1,2,3,4]
    -- [1,2,10,20]
    upon' :: forall s a. (Data s, Data a) => (s -> a) -> IndexedLens' [Int] s a
    upon' :: forall s a. (Data s, Data a) => (s -> a) -> IndexedLens' [Int] s a
    upon' s -> a
    field p a (f a)
    f s
    s = let
        ~([Int]
    isn, a -> s
    kn) = case LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    forall a s.
    Typeable a =>
    LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    lookupon LensLike' (Indexing Identity) s a
    forall s a. (Data s, Typeable a) => Traversal' s a
    Traversal' s a
    template s -> a
    field s
    s of
          Maybe (Int, Context a a s)
    Nothing -> (String -> [Int]
    forall a. HasCallStack => String -> a
    error String
    "upon': no index, not a member", s -> a -> s
    forall a b. a -> b -> a
    const s
    s)
          Just (Int
    i, Context a -> s
    k0 a
    _) -> [Int] -> Traversal' s a -> (a -> s) -> ([Int], a -> s)
    go [Int
    i] (LensLike (Indexing f) s s a a
    -> Int -> IndexedLensLike Int f s s a a
    forall (f :: * -> *) s t a.
    Applicative f =>
    LensLike (Indexing f) s t a a
    -> Int -> IndexedLensLike Int f s t a a
    elementOf LensLike (Indexing f) s s a a
    forall s a. (Data s, Typeable a) => Traversal' s a
    Traversal' s a
    template Int
    i) a -> s
    k0
        go :: [Int] -> Traversal' s a -> (a -> s) -> ([Int], a -> s)
        go :: [Int] -> Traversal' s a -> (a -> s) -> ([Int], a -> s)
    go [Int]
    is Traversal' s a
    l a -> s
    k = case LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    forall a s.
    Typeable a =>
    LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    lookupon (LensLike' (Indexing Identity) s a
    Traversal' s a
    lLensLike' (Indexing Identity) s a
    -> ((a -> Indexing Identity a) -> a -> Indexing Identity a)
    -> LensLike' (Indexing Identity) s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(a -> Indexing Identity a) -> a -> Indexing Identity a
    forall a. Data a => Traversal' a a
    Traversal' a a
    uniplate) s -> a
    field s
    s of
          Maybe (Int, Context a a s)
    Nothing                -> ([Int] -> [Int]
    forall a. [a] -> [a]
    reverse [Int]
    is, a -> s
    k)
          Just (Int
    j, Context a -> s
    k' a
    _) -> [Int] -> Traversal' s a -> (a -> s) -> ([Int], a -> s)
    go (Int
    jInt -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    is) ((a -> f a) -> s -> f s
    Traversal' s a
    l((a -> f a) -> s -> f s)
    -> ((a -> f a) -> a -> f a) -> (a -> f a) -> s -> f s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .LensLike (Indexing f) a a a a
    -> Int -> IndexedLensLike Int f a a a a
    forall (f :: * -> *) s t a.
    Applicative f =>
    LensLike (Indexing f) s t a a
    -> Int -> IndexedLensLike Int f s t a a
    elementOf LensLike (Indexing f) a a a a
    forall a. Data a => Traversal' a a
    Traversal' a a
    uniplate Int
    j) a -> s
    k'
      in a -> s
    kn (a -> s) -> f a -> f s
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> p a (f a) -> [Int] -> a -> f a
    forall a b. p a b -> [Int] -> a -> b
    forall i (p :: * -> * -> *) a b.
    Indexable i p =>
    p a b -> i -> a -> b
    indexed p a (f a)
    f [Int]
    isn (s -> a
    field s
    s)
    {-# INLINE upon' #-}

    -- | This automatically constructs a 'Traversal'' from a field accessor.
    --
    -- The index of the 'Traversal' can be used as an offset into @'elementOf' ('indexing' 'template')@ or into the list
    -- returned by @'holesOf' 'template'@.
    --
    -- The design of 'onceUpon' doesn't allow it to search inside of values of type 'a' for other values of type 'a'.
    -- 'upon' provides this additional recursion, but at the expense of performance.
    --
    -- >>> onceUpon (tail.tail) .~ [10,20] $ [1,2,3,4] -- BAD
    -- [1,10,20]
    --
    -- >>> upon (tail.tail) .~ [10,20] $ [1,2,3,4] -- GOOD
    -- [1,2,10,20]
    --
    -- When in doubt, use 'upon' instead.
    onceUpon :: forall s a. (Data s, Typeable a) => (s -> a) -> IndexedTraversal' Int s a
    onceUpon :: forall s a.
    (Data s, Typeable a) =>
    (s -> a) -> IndexedTraversal' Int s a
    onceUpon s -> a
    field p a (f a)
    f s
    s = case LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    forall a s.
    Typeable a =>
    LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    lookupon LensLike' (Indexing Identity) s a
    forall s a. (Data s, Typeable a) => Traversal' s a
    Traversal' s a
    template s -> a
    field s
    s of
      Maybe (Int, Context a a s)
    Nothing               -> s -> f s
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure s
    s
      Just (Int
    i, Context a -> s
    k a
    a) -> a -> s
    k (a -> s) -> f a -> f s
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> p a (f a) -> Int -> a -> f a
    forall a b. p a b -> Int -> a -> b
    forall i (p :: * -> * -> *) a b.
    Indexable i p =>
    p a b -> i -> a -> b
    indexed p a (f a)
    f Int
    i a
    a
    {-# INLINE onceUpon #-}

    -- | This more trusting version of 'upon' uses your function directly as the getter for a 'Lens'.
    --
    -- This means that reading from 'upon'' is considerably faster than 'upon'.
    --
    -- However, you pay for faster access in two ways:
    --
    -- 1. When passed an illegal field accessor, 'upon'' will give you a 'Lens' that quietly violates
    --    the laws, unlike 'upon', which will give you a legal 'Traversal' that avoids modifying the target.
    --
    -- 2. Modifying with the lens is slightly slower, since it has to go back and calculate the index after the fact.
    --
    -- When given a legal field accessor, the index of the 'Lens' can be used as an offset into
    -- @'elementOf' ('indexed' 'template')@ or into the list returned by @'holesOf' 'template'@.
    --
    -- When in doubt, use 'upon'' instead.
    onceUpon' :: forall s a. (Data s, Typeable a) => (s -> a) -> IndexedLens' Int s a
    onceUpon' :: forall s a.
    (Data s, Typeable a) =>
    (s -> a) -> IndexedLens' Int s a
    onceUpon' s -> a
    field p a (f a)
    f s
    s = a -> s
    k (a -> s) -> f a -> f s
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> p a (f a) -> Int -> a -> f a
    forall a b. p a b -> Int -> a -> b
    forall i (p :: * -> * -> *) a b.
    Indexable i p =>
    p a b -> i -> a -> b
    indexed p a (f a)
    f Int
    i (s -> a
    field s
    s) where
      ~(Int
    i, Context a -> s
    k a
    _) = (Int, Context a a s)
    -> Maybe (Int, Context a a s) -> (Int, Context a a s)
    forall a. a -> Maybe a -> a
    fromMaybe (String -> (Int, Context a a s)
    forall a. HasCallStack => String -> a
    error String
    "upon': no index, not a member") (LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    forall a s.
    Typeable a =>
    LensLike' (Indexing Identity) s a
    -> (s -> a) -> s -> Maybe (Int, Context a a s)
    lookupon LensLike' (Indexing Identity) s a
    forall s a. (Data s, Typeable a) => Traversal' s a
    Traversal' s a
    template s -> a
    field s
    s)
    {-# INLINE onceUpon' #-}

    -------------------------------------------------------------------------------
    -- Data Box
    -------------------------------------------------------------------------------

    data DataBox = forall a. Data a => DataBox
      { DataBox -> TypeRep
    dataBoxKey :: TypeRep
      , ()
    _dataBoxVal :: a
      }

    dataBox :: Data a => a -> DataBox
    dataBox :: forall a. Data a => a -> DataBox
    dataBox a
    a = TypeRep -> a -> DataBox
    forall a. Data a => TypeRep -> a -> DataBox
    DataBox ([a] -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    X.typeRep [a
    a]) a
    a
    {-# INLINE dataBox #-}

    -- partial, caught elsewhere
    sybChildren :: Data a => a -> [DataBox]
    sybChildren :: forall a. Data a => a -> [DataBox]
    sybChildren a
    x
      | DataType -> Bool
    isAlgType DataType
    dt = do
        c <- DataType -> [Constr]
    dataTypeConstrs DataType
    dt
        gmapQ dataBox (fromConstr c `asTypeOf` x)
      | Bool
    otherwise = []
      where dt :: DataType
    dt = a -> DataType
    forall a. Data a => a -> DataType
    dataTypeOf a
    x
    {-# INLINE sybChildren #-}

    -------------------------------------------------------------------------------
    -- HitMap
    -------------------------------------------------------------------------------

    type HitMap = HashMap TypeRep (HashSet TypeRep)

    emptyHitMap :: HitMap
    emptyHitMap :: HitMap
    emptyHitMap = [(TypeRep, HashSet TypeRep)] -> HitMap
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    M.fromList
      [ (TypeRep
    tRational, TypeRep -> HashSet TypeRep
    forall a. Hashable a => a -> HashSet a
    S.singleton TypeRep
    tInteger)
      , (TypeRep
    tInteger,  HashSet TypeRep
    forall a. HashSet a
    S.empty)
      ] where
      tRational :: TypeRep
    tRational = Proxy Rational -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    X.typeRep (Proxy Rational
    forall {k} (t :: k). Proxy t
    X.Proxy :: X.Proxy Rational)
      tInteger :: TypeRep
    tInteger  = Proxy Integer -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    X.typeRep (Proxy Integer
    forall {k} (t :: k). Proxy t
    X.Proxy :: X.Proxy Integer )

    insertHitMap :: DataBox -> HitMap -> HitMap
    insertHitMap :: DataBox -> HitMap -> HitMap
    insertHitMap DataBox
    box HitMap
    hit = (HitMap -> HitMap) -> HitMap -> HitMap
    forall a. Eq a => (a -> a) -> a -> a
    fixEq HitMap -> HitMap
    trans (DataBox -> HitMap
    populate DataBox
    box) HitMap -> HitMap -> HitMap
    forall a. Monoid a => a -> a -> a
    `mappend` HitMap
    hit where
      populate :: DataBox -> HitMap
      populate :: DataBox -> HitMap
    populate DataBox
    a = DataBox -> HitMap -> HitMap
    f DataBox
    a HitMap
    forall k v. HashMap k v
    M.empty where
        f :: DataBox -> HitMap -> HitMap
    f (DataBox TypeRep
    k a
    v) HitMap
    m
          | TypeRep -> HitMap -> Bool
    forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
    M.member TypeRep
    k HitMap
    hit Bool -> Bool -> Bool
    || TypeRep -> HitMap -> Bool
    forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
    M.member TypeRep
    k HitMap
    m = HitMap
    m
          | [DataBox]
    cs <- a -> [DataBox]
    forall a. Data a => a -> [DataBox]
    sybChildren a
    v = [DataBox] -> HitMap -> HitMap
    fs [DataBox]
    cs (HitMap -> HitMap) -> HitMap -> HitMap
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> HashSet TypeRep -> HitMap -> HitMap
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    M.insert TypeRep
    k ([TypeRep] -> HashSet TypeRep
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    S.fromList ([TypeRep] -> HashSet TypeRep) -> [TypeRep] -> HashSet TypeRep
    forall a b. (a -> b) -> a -> b
    $ (DataBox -> TypeRep) -> [DataBox] -> [TypeRep]
    forall a b. (a -> b) -> [a] -> [b]
    map DataBox -> TypeRep
    dataBoxKey [DataBox]
    cs) HitMap
    m
        fs :: [DataBox] -> HitMap -> HitMap
    fs []     HitMap
    m = HitMap
    m
        fs (DataBox
    x:[DataBox]
    xs) HitMap
    m = [DataBox] -> HitMap -> HitMap
    fs [DataBox]
    xs (DataBox -> HitMap -> HitMap
    f DataBox
    x HitMap
    m)

      trans :: HitMap -> HitMap
      trans :: HitMap -> HitMap
    trans HitMap
    m = (HashSet TypeRep -> HashSet TypeRep) -> HitMap -> HitMap
    forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
    M.map HashSet TypeRep -> HashSet TypeRep
    f HitMap
    m where
        f :: HashSet TypeRep -> HashSet TypeRep
    f HashSet TypeRep
    x = HashSet TypeRep
    x HashSet TypeRep -> HashSet TypeRep -> HashSet TypeRep
    forall a. Monoid a => a -> a -> a
    `mappend` (TypeRep -> HashSet TypeRep) -> HashSet TypeRep -> HashSet TypeRep
    forall m a. Monoid m => (a -> m) -> HashSet a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap TypeRep -> HashSet TypeRep
    g HashSet TypeRep
    x
        g :: TypeRep -> HashSet TypeRep
    g TypeRep
    x = HashSet TypeRep -> Maybe (HashSet TypeRep) -> HashSet TypeRep
    forall a. a -> Maybe a -> a
    fromMaybe (HitMap
    hit HitMap -> TypeRep -> HashSet TypeRep
    forall k v.
    (Eq k, Hashable k, HasCallStack) =>
    HashMap k v -> k -> v
    ! TypeRep
    x) (TypeRep -> HitMap -> Maybe (HashSet TypeRep)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    M.lookup TypeRep
    x HitMap
    m)

    fixEq :: Eq a => (a -> a) -> a -> a
    fixEq :: forall a. Eq a => (a -> a) -> a -> a
    fixEq a -> a
    f = a -> a
    go where
      go :: a -> a
    go a
    x | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    x'   = a
    x'
           | Bool
    otherwise = a -> a
    go a
    x'
           where x' :: a
    x' = a -> a
    f a
    x
    {-# INLINE fixEq #-}

    -- | inlineable 'unsafePerformIO'
    inlinePerformIO :: IO a -> a
    inlinePerformIO :: forall a. IO a -> a
    inlinePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
    m) = case State# RealWorld -> (# State# RealWorld, a #)
    m State# RealWorld
    realWorld# of
      (# State# RealWorld
    _, a
    r #) -> a
    r
    {-# INLINE inlinePerformIO #-}

    -------------------------------------------------------------------------------
    -- Cache
    -------------------------------------------------------------------------------

    data Cache = Cache HitMap (HashMap TypeRep (HashMap TypeRep (Maybe Follower)))

    cache :: IORef Cache
    cache :: IORef Cache
    cache = IO (IORef Cache) -> IORef Cache
    forall a. IO a -> a
    unsafePerformIO (IO (IORef Cache) -> IORef Cache)
    -> IO (IORef Cache) -> IORef Cache
    forall a b. (a -> b) -> a -> b
    $ Cache -> IO (IORef Cache)
    forall a. a -> IO (IORef a)
    newIORef (Cache -> IO (IORef Cache)) -> Cache -> IO (IORef Cache)
    forall a b. (a -> b) -> a -> b
    $ HitMap
    -> HashMap TypeRep (HashMap TypeRep (Maybe Follower)) -> Cache
    Cache HitMap
    emptyHitMap HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    forall k v. HashMap k v
    M.empty
    {-# NOINLINE cache #-}

    readCacheFollower :: DataBox -> TypeRep -> Maybe Follower
    readCacheFollower :: DataBox -> TypeRep -> Maybe Follower
    readCacheFollower b :: DataBox
    b@(DataBox TypeRep
    kb a
    _) TypeRep
    ka = IO (Maybe Follower) -> Maybe Follower
    forall a. IO a -> a
    inlinePerformIO (IO (Maybe Follower) -> Maybe Follower)
    -> IO (Maybe Follower) -> Maybe Follower
    forall a b. (a -> b) -> a -> b
    $
      IORef Cache -> IO Cache
    forall a. IORef a -> IO a
    readIORef IORef Cache
    cache IO Cache -> (Cache -> IO (Maybe Follower)) -> IO (Maybe Follower)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ (Cache HitMap
    hm HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    m) -> case TypeRep
    -> HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    -> Maybe (HashMap TypeRep (Maybe Follower))
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    M.lookup TypeRep
    kb HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    m Maybe (HashMap TypeRep (Maybe Follower))
    -> (HashMap TypeRep (Maybe Follower) -> Maybe (Maybe Follower))
    -> Maybe (Maybe Follower)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= TypeRep
    -> HashMap TypeRep (Maybe Follower) -> Maybe (Maybe Follower)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    M.lookup TypeRep
    ka of
        Just Maybe Follower
    a -> Maybe Follower -> IO (Maybe Follower)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Follower
    a
        Maybe (Maybe Follower)
    Nothing -> IO HitMap -> IO (Either SomeException HitMap)
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (HitMap -> IO HitMap
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HitMap -> IO HitMap) -> HitMap -> IO HitMap
    forall a b. (a -> b) -> a -> b
    $! DataBox -> HitMap -> HitMap
    insertHitMap DataBox
    b HitMap
    hm) IO (Either SomeException HitMap)
    -> (Either SomeException HitMap -> IO (Maybe Follower))
    -> IO (Maybe Follower)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Either SomeException HitMap
    r -> case Either SomeException HitMap
    r of
          Left SomeException{}                         -> IORef Cache
    -> (Cache -> (Cache, Maybe Follower)) -> IO (Maybe Follower)
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef Cache
    cache ((Cache -> (Cache, Maybe Follower)) -> IO (Maybe Follower))
    -> (Cache -> (Cache, Maybe Follower)) -> IO (Maybe Follower)
    forall a b. (a -> b) -> a -> b
    $ \(Cache HitMap
    hm' HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    n) -> (HitMap
    -> HashMap TypeRep (HashMap TypeRep (Maybe Follower)) -> Cache
    Cache HitMap
    hm' (TypeRep
    -> TypeRep
    -> Maybe Follower
    -> HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    -> HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    forall a.
    TypeRep
    -> TypeRep
    -> a
    -> HashMap TypeRep (HashMap TypeRep a)
    -> HashMap TypeRep (HashMap TypeRep a)
    insert2 TypeRep
    kb TypeRep
    ka Maybe Follower
    forall a. Maybe a
    Nothing HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    n), Maybe Follower
    forall a. Maybe a
    Nothing)
          Right HitMap
    hm' | Maybe Follower
    fol <- Follower -> Maybe Follower
    forall a. a -> Maybe a
    Just (TypeRep -> TypeRep -> HitMap -> Follower
    follower TypeRep
    kb TypeRep
    ka HitMap
    hm') -> IORef Cache
    -> (Cache -> (Cache, Maybe Follower)) -> IO (Maybe Follower)
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef Cache
    cache ((Cache -> (Cache, Maybe Follower)) -> IO (Maybe Follower))
    -> (Cache -> (Cache, Maybe Follower)) -> IO (Maybe Follower)
    forall a b. (a -> b) -> a -> b
    $ \(Cache HitMap
    _ HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    n) -> (HitMap
    -> HashMap TypeRep (HashMap TypeRep (Maybe Follower)) -> Cache
    Cache HitMap
    hm' (TypeRep
    -> TypeRep
    -> Maybe Follower
    -> HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    -> HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    forall a.
    TypeRep
    -> TypeRep
    -> a
    -> HashMap TypeRep (HashMap TypeRep a)
    -> HashMap TypeRep (HashMap TypeRep a)
    insert2 TypeRep
    kb TypeRep
    ka Maybe Follower
    fol HashMap TypeRep (HashMap TypeRep (Maybe Follower))
    n),    Maybe Follower
    fol)

    insert2 :: TypeRep -> TypeRep -> a -> HashMap TypeRep (HashMap TypeRep a) -> HashMap TypeRep (HashMap TypeRep a)
    insert2 :: forall a.
    TypeRep
    -> TypeRep
    -> a
    -> HashMap TypeRep (HashMap TypeRep a)
    -> HashMap TypeRep (HashMap TypeRep a)
    insert2 TypeRep
    x TypeRep
    y a
    v = (HashMap TypeRep a -> HashMap TypeRep a -> HashMap TypeRep a)
    -> TypeRep
    -> HashMap TypeRep a
    -> HashMap TypeRep (HashMap TypeRep a)
    -> HashMap TypeRep (HashMap TypeRep a)
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
    M.insertWith ((HashMap TypeRep a -> HashMap TypeRep a)
    -> HashMap TypeRep a -> HashMap TypeRep a -> HashMap TypeRep a
    forall a b. a -> b -> a
    const ((HashMap TypeRep a -> HashMap TypeRep a)
     -> HashMap TypeRep a -> HashMap TypeRep a -> HashMap TypeRep a)
    -> (HashMap TypeRep a -> HashMap TypeRep a)
    -> HashMap TypeRep a
    -> HashMap TypeRep a
    -> HashMap TypeRep a
    forall a b. (a -> b) -> a -> b
    $ TypeRep -> a -> HashMap TypeRep a -> HashMap TypeRep a
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    M.insert TypeRep
    y a
    v) TypeRep
    x (TypeRep -> a -> HashMap TypeRep a
    forall k v. Hashable k => k -> v -> HashMap k v
    M.singleton TypeRep
    y a
    v)
    {-# INLINE insert2 #-}

    {-
    readCacheHitMap :: DataBox -> Maybe HitMap
    readCacheHitMap b@(DataBox kb _) = inlinePerformIO $
      readIORef cache >>= \ (Cache hm _) -> case M.lookup kb hm of
        Just _  -> return $ Just hm
        Nothing -> E.try (return $! insertHitMap b hm) >>= \r -> case r of
          Left SomeException{} -> return Nothing
          Right hm' -> atomicModifyIORef cache $ \(Cache _ follow) -> (Cache hm' follow, Just hm')
    -}

    -------------------------------------------------------------------------------
    -- Answers
    -------------------------------------------------------------------------------

    data Answer b a
      = b ~ a => Hit a
      | Follow
      | Miss

    -------------------------------------------------------------------------------
    -- Oracles
    -------------------------------------------------------------------------------

    newtype Oracle a = Oracle { forall a. Oracle a -> forall t. Typeable t => t -> Answer t a
    fromOracle :: forall t. Typeable t => t -> Answer t a }

    hitTest :: forall a b. (Data a, Typeable b) => a -> b -> Oracle b
    hitTest :: forall a b. (Data a, Typeable b) => a -> b -> Oracle b
    hitTest a
    a b
    b = (forall t. Typeable t => t -> Answer t b) -> Oracle b
    forall a. (forall t. Typeable t => t -> Answer t a) -> Oracle a
    Oracle ((forall t. Typeable t => t -> Answer t b) -> Oracle b)
    -> (forall t. Typeable t => t -> Answer t b) -> Oracle b
    forall a b. (a -> b) -> a -> b
    $ \(t
    c :: c) ->
      case Maybe (t :~: b)
    forall {k} (a :: k) (b :: k).
    (Typeable a, Typeable b) =>
    Maybe (a :~: b)
    X.eqT :: Maybe (c X.:~: b) of
        Just t :~: b
    X.Refl -> b -> Answer t b
    forall b a. (b ~ a) => a -> Answer b a
    Hit b
    t
    c
        Maybe (t :~: b)
    Nothing ->
          case DataBox -> TypeRep -> Maybe Follower
    readCacheFollower (a -> DataBox
    forall a. Data a => a -> DataBox
    dataBox a
    a) (b -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf b
    b) of
            Just Follower
    p | Bool -> Bool
    not (Follower
    p (t -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf t
    c)) -> Answer t b
    forall b a. Answer b a
    Miss
            Maybe Follower
    _ -> Answer t b
    forall b a. Answer b a
    Follow

    -------------------------------------------------------------------------------
    -- Traversals
    -------------------------------------------------------------------------------

    biplateData :: forall f s a. (Applicative f, Data s) => (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s
    biplateData :: forall (f :: * -> *) s a.
    (Applicative f, Data s) =>
    (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s
    biplateData forall c. Typeable c => c -> Answer c a
    o a -> f a
    f = s -> f s
    forall d. Data d => d -> f d
    go2 where
      go :: Data d => d -> f d
      go :: forall d. Data d => d -> f d
    go = (forall d b. Data d => f (d -> b) -> d -> f b)
    -> (forall g. g -> f g) -> d -> f d
    forall a (c :: * -> *).
    Data a =>
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> d -> c d
    gfoldl (\f (d -> b)
    x d
    y -> f (d -> b)
    x f (d -> b) -> f d -> f b
    forall a b. f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> d -> f d
    forall d. Data d => d -> f d
    go2 d
    y) g -> f g
    forall g. g -> f g
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      go2 :: Data d => d -> f d
      go2 :: forall d. Data d => d -> f d
    go2 d
    s = case d -> Answer d a
    forall c. Typeable c => c -> Answer c a
    o d
    s of
        Hit a
    a  -> a -> f a
    f a
    a
        Answer d a
    Follow -> d -> f d
    forall d. Data d => d -> f d
    go d
    s
        Answer d a
    Miss   -> d -> f d
    forall g. g -> f g
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure d
    s
    {-# INLINE biplateData #-}

    uniplateData :: forall f s a. (Applicative f, Data s) => (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s
    uniplateData :: forall (f :: * -> *) s a.
    (Applicative f, Data s) =>
    (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s
    uniplateData forall c. Typeable c => c -> Answer c a
    o a -> f a
    f = s -> f s
    forall d. Data d => d -> f d
    go where
      go :: Data d => d -> f d
      go :: forall d. Data d => d -> f d
    go = (forall d b. Data d => f (d -> b) -> d -> f b)
    -> (forall g. g -> f g) -> d -> f d
    forall a (c :: * -> *).
    Data a =>
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> d -> c d
    gfoldl (\f (d -> b)
    x d
    y -> f (d -> b)
    x f (d -> b) -> f d -> f b
    forall a b. f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> d -> f d
    forall d. Data d => d -> f d
    go2 d
    y) g -> f g
    forall g. g -> f g
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      go2 :: Data d => d -> f d
      go2 :: forall d. Data d => d -> f d
    go2 d
    s = case d -> Answer d a
    forall c. Typeable c => c -> Answer c a
    o d
    s of
        Hit a
    a  -> a -> f a
    f a
    a
        Answer d a
    Follow -> d -> f d
    forall d. Data d => d -> f d
    go d
    s
        Answer d a
    Miss   -> d -> f d
    forall g. g -> f g
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure d
    s
    {-# INLINE uniplateData #-}

    -------------------------------------------------------------------------------
    -- Follower
    -------------------------------------------------------------------------------

    part :: (a -> Bool) -> HashSet a -> (HashSet a, HashSet a)
    part :: forall a. (a -> Bool) -> HashSet a -> (HashSet a, HashSet a)
    part a -> Bool
    p HashSet a
    s = ((a -> Bool) -> HashSet a -> HashSet a
    forall a. (a -> Bool) -> HashSet a -> HashSet a
    S.filter a -> Bool
    p HashSet a
    s, (a -> Bool) -> HashSet a -> HashSet a
    forall a. (a -> Bool) -> HashSet a -> HashSet a
    S.filter (Bool -> Bool
    not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Bool
    p) HashSet a
    s)
    {-# INLINE part #-}

    type Follower = TypeRep -> Bool

    follower :: TypeRep -> TypeRep -> HitMap -> Follower
    follower :: TypeRep -> TypeRep -> HitMap -> Follower
    follower TypeRep
    a TypeRep
    b HitMap
    m
      | HashSet TypeRep -> Bool
    forall a. HashSet a -> Bool
    S.null HashSet TypeRep
    hit               = Bool -> Follower
    forall a b. a -> b -> a
    const Bool
    False
      | HashSet TypeRep -> Bool
    forall a. HashSet a -> Bool
    S.null HashSet TypeRep
    miss              = Bool -> Follower
    forall a b. a -> b -> a
    const Bool
    True
      | HashSet TypeRep -> Int
    forall a. HashSet a -> Int
    S.size HashSet TypeRep
    hit Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < HashSet TypeRep -> Int
    forall a. HashSet a -> Int
    S.size HashSet TypeRep
    miss = TypeRep -> HashSet TypeRep -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    S.member (TypeRep -> HashSet TypeRep -> Bool) -> HashSet TypeRep -> Follower
    forall (f :: * -> *) a b. Functor f => f (a -> b) -> a -> f b
    ?? HashSet TypeRep
    hit
      | Bool
    otherwise = \TypeRep
    k -> Bool -> Bool
    not (TypeRep -> HashSet TypeRep -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    S.member TypeRep
    k HashSet TypeRep
    miss)
      where (HashSet TypeRep
    hit, HashSet TypeRep
    miss) = Follower -> HashSet TypeRep -> (HashSet TypeRep, HashSet TypeRep)
    forall a. (a -> Bool) -> HashSet a -> (HashSet a, HashSet a)
    part (\TypeRep
    x -> TypeRep -> HashSet TypeRep -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    S.member TypeRep
    b (HitMap
    m HitMap -> TypeRep -> HashSet TypeRep
    forall k v.
    (Eq k, Hashable k, HasCallStack) =>
    HashMap k v -> k -> v
    ! TypeRep
    x)) (TypeRep -> HashSet TypeRep -> HashSet TypeRep
    forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
    S.insert TypeRep
    a (HitMap
    m HitMap -> TypeRep -> HashSet TypeRep
    forall k v.
    (Eq k, Hashable k, HasCallStack) =>
    HashMap k v -> k -> v
    ! TypeRep
    a))