    {-# LANGUAGE CPP #-}
    module Extract (Module(..), extract) where

    import           Imports hiding (mod, concat)
    import           Data.List (partition, isSuffixOf)

    import           Control.DeepSeq (deepseq, NFData(rnf))
    import           Data.Generics

    #if __GLASGOW_HASKELL__ < 900
    import           GHC hiding (Module, Located)
    import           DynFlags
    import           MonadUtils (liftIO)
    #else
    import           GHC hiding (Module, Located)
    import           GHC.Driver.Session
    import           GHC.Utils.Monad (liftIO)
    #endif

    #if __GLASGOW_HASKELL__ < 900
    import           Digraph (flattenSCCs)
    import           Exception (ExceptionMonad)
    #else
    import           GHC.Data.Graph.Directed (flattenSCCs)
    import           GHC.Utils.Exception (ExceptionMonad)
    import           Control.Monad.Catch (generalBracket)
    #endif

    import           System.Directory
    import           System.FilePath

    import           System.Posix.Internals (c_getpid)

    import           GhcUtil (withGhc)
    import           Location hiding (unLoc)

    import           Util (convertDosLineEndings)
    import           PackageDBs (getPackageDBArgs)

    #if __GLASGOW_HASKELL__ < 900
    import           DynamicLoading (initializePlugins)
    #else
    import           GHC.Runtime.Loader (initializePlugins)
    #endif

    #if __GLASGOW_HASKELL__ >= 901
    import           GHC.Unit.Module.Graph
    #endif

    -- | A wrapper around `SomeException`, to allow for a custom `Show` instance.
    newtype ExtractError = ExtractError SomeException
    #if __GLASGOW_HASKELL__ < 912
      deriving Typeable
    #endif

    instance Show ExtractError where
      show :: ExtractError -> String
    show (ExtractError SomeException
    e) =
        [String] -> String
    unlines [
            String
    "Ouch! Hit an error thunk in GHC's AST while extracting documentation."
          , String
    ""
          , String
    "    " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg
          , String
    ""
          , String
    "This is most likely a bug in doctest."
          , String
    ""
          , String
    "Please report it here: https://github.com/sol/doctest/issues/new"
          ]
        where
          msg :: String
    msg = case SomeException -> Maybe GhcException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e of
            Just (Panic String
    s) -> String
    "GHC panic: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s
            Maybe GhcException
    _              -> SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e

    instance Exception ExtractError

    -- | Documentation for a module grouped together with the modules name.
    data Module a = Module {
      forall a. Module a -> String
    moduleName    :: String
    , forall a. Module a -> Maybe a
    moduleSetup   :: Maybe a
    , forall a. Module a -> [a]
    moduleContent :: [a]
    } deriving (Module a -> Module a -> Bool
    (Module a -> Module a -> Bool)
    -> (Module a -> Module a -> Bool) -> Eq (Module a)
    forall a. Eq a => Module a -> Module a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => Module a -> Module a -> Bool
    == :: Module a -> Module a -> Bool
    $c/= :: forall a. Eq a => Module a -> Module a -> Bool
    /= :: Module a -> Module a -> Bool
    Eq, Int -> Module a -> ShowS
    [Module a] -> ShowS
    Module a -> String
    (Int -> Module a -> ShowS)
    -> (Module a -> String) -> ([Module a] -> ShowS) -> Show (Module a)
    forall a. Show a => Int -> Module a -> ShowS
    forall a. Show a => [Module a] -> ShowS
    forall a. Show a => Module a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Module a -> ShowS
    showsPrec :: Int -> Module a -> ShowS
    $cshow :: forall a. Show a => Module a -> String
    show :: Module a -> String
    $cshowList :: forall a. Show a => [Module a] -> ShowS
    showList :: [Module a] -> ShowS
    Show, (forall a b. (a -> b) -> Module a -> Module b)
    -> (forall a b. a -> Module b -> Module a) -> Functor Module
    forall a b. a -> Module b -> Module a
    forall a b. (a -> b) -> Module a -> Module b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Module a -> Module b
    fmap :: forall a b. (a -> b) -> Module a -> Module b
    $c<$ :: forall a b. a -> Module b -> Module a
    <$ :: forall a b. a -> Module b -> Module a
    Functor)

    instance NFData a => NFData (Module a) where
      rnf :: Module a -> ()
    rnf (Module String
    name Maybe a
    setup [a]
    content) = String
    name String -> () -> ()
    forall a b. NFData a => a -> b -> b
    `deepseq` Maybe a
    setup Maybe a -> () -> ()
    forall a b. NFData a => a -> b -> b
    `deepseq` [a]
    content [a] -> () -> ()
    forall a b. NFData a => a -> b -> b
    `deepseq` ()

    -- | Parse a list of modules.
    parse :: [String] -> IO [ParsedModule]
    parse :: [String] -> IO [ParsedModule]
    parse [String]
    args = [String] -> ([String] -> Ghc [ParsedModule]) -> IO [ParsedModule]
    forall a. [String] -> ([String] -> Ghc a) -> IO a
    withGhc [String]
    args (([String] -> Ghc [ParsedModule]) -> IO [ParsedModule])
    -> ([String] -> Ghc [ParsedModule]) -> IO [ParsedModule]
    forall a b. (a -> b) -> a -> b
    $ \[String]
    modules_ -> Ghc [ParsedModule] -> Ghc [ParsedModule]
    forall a. Ghc a -> Ghc a
    withTempOutputDir (Ghc [ParsedModule] -> Ghc [ParsedModule])
    -> Ghc [ParsedModule] -> Ghc [ParsedModule]
    forall a b. (a -> b) -> a -> b
    $ do

      -- ignore additional object files
      let modules :: [String]
    modules = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isSuffixOf String
    ".o") [String]
    modules_

      [Target] -> Ghc ()
    forall (m :: * -> *). GhcMonad m => [Target] -> m ()
    setTargets ([Target] -> Ghc ()) -> Ghc [Target] -> Ghc ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [String] -> (String -> Ghc Target) -> Ghc [Target]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [String]
    modules (\ String
    m -> String -> Maybe UnitId -> Maybe Phase -> Ghc Target
    forall (m :: * -> *).
    GhcMonad m =>
    String -> Maybe UnitId -> Maybe Phase -> m Target
    guessTarget String
    m
    #if __GLASGOW_HASKELL__ >= 903
                    Maybe UnitId
    forall a. Maybe a
    Nothing
    #endif
                    Maybe Phase
    forall a. Maybe a
    Nothing)
      mods <- [ModuleName] -> Bool -> Ghc ModuleGraph
    forall (m :: * -> *).
    GhcMonad m =>
    [ModuleName] -> Bool -> m ModuleGraph
    depanal [] Bool
    False

      let sortedMods = [SCC ModSummary] -> [ModSummary]
    forall a. [SCC a] -> [a]
    flattenSCCs
    #if __GLASGOW_HASKELL__ >= 901
                         ([SCC ModSummary] -> [ModSummary])
    -> [SCC ModSummary] -> [ModSummary]
    forall a b. (a -> b) -> a -> b
    $ [SCC ModuleGraphNode] -> [SCC ModSummary]
    filterToposortToModules
    #endif
                         ([SCC ModuleGraphNode] -> [SCC ModSummary])
    -> [SCC ModuleGraphNode] -> [SCC ModSummary]
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> ModuleGraph -> Maybe HomeUnitModule -> [SCC ModuleGraphNode]
    topSortModuleGraph Bool
    False ModuleGraph
    mods Maybe HomeUnitModule
    forall a. Maybe a
    Nothing
      reverse <$> mapM (loadModPlugins >=> parseModule) sortedMods
      where

        -- copied from Haddock/GhcUtils.hs
        modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc ()
        modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc ()
    modifySessionDynFlags DynFlags -> DynFlags
    f = do
          dflags <- Ghc DynFlags
    forall (m :: * -> *). GhcMonad m => m DynFlags
    getSessionDynFlags
          -- GHCi 7.7 now uses dynamic linking.
          let dflags' = case String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "GHC Dynamic" (DynFlags -> [(String, String)]
    compilerInfo DynFlags
    dflags) of
                Just String
    "YES" -> DynFlags -> GeneralFlag -> DynFlags
    gopt_set DynFlags
    dflags GeneralFlag
    Opt_BuildDynamicToo
                Maybe String
    _          -> DynFlags
    dflags
          _ <- setSessionDynFlags (f dflags')
          return ()

        withTempOutputDir :: Ghc a -> Ghc a
        withTempOutputDir :: forall a. Ghc a -> Ghc a
    withTempOutputDir Ghc a
    action = do
          tmp <- IO String -> Ghc String
    forall a. IO a -> Ghc a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO String
    getTemporaryDirectory
          x   <- liftIO c_getpid
          let dir = String
    tmp String -> ShowS
    </> String
    ".doctest-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ CPid -> String
    forall a. Show a => a -> String
    show CPid
    x
          modifySessionDynFlags (setOutputDir dir)
          gbracket_
            (liftIO $ createDirectory dir)
            (liftIO $ removeDirectoryRecursive dir)
            action

        -- | A variant of 'gbracket' where the return value from the first computation
        -- is not required.
        gbracket_ :: ExceptionMonad m => m a -> m b -> m c -> m c
    #if __GLASGOW_HASKELL__ < 900
        gbracket_ before_ after thing = gbracket before_ (const after) (const thing)
    #else
        gbracket_ :: forall (m :: * -> *) a b c.
    ExceptionMonad m =>
    m a -> m b -> m c -> m c
    gbracket_ m a
    before_ m b
    after m c
    thing = (c, b) -> c
    forall a b. (a, b) -> a
    fst ((c, b) -> c) -> m (c, b) -> m c
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m a -> (a -> ExitCase c -> m b) -> (a -> m c) -> m (c, b)
    forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
    forall (m :: * -> *) a b c.
    (MonadMask m, HasCallStack) =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
    generalBracket m a
    before_ (\ a
    _ ExitCase c
    _ -> m b
    after) (m c -> a -> m c
    forall a b. a -> b -> a
    const m c
    thing)
    #endif

        setOutputDir :: String -> DynFlags -> DynFlags
    setOutputDir String
    f DynFlags
    d = DynFlags
    d {
            objectDir  = Just f
          , hiDir      = Just f
          , stubDir    = Just f
          , includePaths = addQuoteInclude (includePaths d) [f]
          }

        -- Since GHC 8.6, plugins are initialized on a per module basis
        loadModPlugins :: ModSummary -> m ModSummary
    loadModPlugins ModSummary
    modsum = do
          _ <- DynFlags -> m ()
    forall (m :: * -> *).
    (HasCallStack, GhcMonad m) =>
    DynFlags -> m ()
    setSessionDynFlags (ModSummary -> DynFlags
    GHC.ms_hspp_opts ModSummary
    modsum)
          hsc_env <- getSession

    # if __GLASGOW_HASKELL__ >= 902
          hsc_env' <- liftIO (initializePlugins hsc_env)
          setSession hsc_env'
          return modsum
    # else
          dynflags' <- liftIO (initializePlugins hsc_env (GHC.ms_hspp_opts modsum))
          return $ modsum { ms_hspp_opts = dynflags' }
    # endif

    -- | Extract all docstrings from given list of files/modules.
    --
    -- This includes the docstrings of all local modules that are imported from
    -- those modules (possibly indirect).
    extract :: [String] -> IO [Module (Located String)]
    extract :: [String] -> IO [Module (Located String)]
    extract [String]
    args = do
      packageDBArgs <- IO [String]
    getPackageDBArgs
      let
        args' = [String]
    args [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
    #if __GLASGOW_HASKELL__ >= 810
          -- `ghci` ignores unused packages in certain situation.  This ensures
          -- that we don't fail in situations where `ghci` would not.
          String
    "-Wno-unused-packages" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :
    #endif
          [String]
    packageDBArgs

      mods <- parse args'
      let docs = (ParsedModule -> Module (Located String))
    -> [ParsedModule] -> [Module (Located String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Located String -> Located String)
    -> Module (Located String) -> Module (Located String)
    forall a b. (a -> b) -> Module a -> Module b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ShowS -> Located String -> Located String
    forall a b. (a -> b) -> Located a -> Located b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ShowS
    convertDosLineEndings) (Module (Located String) -> Module (Located String))
    -> (ParsedModule -> Module (Located String))
    -> ParsedModule
    -> Module (Located String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsedModule -> Module (Located String)
    extractFromModule) [ParsedModule]
    mods

      (docs `deepseq` return docs) `catches` [
          -- Re-throw AsyncException, otherwise execution will not terminate on
          -- SIGINT (ctrl-c).  All AsyncExceptions are re-thrown (not just
          -- UserInterrupt) because all of them indicate severe conditions and
          -- should not occur during normal operation.
          Handler (\AsyncException
    e -> AsyncException -> IO [Module (Located String)]
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (AsyncException
    e :: AsyncException))
        , Handler (throwIO . ExtractError)
        ]

    -- | Extract all docstrings from given module and attach the modules name.
    extractFromModule :: ParsedModule -> Module (Located String)
    extractFromModule :: ParsedModule -> Module (Located String)
    extractFromModule ParsedModule
    m = String
    -> Maybe (Located String)
    -> [Located String]
    -> Module (Located String)
    forall a. String -> Maybe a -> [a] -> Module a
    Module String
    name ([Located String] -> Maybe (Located String)
    forall a. [a] -> Maybe a
    listToMaybe ([Located String] -> Maybe (Located String))
    -> [Located String] -> Maybe (Located String)
    forall a b. (a -> b) -> a -> b
    $ ((Maybe String, Located String) -> Located String)
    -> [(Maybe String, Located String)] -> [Located String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe String, Located String) -> Located String
    forall a b. (a, b) -> b
    snd [(Maybe String, Located String)]
    setup) (((Maybe String, Located String) -> Located String)
    -> [(Maybe String, Located String)] -> [Located String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe String, Located String) -> Located String
    forall a b. (a, b) -> b
    snd [(Maybe String, Located String)]
    docs)
      where
        isSetup :: (Maybe String, b) -> Bool
    isSetup = (Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "setup") (Maybe String -> Bool)
    -> ((Maybe String, b) -> Maybe String) -> (Maybe String, b) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe String, b) -> Maybe String
    forall a b. (a, b) -> a
    fst
        ([(Maybe String, Located String)]
    setup, [(Maybe String, Located String)]
    docs) = ((Maybe String, Located String) -> Bool)
    -> [(Maybe String, Located String)]
    -> ([(Maybe String, Located String)],
        [(Maybe String, Located String)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Maybe String, Located String) -> Bool
    forall {b}. (Maybe String, b) -> Bool
    isSetup (ParsedModule -> [(Maybe String, Located String)]
    docStringsFromModule ParsedModule
    m)
        name :: String
    name = (ModuleName -> String
    moduleNameString (ModuleName -> String)
    -> (ParsedModule -> ModuleName) -> ParsedModule -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenModule Unit -> ModuleName
    forall unit. GenModule unit -> ModuleName
    GHC.moduleName (GenModule Unit -> ModuleName)
    -> (ParsedModule -> GenModule Unit) -> ParsedModule -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModSummary -> GenModule Unit
    ms_mod (ModSummary -> GenModule Unit)
    -> (ParsedModule -> ModSummary) -> ParsedModule -> GenModule Unit
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsedModule -> ModSummary
    pm_mod_summary) ParsedModule
    m

    #if __GLASGOW_HASKELL__ >= 904
    unpackHDS :: HsDocString -> String
    unpackHDS :: HsDocString -> String
    unpackHDS = HsDocString -> String
    renderHsDocString
    #endif

    -- | Extract all docstrings from given module.
    docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)]
    docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)]
    docStringsFromModule ParsedModule
    mod = ((Maybe String, GenLocated SrcSpan HsDocString)
     -> (Maybe String, Located String))
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    -> [(Maybe String, Located String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((GenLocated SrcSpan HsDocString -> Located String)
    -> (Maybe String, GenLocated SrcSpan HsDocString)
    -> (Maybe String, Located String)
    forall a b. (a -> b) -> (Maybe String, a) -> (Maybe String, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Located String -> Located String
    forall a. Located a -> Located a
    toLocated (Located String -> Located String)
    -> (GenLocated SrcSpan HsDocString -> Located String)
    -> GenLocated SrcSpan HsDocString
    -> Located String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HsDocString -> String)
    -> GenLocated SrcSpan HsDocString -> Located String
    forall a b.
    (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsDocString -> String
    unpackHDS)) [(Maybe String, GenLocated SrcSpan HsDocString)]
    docs
      where
        source :: HsModule GhcPs
    source   = (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan (HsModule GhcPs) -> HsModule GhcPs)
    -> (ParsedModule -> GenLocated SrcSpan (HsModule GhcPs))
    -> ParsedModule
    -> HsModule GhcPs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsedModule -> GenLocated SrcSpan (HsModule GhcPs)
    pm_parsed_source) ParsedModule
    mod

        -- we use dlist-style concatenation here
        docs :: [(Maybe String, LHsDocString)]
        docs :: [(Maybe String, GenLocated SrcSpan HsDocString)]
    docs     = [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall {a}. [(Maybe a, GenLocated SrcSpan HsDocString)]
    header [(Maybe String, GenLocated SrcSpan HsDocString)]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall a. [a] -> [a] -> [a]
    ++ [(Maybe String, GenLocated SrcSpan HsDocString)]
    exports [(Maybe String, GenLocated SrcSpan HsDocString)]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall a. [a] -> [a] -> [a]
    ++ [(Maybe String, GenLocated SrcSpan HsDocString)]
    decls

        -- We process header, exports and declarations separately instead of
        -- traversing the whole source in a generic way, to ensure that we get
        -- everything in source order.
    #if __GLASGOW_HASKELL__ >= 906
        header :: [(Maybe a, GenLocated SrcSpan HsDocString)]
    header  = [(Maybe a
    forall a. Maybe a
    Nothing, WithHsDocIdentifiers HsDocString GhcPs -> HsDocString
    forall a pass. WithHsDocIdentifiers a pass -> a
    hsDocString (WithHsDocIdentifiers HsDocString GhcPs -> HsDocString)
    -> GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    -> GenLocated SrcSpan HsDocString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    x) | Just GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    x <- [XModulePs
    -> Maybe
         (GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs))
    hsmodHaddockModHeader (HsModule GhcPs -> XCModule GhcPs
    forall p. HsModule p -> XCModule p
    hsmodExt HsModule GhcPs
    source)]]
    #elif __GLASGOW_HASKELL__ >= 904
        header  = [(Nothing, hsDocString <$> x) | Just x <- [hsmodHaddockModHeader (source)]]
    #else
        header  = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]]
    #endif
        exports :: [(Maybe String, LHsDocString)]
    #if __GLASGOW_HASKELL__ >= 904
        exports :: [(Maybe String, GenLocated SrcSpan HsDocString)]
    exports = [ (Maybe String
    forall a. Maybe a
    Nothing, SrcSpan -> HsDocString -> GenLocated SrcSpan HsDocString
    forall l e. l -> e -> GenLocated l e
    L (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    loc) (WithHsDocIdentifiers HsDocString GhcPs -> HsDocString
    forall a pass. WithHsDocIdentifiers a pass -> a
    hsDocString (GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    -> WithHsDocIdentifiers HsDocString GhcPs
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    doc)))
    #else
        exports = [ (Nothing, L (locA loc) doc)
    #endif
                  | L SrcSpanAnnA
    loc (IEDoc XIEDoc GhcPs
    _ GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    doc) <- [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
        -> [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> Maybe
         (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    -> [GenLocated SrcSpanAnnA (IE GhcPs)]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
    -> [GenLocated SrcSpanAnnA (IE GhcPs)]
    forall l e. GenLocated l e -> e
    unLoc (HsModule GhcPs -> Maybe (XRec GhcPs [LIE GhcPs])
    forall p. HsModule p -> Maybe (XRec p [LIE p])
    hsmodExports HsModule GhcPs
    source)
                  ]
        decls :: [(Maybe String, LHsDocString)]
        decls :: [(Maybe String, GenLocated SrcSpan HsDocString)]
    decls   = [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall a.
    Data a =>
    a -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    extractDocStrings (HsModule GhcPs -> [LHsDecl GhcPs]
    forall p. HsModule p -> [LHsDecl p]
    hsmodDecls HsModule GhcPs
    source)

    -- | Extract all docstrings from given value.
    extractDocStrings :: Data a => a -> [(Maybe String, LHsDocString)]
    extractDocStrings :: forall a.
    Data a =>
    a -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    extractDocStrings a
    d =
    #if __GLASGOW_HASKELL__ >= 904
      let
        docStrs :: [GenLocated SrcSpan HsDocString]
    docStrs = (GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
     -> GenLocated SrcSpan HsDocString)
    -> a -> [GenLocated SrcSpan HsDocString]
    forall {a} {b} {a}. (Data a, Typeable b) => (b -> a) -> a -> [a]
    extractAll GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    -> GenLocated SrcSpan HsDocString
    extractDocDocString a
    d
        docStrNames :: [(SrcSpan, String)]
    docStrNames = [Maybe (SrcSpan, String)] -> [(SrcSpan, String)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (SrcSpan, String)] -> [(SrcSpan, String)])
    -> [Maybe (SrcSpan, String)] -> [(SrcSpan, String)]
    forall a b. (a -> b) -> a -> b
    $ (DocDecl GhcPs -> Maybe (SrcSpan, String))
    -> a -> [Maybe (SrcSpan, String)]
    forall {a} {b} {a}. (Data a, Typeable b) => (b -> a) -> a -> [a]
    extractAll DocDecl GhcPs -> Maybe (SrcSpan, String)
    extractDocName a
    d
      in
        ((GenLocated SrcSpan HsDocString
      -> (Maybe String, GenLocated SrcSpan HsDocString))
     -> [GenLocated SrcSpan HsDocString]
     -> [(Maybe String, GenLocated SrcSpan HsDocString)])
    -> [GenLocated SrcSpan HsDocString]
    -> (GenLocated SrcSpan HsDocString
        -> (Maybe String, GenLocated SrcSpan HsDocString))
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (GenLocated SrcSpan HsDocString
     -> (Maybe String, GenLocated SrcSpan HsDocString))
    -> [GenLocated SrcSpan HsDocString]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [GenLocated SrcSpan HsDocString]
    docStrs ((GenLocated SrcSpan HsDocString
      -> (Maybe String, GenLocated SrcSpan HsDocString))
     -> [(Maybe String, GenLocated SrcSpan HsDocString)])
    -> (GenLocated SrcSpan HsDocString
        -> (Maybe String, GenLocated SrcSpan HsDocString))
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall a b. (a -> b) -> a -> b
    $ \GenLocated SrcSpan HsDocString
    docStr -> (SrcSpan -> [(SrcSpan, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (GenLocated SrcSpan HsDocString -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc GenLocated SrcSpan HsDocString
    docStr) [(SrcSpan, String)]
    docStrNames, GenLocated SrcSpan HsDocString
    docStr)
      where
        extractAll :: (b -> a) -> a -> [a]
    extractAll b -> a
    z = ([a] -> [a] -> [a]) -> GenericQ [a] -> GenericQ [a]
    forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
    everything [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    (++) ([a] -> (b -> [a]) -> a -> [a]
    forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
    mkQ [] ((a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[]) (a -> [a]) -> (b -> a) -> b -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    z))

        extractDocDocString :: LHsDoc GhcPs -> LHsDocString
        extractDocDocString :: GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    -> GenLocated SrcSpan HsDocString
    extractDocDocString = (WithHsDocIdentifiers HsDocString GhcPs -> HsDocString)
    -> GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    -> GenLocated SrcSpan HsDocString
    forall a b.
    (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap WithHsDocIdentifiers HsDocString GhcPs -> HsDocString
    forall a pass. WithHsDocIdentifiers a pass -> a
    hsDocString

        extractDocName :: DocDecl GhcPs -> Maybe (SrcSpan, String)
        extractDocName :: DocDecl GhcPs -> Maybe (SrcSpan, String)
    extractDocName DocDecl GhcPs
    docDecl = case DocDecl GhcPs
    docDecl of
          DocCommentNamed String
    name GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    y ->
            (SrcSpan, String) -> Maybe (SrcSpan, String)
    forall a. a -> Maybe a
    Just (GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    y, String
    name)
          DocDecl GhcPs
    _ ->
            Maybe (SrcSpan, String)
    forall a. Maybe a
    Nothing
    #else
      everythingBut (++) (([], False) `mkQ` fromLHsDecl
      `extQ` fromLDocDecl
      `extQ` fromLHsDocString
      ) d
      where
        fromLHsDecl :: Selector (LHsDecl GhcPs)
        fromLHsDecl (L loc decl) = case decl of

          -- Top-level documentation has to be treated separately, because it has
          -- no location information attached.  The location information is
          -- attached to HsDecl instead.
          DocD _ x
                   -> select (fromDocDecl (locA loc) x)

          _ -> (extractDocStrings decl, True)

        fromLDocDecl :: Selector
    #if __GLASGOW_HASKELL__ >= 901
                                 (LDocDecl GhcPs)
    #else
                                 LDocDecl
    #endif
        fromLDocDecl (L loc x) = select (fromDocDecl (locA loc) x)

        fromLHsDocString :: Selector LHsDocString
        fromLHsDocString x = select (Nothing, x)

        fromDocDecl :: SrcSpan -> DocDecl -> (Maybe String, LHsDocString)
        fromDocDecl loc x = case x of
          DocCommentNamed name doc -> (Just name, L loc doc)
          _                        -> (Nothing, L loc $ docDeclDoc x)

    type Selector a = a -> ([(Maybe String, LHsDocString)], Bool)

    -- | Collect given value and descend into subtree.
    select :: a -> ([a], Bool)
    select x = ([x], False)
    #endif

    #if __GLASGOW_HASKELL__ < 901
    locA :: SrcSpan -> SrcSpan
    locA = id
    #endif