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

    import           Prelude hiding (mod, concat)
    import           Control.Monad
    #if __GLASGOW_HASKELL__ < 710
    import           Control.Applicative
    #endif
    import           Control.Exception
    import           Data.List (partition, isSuffixOf)
    import           Data.Maybe
    #if __GLASGOW_HASKELL__ < 710
    import           Data.Foldable (concat)
    #endif

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

    #if __GLASGOW_HASKELL__ < 707
    import           GHC hiding (flags, Module, Located)
    import           MonadUtils (liftIO, MonadIO)
    #else
    import           GHC hiding (Module, Located)
    import           DynFlags
    import           MonadUtils (liftIO)
    #endif
    import           Exception (ExceptionMonad)
    import           System.Directory
    import           System.FilePath

    #if __GLASGOW_HASKELL__ < 710
    import           NameSet (NameSet)
    import           Coercion (Coercion)
    #endif

    #if __GLASGOW_HASKELL__ < 805
    import           FastString (unpackFS)
    #endif

    import           Digraph (flattenSCCs)

    import           System.Posix.Internals (c_getpid)

    import           GhcUtil (withGhc)
    import           Location hiding (unLoc)

    import           Util (convertDosLineEndings)
    import           PackageDBs (getPackageDBArgs)

    #if __GLASGOW_HASKELL__ >= 806
    import           DynamicLoading (initializePlugins)
    #endif

    -- | A wrapper around `SomeException`, to allow for a custom `Show` instance.
    newtype ExtractError = ExtractError SomeException
      deriving Typeable

    instance Show ExtractError where
      show :: ExtractError -> String
    show (ExtractError e :: SomeException
    e) =
        [String] -> String
    unlines [
            "Ouch! Hit an error thunk in GHC's AST while extracting documentation."
          , ""
          , "    " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg
          , ""
          , "This is most likely a bug in doctest."
          , ""
          , "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 s :: String
    s) -> "GHC panic: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s
            _              -> 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 {
      Module a -> String
    moduleName    :: String
    , Module a -> Maybe a
    moduleSetup   :: Maybe 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
    /= :: Module a -> Module a -> Bool
    $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
    Eq, a -> Module b -> Module a
    (a -> b) -> Module a -> Module b
    (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
    <$ :: a -> Module b -> Module a
    $c<$ :: forall a b. a -> Module b -> Module a
    fmap :: (a -> b) -> Module a -> Module b
    $cfmap :: forall a b. (a -> b) -> Module a -> Module b
    Functor)

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

    #if __GLASGOW_HASKELL__ < 803
    type GhcPs = RdrName

    needsTemplateHaskellOrQQ :: ModuleGraph -> Bool
    needsTemplateHaskellOrQQ = needsTemplateHaskell

    mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
    mapMG = map
    #endif

    #if __GLASGOW_HASKELL__ < 805
    addQuoteInclude :: [String] -> [String] -> [String]
    addQuoteInclude includes new = new ++ includes
    #endif

    -- | Parse a list of modules.
    parse :: [String] -> IO [TypecheckedModule]
    parse :: [String] -> IO [TypecheckedModule]
    parse args :: [String]
    args = [String]
    -> ([String] -> Ghc [TypecheckedModule]) -> IO [TypecheckedModule]
    forall a. [String] -> ([String] -> Ghc a) -> IO a
    withGhc [String]
    args (([String] -> Ghc [TypecheckedModule]) -> IO [TypecheckedModule])
    -> ([String] -> Ghc [TypecheckedModule]) -> IO [TypecheckedModule]
    forall a b. (a -> b) -> a -> b
    $ \modules_ :: [String]
    modules_ -> Ghc [TypecheckedModule] -> Ghc [TypecheckedModule]
    forall a. Ghc a -> Ghc a
    withTempOutputDir (Ghc [TypecheckedModule] -> Ghc [TypecheckedModule])
    -> Ghc [TypecheckedModule] -> Ghc [TypecheckedModule]
    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 ".o") [String]
    modules_

      (String -> Ghc Target) -> [String] -> Ghc [Target]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String -> Maybe Phase -> Ghc Target
    forall (m :: * -> *).
    GhcMonad m =>
    String -> Maybe Phase -> m Target
    `guessTarget` Maybe Phase
    forall a. Maybe a
    Nothing) [String]
    modules Ghc [Target] -> ([Target] -> Ghc ()) -> Ghc ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Target] -> Ghc ()
    forall (m :: * -> *). GhcMonad m => [Target] -> m ()
    setTargets
      ModuleGraph
    mods <- [ModuleName] -> Bool -> Ghc ModuleGraph
    forall (m :: * -> *).
    GhcMonad m =>
    [ModuleName] -> Bool -> m ModuleGraph
    depanal [] Bool
    False

      ModuleGraph
    mods' <- if ModuleGraph -> Bool
    needsTemplateHaskellOrQQ ModuleGraph
    mods then ModuleGraph -> Ghc ModuleGraph
    enableCompilation ModuleGraph
    mods else ModuleGraph -> Ghc ModuleGraph
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleGraph
    mods

      let sortedMods :: [ModSummary]
    sortedMods = [SCC ModSummary] -> [ModSummary]
    forall a. [SCC a] -> [a]
    flattenSCCs (Bool -> ModuleGraph -> Maybe ModuleName -> [SCC ModSummary]
    topSortModuleGraph Bool
    False ModuleGraph
    mods' Maybe ModuleName
    forall a. Maybe a
    Nothing)
      [TypecheckedModule] -> [TypecheckedModule]
    forall a. [a] -> [a]
    reverse ([TypecheckedModule] -> [TypecheckedModule])
    -> Ghc [TypecheckedModule] -> Ghc [TypecheckedModule]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ModSummary -> Ghc TypecheckedModule)
    -> [ModSummary] -> Ghc [TypecheckedModule]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (ModSummary -> Ghc ModSummary
    forall (m :: * -> *). GhcMonad m => ModSummary -> m ModSummary
    loadModPlugins (ModSummary -> Ghc ModSummary)
    -> (ModSummary -> Ghc TypecheckedModule)
    -> ModSummary
    -> Ghc TypecheckedModule
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> ModSummary -> Ghc ParsedModule
    forall (m :: * -> *). GhcMonad m => ModSummary -> m ParsedModule
    parseModule (ModSummary -> Ghc ParsedModule)
    -> (ParsedModule -> Ghc TypecheckedModule)
    -> ModSummary
    -> Ghc TypecheckedModule
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> ParsedModule -> Ghc TypecheckedModule
    forall (m :: * -> *).
    GhcMonad m =>
    ParsedModule -> m TypecheckedModule
    typecheckModule (ParsedModule -> Ghc TypecheckedModule)
    -> (TypecheckedModule -> Ghc TypecheckedModule)
    -> ParsedModule
    -> Ghc TypecheckedModule
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> TypecheckedModule -> Ghc TypecheckedModule
    forall mod (m :: * -> *).
    (TypecheckedMod mod, GhcMonad m) =>
    mod -> m mod
    loadModule) [ModSummary]
    sortedMods
      where
        -- copied from Haddock/Interface.hs
        enableCompilation :: ModuleGraph -> Ghc ModuleGraph
        enableCompilation :: ModuleGraph -> Ghc ModuleGraph
    enableCompilation modGraph :: ModuleGraph
    modGraph = do
    #if __GLASGOW_HASKELL__ < 707
          let enableComp d = d { hscTarget = defaultObjectTarget }
    #elif __GLASGOW_HASKELL__ < 809
          let enableComp :: DynFlags -> DynFlags
    enableComp d :: DynFlags
    d = let platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    d
                             in DynFlags
    d { hscTarget :: HscTarget
    hscTarget = Platform -> HscTarget
    defaultObjectTarget Platform
    platform }
    #else
          let enableComp d = d { hscTarget = defaultObjectTarget d }
    #endif
          (DynFlags -> DynFlags) -> Ghc ()
    modifySessionDynFlags DynFlags -> DynFlags
    enableComp
          -- We need to update the DynFlags of the ModSummaries as well.
          let upd :: ModSummary -> ModSummary
    upd m :: ModSummary
    m = ModSummary
    m { ms_hspp_opts :: DynFlags
    ms_hspp_opts = DynFlags -> DynFlags
    enableComp (ModSummary -> DynFlags
    ms_hspp_opts ModSummary
    m) }
          let modGraph' :: ModuleGraph
    modGraph' = (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
    mapMG ModSummary -> ModSummary
    upd ModuleGraph
    modGraph
          ModuleGraph -> Ghc ModuleGraph
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModuleGraph
    modGraph'

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

        withTempOutputDir :: Ghc a -> Ghc a
        withTempOutputDir :: Ghc a -> Ghc a
    withTempOutputDir action :: Ghc a
    action = do
          String
    tmp <- IO String -> Ghc String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO String
    getTemporaryDirectory
          CPid
    x   <- IO CPid -> Ghc CPid
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO CPid
    c_getpid
          let dir :: String
    dir = String
    tmp String -> ShowS
    </> ".doctest-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ CPid -> String
    forall a. Show a => a -> String
    show CPid
    x
          (DynFlags -> DynFlags) -> Ghc ()
    modifySessionDynFlags (String -> DynFlags -> DynFlags
    setOutputDir String
    dir)
          Ghc () -> Ghc () -> Ghc a -> Ghc a
    forall (m :: * -> *) a b c.
    ExceptionMonad m =>
    m a -> m b -> m c -> m c
    gbracket_
            (IO () -> Ghc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    createDirectory String
    dir)
            (IO () -> Ghc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Ghc ()) -> IO () -> Ghc ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    removeDirectoryRecursive String
    dir)
            Ghc a
    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
        gbracket_ :: m a -> m b -> m c -> m c
    gbracket_ before_ :: m a
    before_ after :: m b
    after thing :: m c
    thing = m a -> (a -> m b) -> (a -> m c) -> m c
    forall (m :: * -> *) a b c.
    ExceptionMonad m =>
    m a -> (a -> m b) -> (a -> m c) -> m c
    gbracket m a
    before_ (m b -> a -> m b
    forall a b. a -> b -> a
    const m b
    after) (m c -> a -> m c
    forall a b. a -> b -> a
    const m c
    thing)

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

    #if __GLASGOW_HASKELL__ >= 806
        -- Since GHC 8.6, plugins are initialized on a per module basis
        loadModPlugins :: ModSummary -> m ModSummary
    loadModPlugins modsum :: ModSummary
    modsum = do
          HscEnv
    hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
          DynFlags
    dynflags' <- IO DynFlags -> m DynFlags
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (HscEnv -> DynFlags -> IO DynFlags
    initializePlugins HscEnv
    hsc_env (ModSummary -> DynFlags
    GHC.ms_hspp_opts ModSummary
    modsum))
          ModSummary -> m ModSummary
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModSummary -> m ModSummary) -> ModSummary -> m ModSummary
    forall a b. (a -> b) -> a -> b
    $ ModSummary
    modsum { ms_hspp_opts :: DynFlags
    ms_hspp_opts = DynFlags
    dynflags' }
    #else
        loadModPlugins = return
    #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 args :: [String]
    args = do
      [String]
    packageDBArgs <- IO [String]
    getPackageDBArgs
      let args' :: [String]
    args'  = [String]
    args [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    packageDBArgs
      [TypecheckedModule]
    mods <- [String] -> IO [TypecheckedModule]
    parse [String]
    args'
      let docs :: [Module (Located String)]
    docs = (TypecheckedModule -> Module (Located String))
    -> [TypecheckedModule] -> [Module (Located String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Located String -> Located String)
    -> Module (Located String) -> Module (Located String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ShowS -> Located String -> Located String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ShowS
    convertDosLineEndings) (Module (Located String) -> Module (Located String))
    -> (TypecheckedModule -> Module (Located String))
    -> TypecheckedModule
    -> Module (Located String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsedModule -> Module (Located String)
    extractFromModule (ParsedModule -> Module (Located String))
    -> (TypecheckedModule -> ParsedModule)
    -> TypecheckedModule
    -> Module (Located String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TypecheckedModule -> ParsedModule
    tm_parsed_module) [TypecheckedModule]
    mods

      ([Module (Located String)]
    docs [Module (Located String)]
    -> IO [Module (Located String)] -> IO [Module (Located String)]
    forall a b. NFData a => a -> b -> b
    `deepseq` [Module (Located String)] -> IO [Module (Located String)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Module (Located String)]
    docs) IO [Module (Located String)]
    -> [Handler [Module (Located String)]]
    -> IO [Module (Located String)]
    forall a. IO a -> [Handler a] -> IO a
    `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.
          (AsyncException -> IO [Module (Located String)])
    -> Handler [Module (Located String)]
    forall a e. Exception e => (e -> IO a) -> Handler a
    Handler (\e :: AsyncException
    e -> AsyncException -> IO [Module (Located String)]
    forall a e. Exception e => e -> a
    throw (AsyncException
    e :: AsyncException))
        , (SomeException -> IO [Module (Located String)])
    -> Handler [Module (Located String)]
    forall a e. Exception e => (e -> IO a) -> Handler a
    Handler (ExtractError -> IO [Module (Located String)]
    forall e a. Exception e => e -> IO a
    throwIO (ExtractError -> IO [Module (Located String)])
    -> (SomeException -> ExtractError)
    -> SomeException
    -> IO [Module (Located String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> ExtractError
    ExtractError)
        ]

    -- | Extract all docstrings from given module and attach the modules name.
    extractFromModule :: ParsedModule -> Module (Located String)
    extractFromModule :: ParsedModule -> Module (Located String)
    extractFromModule m :: 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 "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
        (setup :: [(Maybe String, Located String)]
    setup, docs :: [(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
    . Module -> ModuleName
    GHC.moduleName (Module -> ModuleName)
    -> (ParsedModule -> Module) -> ParsedModule -> ModuleName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModSummary -> Module
    ms_mod (ModSummary -> Module)
    -> (ParsedModule -> ModSummary) -> ParsedModule -> Module
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsedModule -> ModSummary
    pm_mod_summary) ParsedModule
    m

    -- | Extract all docstrings from given module.
    docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)]
    docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)]
    docStringsFromModule mod :: 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 (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 (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   = (ParsedSource -> HsModule GhcPs
    forall a. HasSrcSpan a => a -> SrcSpanLess a
    unLoc (ParsedSource -> HsModule GhcPs)
    -> (ParsedModule -> ParsedSource) -> ParsedModule -> HsModule GhcPs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParsedModule -> ParsedSource
    pm_parsed_source) ParsedModule
    mod

        -- we use dlist-style concatenation here
        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)]
    forall a. [(Maybe a, 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.
        header :: [(Maybe a, GenLocated SrcSpan HsDocString)]
    header  = [(Maybe a
    forall a. Maybe a
    Nothing, GenLocated SrcSpan HsDocString
    x) | Just x :: GenLocated SrcSpan HsDocString
    x <- [HsModule GhcPs -> Maybe (GenLocated SrcSpan HsDocString)
    forall pass.
    HsModule pass -> Maybe (GenLocated SrcSpan HsDocString)
    hsmodHaddockModHeader HsModule GhcPs
    source]]
    #if __GLASGOW_HASKELL__ < 710
        exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- concat (hsmodExports source)]
    #elif __GLASGOW_HASKELL__ < 805
        exports = [(Nothing, L loc doc) | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)]
    #else
        exports :: [(Maybe a, GenLocated SrcSpan HsDocString)]
    exports = [(Maybe a
    forall a. Maybe a
    Nothing, SrcSpan -> HsDocString -> GenLocated SrcSpan HsDocString
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsDocString
    doc) | L loc :: SrcSpan
    loc (IEDoc _ doc :: HsDocString
    doc) <- [GenLocated SrcSpan (IE GhcPs)]
    -> (Located [GenLocated SrcSpan (IE GhcPs)]
        -> [GenLocated SrcSpan (IE GhcPs)])
    -> Maybe (Located [GenLocated SrcSpan (IE GhcPs)])
    -> [GenLocated SrcSpan (IE GhcPs)]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] Located [GenLocated SrcSpan (IE GhcPs)]
    -> [GenLocated SrcSpan (IE GhcPs)]
    forall a. HasSrcSpan a => a -> SrcSpanLess a
    unLoc (HsModule GhcPs -> Maybe (Located [GenLocated SrcSpan (IE GhcPs)])
    forall pass. HsModule pass -> Maybe (Located [LIE pass])
    hsmodExports HsModule GhcPs
    source)]
    #endif
        decls :: [(Maybe String, GenLocated SrcSpan HsDocString)]
    decls   = [LHsDecl GhcPs] -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall a.
    Data a =>
    a -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    extractDocStrings (HsModule GhcPs -> [LHsDecl GhcPs]
    forall pass. HsModule pass -> [LHsDecl pass]
    hsmodDecls HsModule GhcPs
    source)

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

    #if __GLASGOW_HASKELL__ < 710
    -- | Ignore a subtree.
    ignore :: Selector a
    ignore = const ([], True)
    #endif

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

    -- | Extract all docstrings from given value.
    extractDocStrings :: Data a => a -> [(Maybe String, LHsDocString)]
    extractDocStrings :: a -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    extractDocStrings = ([(Maybe String, GenLocated SrcSpan HsDocString)]
     -> [(Maybe String, GenLocated SrcSpan HsDocString)]
     -> [(Maybe String, GenLocated SrcSpan HsDocString)])
    -> GenericQ
         ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    -> forall a.
       Data a =>
       a -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall r. (r -> r -> r) -> GenericQ (r, Bool) -> GenericQ r
    everythingBut [(Maybe String, GenLocated SrcSpan HsDocString)]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall a. [a] -> [a] -> [a]
    (++) (([], Bool
    False) ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    -> (LHsDecl GhcPs
        -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool))
    -> a
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
    `mkQ` LHsDecl GhcPs
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromLHsDecl
      (a -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool))
    -> (LDocDecl
        -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool))
    -> a
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a b q.
    (Typeable a, Typeable b) =>
    (a -> q) -> (b -> q) -> a -> q
    `extQ` LDocDecl
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromLDocDecl
      (a -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool))
    -> (GenLocated SrcSpan HsDocString
        -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool))
    -> a
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a b q.
    (Typeable a, Typeable b) =>
    (a -> q) -> (b -> q) -> a -> q
    `extQ` GenLocated SrcSpan HsDocString
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromLHsDocString
    #if __GLASGOW_HASKELL__ < 710
      `extQ` (ignore :: Selector NameSet)
      `extQ` (ignore :: Selector PostTcKind)

      -- HsExpr never contains any documentation, but it may contain error thunks.
      --
      -- Problematic are (non comprehensive):
      --
      --  * parallel list comprehensions
      --  * infix operators
      --
      `extQ` (ignore :: Selector (HsExpr RdrName))

      -- undefined before type checking
      `extQ` (ignore :: Selector Coercion)

    #if __GLASGOW_HASKELL__ >= 706
      -- hswb_kvs and hswb_tvs may be error thunks
      `extQ` (ignore :: Selector (HsWithBndrs [LHsType RdrName]))
      `extQ` (ignore :: Selector (HsWithBndrs [LHsType Name]))
      `extQ` (ignore :: Selector (HsWithBndrs (LHsType RdrName)))
      `extQ` (ignore :: Selector (HsWithBndrs (LHsType Name)))
    #endif

    #endif
      )
      where
        fromLHsDecl :: Selector (LHsDecl GhcPs)
        fromLHsDecl :: LHsDecl GhcPs
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromLHsDecl (L loc :: SrcSpan
    loc decl :: HsDecl GhcPs
    decl) = case HsDecl GhcPs
    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.
    #if __GLASGOW_HASKELL__ < 805
          DocD x -> select (fromDocDecl loc x)
    #else
          DocD _ x :: DocDecl
    x -> (Maybe String, GenLocated SrcSpan HsDocString)
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a. a -> ([a], Bool)
    select (SrcSpan
    -> DocDecl -> (Maybe String, GenLocated SrcSpan HsDocString)
    fromDocDecl SrcSpan
    loc DocDecl
    x)
    #endif

          _ -> (HsDecl GhcPs -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    forall a.
    Data a =>
    a -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    extractDocStrings HsDecl GhcPs
    decl, Bool
    True)

        fromLDocDecl :: Selector LDocDecl
        fromLDocDecl :: LDocDecl
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromLDocDecl (L loc :: SrcSpan
    loc x :: DocDecl
    x) = (Maybe String, GenLocated SrcSpan HsDocString)
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a. a -> ([a], Bool)
    select (SrcSpan
    -> DocDecl -> (Maybe String, GenLocated SrcSpan HsDocString)
    fromDocDecl SrcSpan
    loc DocDecl
    x)

        fromLHsDocString :: Selector LHsDocString
        fromLHsDocString :: GenLocated SrcSpan HsDocString
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromLHsDocString x :: GenLocated SrcSpan HsDocString
    x = (Maybe String, GenLocated SrcSpan HsDocString)
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a. a -> ([a], Bool)
    select (Maybe String
    forall a. Maybe a
    Nothing, GenLocated SrcSpan HsDocString
    x)

        fromDocDecl :: SrcSpan -> DocDecl -> (Maybe String, LHsDocString)
        fromDocDecl :: SrcSpan
    -> DocDecl -> (Maybe String, GenLocated SrcSpan HsDocString)
    fromDocDecl loc :: SrcSpan
    loc x :: DocDecl
    x = case DocDecl
    x of
          DocCommentNamed name :: String
    name doc :: HsDocString
    doc -> (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    name, SrcSpan -> HsDocString -> GenLocated SrcSpan HsDocString
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsDocString
    doc)
          _                        -> (Maybe String
    forall a. Maybe a
    Nothing, SrcSpan -> HsDocString -> GenLocated SrcSpan HsDocString
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsDocString -> GenLocated SrcSpan HsDocString)
    -> HsDocString -> GenLocated SrcSpan HsDocString
    forall a b. (a -> b) -> a -> b
    $ DocDecl -> HsDocString
    docDeclDoc DocDecl
    x)

    #if __GLASGOW_HASKELL__ < 805
    -- | Convert a docstring to a plain string.
    unpackHDS :: HsDocString -> String
    unpackHDS (HsDocString s) = unpackFS s
    #endif