    {-# LANGUAGE CPP #-}
    -- | @th-reify-many@ provides functions for recursively reifying top
    -- level declarations.  The main intended use case is for enumerating
    -- the names of datatypes reachable from an initial datatype, and
    -- passing these names to some function which generates instances.
    --
    -- For example, in order to define 'Language.Haskell.TH.Syntax.Lift'
    -- instances for two mutually recursive datatypes, I could write
    -- something like:
    --
    -- > {-# LANGUAGE TemplateHaskell #-}
    -- > import Language.Haskell.TH.ReifyMany (reifyManyWithoutInstances)
    -- > import Language.Haskell.TH.Lift (Lift(..), deriveLiftMany)
    -- >
    -- > data A = A B
    -- >
    -- > data B = B Int
    -- >
    -- > $(reifyManyWithoutInstances ''Lift [''A] (const True) >>= deriveLiftMany)
    --
    -- One interesting feature of this is that it attempts to omit the
    -- types which already have an instance defined.  For example, if
    -- @$(deriveLift ''B)@ is used before @deriveLiftMany@, it will omit
    -- the instance for B.
    --
    -- Of course, the intended usecase for this involves many more
    -- datatypes - for example, syntax trees such as those found in TH.
    --
    -- Note that 'reifyManyWithoutInstances' is rather imperfect in its
    -- testing of whether an instance exists, and whether an instance
    -- should exist.  See this function's docs for details.
    module Language.Haskell.TH.ReifyMany where

    import qualified Control.Monad.State as State
    import           Data.Maybe (isNothing)
    import qualified Data.Set as S
    import           Language.Haskell.TH
    import           Language.Haskell.TH.ReifyMany.Internal

    -- | Recursively enumerates type constructor declarations, halting
    -- when datatypes appear to already have an instance for the typeclass
    -- specified by the first 'Name' parameter.  It guesses that an
    -- instance exists for a given datatype if it's used in the top
    -- constructor of any of its parameters (see 'instanceMatches').
    --
    -- This function is useful for bulk defining typeclass instances like
    -- @Binary@, @Lift@, @Data@, @Typeable@, etc.  It isn't very clever,
    -- though - in particular it has the following limitations:
    --
    -- * It only works well when type constructors mentioned in
    --   fields should all have instances defined for them.
    --
    -- * It ignores data type / constructor constraints.
    --
    -- * It ignores data / type families.
    --
    -- It also takes a user-defined predicate, which is useful in
    -- situations where this attempts to descend into datatypes which do
    -- not need instances defined for them.
    --
    -- Note that this will always initially yield the 'Name's of the
    -- initial types, regardless of whether they are instances or not.
    reifyManyWithoutInstances :: Name -> [Name] -> (Name -> Bool) -> Q [Name]
    reifyManyWithoutInstances :: Name -> [Name] -> (Name -> Bool) -> Q [Name]
    reifyManyWithoutInstances Name
    clz [Name]
    initial Name -> Bool
    recursePred = do
        insts <- Name -> Q [TypeclassInstance]
    getInstances Name
    clz
        let recurse (Name
    name, Dec
    dec)
                | Name -> Bool
    recursePred Name
    name Bool -> Bool -> Bool
    && Maybe TypeclassInstance -> Bool
    forall a. Maybe a -> Bool
    isNothing ([TypeclassInstance] -> Name -> Maybe TypeclassInstance
    lookupInstance [TypeclassInstance]
    insts Name
    name) = do
                    (Bool, [Name]) -> m (Bool, [Name])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Dec -> Bool
    isDataDec Dec
    dec, Dec -> [Name]
    decConcreteNames Dec
    dec)
            recurse (Name, Dec)
    _ = (Bool, [Name]) -> m (Bool, [Name])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, [])
        infos <- reifyManyTyCons recurse initial
        return (map fst infos)

    -- | Like 'reifyMany', but specialized for recursively enumerating
    -- type constructor declarations, omitting 'PrimTyConI'.
    --
    -- In order to have this behave like 'reifyManyWithoutInstances', but
    -- not do any instance filtering, use it with the 'isDataDec' and
    -- 'decConcreteNames' internal utilities.  For example:
    --
    -- > {-# LANGUAGE TemplateHaskell #-}
    -- > import Language.Haskell.TH
    -- > import Language.Haskell.TH.ReifyMany
    -- > import Language.Haskell.TH.ReifyMany.Internal
    -- >
    -- > $(do results <- reifyManyTyCons
    -- >          (\(_, dec) -> return (isDataDec dec, decConcreteNames dec))
    -- >          [''Exp]
    -- >      -- Display the results
    -- >      reportError (show (map fst results))
    -- >      -- This TH splice doesn't generate any code.
    -- >      return []
    -- >  )
    reifyManyTyCons :: ((Name, Dec) -> Q (Bool, [Name]))
                    -> [Name]
                    -> Q [(Name, Info)]
    reifyManyTyCons :: ((Name, Dec) -> Q (Bool, [Name])) -> [Name] -> Q [(Name, Info)]
    reifyManyTyCons (Name, Dec) -> Q (Bool, [Name])
    recurse = ((Name, Info) -> Q (Bool, [Name])) -> [Name] -> Q [(Name, Info)]
    reifyMany (Name, Info) -> Q (Bool, [Name])
    recurse'
      where
        recurse' :: (Name, Info) -> Q (Bool, [Name])
    recurse' (Name
    name, Info
    info) = do
            let skip :: p -> m (Bool, [a])
    skip p
    _ = do
                    (Bool, [a]) -> m (Bool, [a])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, [])
                unexpected :: [Char] -> m a
    unexpected [Char]
    thing = do
                    [Char] -> m a
    forall a. [Char] -> m a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> m a) -> [Char] -> m a
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "reifyManyTyCons encountered unexpected " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    thing [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " named " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Name -> [Char]
    forall a. Ppr a => a -> [Char]
    pprint Name
    name
            case Info
    info of
                TyConI Dec
    dec -> (Name, Dec) -> Q (Bool, [Name])
    recurse (Name
    name, Dec
    dec)
                PrimTyConI{} -> [Char] -> Q (Bool, [Name])
    forall {m :: * -> *} {p} {a}. Monad m => p -> m (Bool, [a])
    skip [Char]
    "prim type constructor"
                DataConI{} -> [Char] -> Q (Bool, [Name])
    forall {m :: * -> *} {p} {a}. Monad m => p -> m (Bool, [a])
    skip [Char]
    "data constructor"
                ClassI{} -> [Char] -> Q (Bool, [Name])
    forall {m :: * -> *} {p} {a}. Monad m => p -> m (Bool, [a])
    skip [Char]
    "class"
                ClassOpI{} -> [Char] -> Q (Bool, [Name])
    forall {m :: * -> *} {a}. MonadFail m => [Char] -> m a
    unexpected [Char]
    "class method"
                VarI{} -> [Char] -> Q (Bool, [Name])
    forall {m :: * -> *} {a}. MonadFail m => [Char] -> m a
    unexpected [Char]
    "value variable"
                TyVarI{} -> [Char] -> Q (Bool, [Name])
    forall {m :: * -> *} {a}. MonadFail m => [Char] -> m a
    unexpected [Char]
    "type variable"
    #if MIN_VERSION_template_haskell(2,7,0)
                FamilyI{} -> [Char] -> Q (Bool, [Name])
    forall {m :: * -> *} {p} {a}. Monad m => p -> m (Bool, [a])
    skip [Char]
    "type or data family"
    #endif
    #if MIN_VERSION_template_haskell(2,12,0)
                PatSynI{} -> [Char] -> Q (Bool, [Name])
    forall {m :: * -> *} {p} {a}. Monad m => p -> m (Bool, [a])
    skip [Char]
    "pattern synonym"
    #endif

    -- | Starting from a set of initial top level declarations, specified
    -- by @[Name]@, recursively enumerate other related declarations.  The
    -- provided function determines whether the current info be included
    -- in the list of results, and which 'Name's to lookup next. This
    -- function handles keeping track of which 'Name's have already been
    -- visited.
    reifyMany :: ((Name, Info) -> Q (Bool, [Name]))
              -> [Name]
              -> Q [(Name, Info)]
    reifyMany :: ((Name, Info) -> Q (Bool, [Name])) -> [Name] -> Q [(Name, Info)]
    reifyMany (Name, Info) -> Q (Bool, [Name])
    recurse [Name]
    initial =
        StateT (Set Name) Q [(Name, Info)] -> Set Name -> Q [(Name, Info)]
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    State.evalStateT (([[(Name, Info)]] -> [(Name, Info)])
    -> StateT (Set Name) Q [[(Name, Info)]]
    -> StateT (Set Name) Q [(Name, Info)]
    forall a b.
    (a -> b) -> StateT (Set Name) Q a -> StateT (Set Name) Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[(Name, Info)]] -> [(Name, Info)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (StateT (Set Name) Q [[(Name, Info)]]
     -> StateT (Set Name) Q [(Name, Info)])
    -> StateT (Set Name) Q [[(Name, Info)]]
    -> StateT (Set Name) Q [(Name, Info)]
    forall a b. (a -> b) -> a -> b
    $ (Name -> StateT (Set Name) Q [(Name, Info)])
    -> [Name] -> StateT (Set Name) Q [[(Name, Info)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Name -> StateT (Set Name) Q [(Name, Info)]
    go [Name]
    initial) Set Name
    forall a. Set a
    S.empty
      where
        go :: Name -> State.StateT (S.Set Name) Q [(Name, Info)]
        go :: Name -> StateT (Set Name) Q [(Name, Info)]
    go Name
    n = do
            seen <- StateT (Set Name) Q (Set Name)
    forall s (m :: * -> *). MonadState s m => m s
    State.get
            if S.member n seen
                then return []
                else do
                    State.put (S.insert n seen)
                    info <- State.lift (reify n)
                    (shouldEmit, ns) <- State.lift $ recurse (n, info)
                    results <- fmap concat $ mapM go ns
                    if shouldEmit
                        then return ((n, info) : results)
                        else return results

    -- | Like 'getDatatypesWithoutInstanceOf', but more precise as it uses
    -- the 'isInstance' function
    --
    -- The typeclass is specified by a 'Name', and a function
    -- to take the concrete type to a list of the parameters for the
    -- typeclass.
    --
    -- FIXME: this code is disabled because "isInstance" doesn't do any
    -- recursive instance resolution.  For example, it yields 'True' when
    -- asked if the instance (Show [Int -> Int]) exists, since one exists
    -- for lists.
    {-
    getDataTypesWithoutInstancesOf' :: Name -> (Type -> [Type]) -> Name -> (Name -> Bool) -> Q [Name]
    getDataTypesWithoutInstancesOf' clz tysFunc initial recursePred = do
        let recurse (name, dec)
                | recursePred name && isNormalTyCon dec = do
                    let tys = concat (decToFieldTypes dec)
                    reportError ("before: " ++ show tys)
                    filtered <- filterM (fmap not . recover (return True) . isInstance clz . tysFunc) tys
                    State.when (not (null filtered)) $ reportError (show filtered)
                    return (isDataDec dec, concatMap typeConcreteNames filtered)
            recurse _ = return (False, [])
        infos <- reifyManyTyCons recurse initial
        return (map fst infos)
    -}