    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ViewPatterns #-}

    module Test.DocTest.Internal.Extract
      ( Module(..)
      , isEmptyModule
      , extract
      , extractIO
      , eraseConfigLocation
      ) where
    import           Prelude hiding (mod, concat)
    import           Control.DeepSeq (NFData, deepseq)
    import           Control.Exception (AsyncException, throw, throwIO, fromException)
    import           Control.Monad
    import           Control.Monad.Catch (catches, SomeException, Exception, Handler (Handler))
    import           Data.Generics (Data, extQ, mkQ, everythingBut)
    import           Data.List (partition, isPrefixOf)
    import           Data.List.Extra (trim, splitOn)
    import           Data.Maybe
    import           GHC.Generics (Generic)

    #if __GLASGOW_HASKELL__ < 912
    import           Data.Generics (Typeable)
    #endif

    import           GHC hiding (Module, Located, moduleName, parsedSource)
    import           GHC.Driver.Session
    import           GHC.Utils.Monad (liftIO)

    import           System.Directory
    import           System.FilePath

    #if __GLASGOW_HASKELL__ < 902
    import           GHC.Data.FastString (unpackFS)
    import           GHC.Types.Basic (SourceText(SourceText))
    #elif __GLASGOW_HASKELL__ < 906
    import           GHC.Types.SourceText (SourceText(SourceText))
    import           GHC.Data.FastString (unpackFS)
    #else
    import           GHC.Data.FastString (unpackFS)
    #endif

    import           Test.DocTest.Internal.GhcUtil (withGhc)
    import           Test.DocTest.Internal.Location hiding (unLoc)
    import           Test.DocTest.Internal.Util (convertDosLineEndings)

    #if MIN_VERSION_ghc_exactprint(1,3,0)
    import           Language.Haskell.GHC.ExactPrint.Parsers (parseModuleEpAnnsWithCppInternal, defaultCppOptions)
    #else
    import           Language.Haskell.GHC.ExactPrint.Parsers (parseModuleApiAnnsWithCppInternal, defaultCppOptions)
    #endif

    #if __GLASGOW_HASKELL__ < 902
    import           GHC.Driver.Types (throwErrors)
    import           GHC.Parser.Header (getOptionsFromFile)
    #elif __GLASGOW_HASKELL__ < 904
    import           GHC.Types.SourceError (throwErrors)
    import           GHC.Parser.Header (getOptionsFromFile)
    #else
    import           GHC.Types.SourceError (throwErrors)
    import           GHC.Parser.Header (getOptionsFromFile)
    import           GHC.Driver.Config.Parser (initParserOpts)
    #endif

    #if __GLASGOW_HASKELL__ < 904
    initParserOpts :: DynFlags -> DynFlags
    initParserOpts = id
    #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-parallel."
          , String
    ""
          , String
    "Please report it here: https://github.com/martijnbastiaan/doctest-parallel/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

    data ModuleNotFoundError = ModuleNotFoundError String [FilePath]
      deriving (
    #if __GLASGOW_HASKELL__ < 912
        Typeable,
    #endif
        Show ModuleNotFoundError
    Typeable ModuleNotFoundError
    (Typeable ModuleNotFoundError, Show ModuleNotFoundError) =>
    (ModuleNotFoundError -> SomeException)
    -> (SomeException -> Maybe ModuleNotFoundError)
    -> (ModuleNotFoundError -> String)
    -> (ModuleNotFoundError -> Bool)
    -> Exception ModuleNotFoundError
    SomeException -> Maybe ModuleNotFoundError
    ModuleNotFoundError -> Bool
    ModuleNotFoundError -> String
    ModuleNotFoundError -> SomeException
    forall e.
    (Typeable e, Show e) =>
    (e -> SomeException)
    -> (SomeException -> Maybe e)
    -> (e -> String)
    -> (e -> Bool)
    -> Exception e
    $ctoException :: ModuleNotFoundError -> SomeException
    toException :: ModuleNotFoundError -> SomeException
    $cfromException :: SomeException -> Maybe ModuleNotFoundError
    fromException :: SomeException -> Maybe ModuleNotFoundError
    $cdisplayException :: ModuleNotFoundError -> String
    displayException :: ModuleNotFoundError -> String
    $cbacktraceDesired :: ModuleNotFoundError -> Bool
    backtraceDesired :: ModuleNotFoundError -> Bool
    Exception
      )

    instance Show ModuleNotFoundError where
      show :: ModuleNotFoundError -> String
    show (ModuleNotFoundError String
    modName [String]
    incdirs) =
        [String] -> String
    unlines [
            String
    "Module not found: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    modName
          , String
    ""
          , String
    "Tried the following include directories:"
          , String
    ""
          , [String] -> String
    unlines [String]
    incdirs
          ]

    -- | 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]
    , forall a. Module a -> [Located String]
    moduleConfig  :: [Located String]
    } 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, (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, 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 x. Module a -> Rep (Module a) x)
    -> (forall x. Rep (Module a) x -> Module a) -> Generic (Module a)
    forall x. Rep (Module a) x -> Module a
    forall x. Module a -> Rep (Module a) x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    forall a x. Rep (Module a) x -> Module a
    forall a x. Module a -> Rep (Module a) x
    $cfrom :: forall a x. Module a -> Rep (Module a) x
    from :: forall x. Module a -> Rep (Module a) x
    $cto :: forall a x. Rep (Module a) x -> Module a
    to :: forall x. Rep (Module a) x -> Module a
    Generic, Module a -> ()
    (Module a -> ()) -> NFData (Module a)
    forall a. NFData a => Module a -> ()
    forall a. (a -> ()) -> NFData a
    $crnf :: forall a. NFData a => Module a -> ()
    rnf :: Module a -> ()
    NFData)

    isEmptyModule :: Module a -> Bool
    isEmptyModule :: forall a. Module a -> Bool
    isEmptyModule (Module String
    _ Maybe a
    setup [a]
    tests [Located String]
    _) = [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    tests Bool -> Bool -> Bool
    && Maybe a -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe a
    setup

    eraseConfigLocation :: Module a -> Module a
    eraseConfigLocation :: forall a. Module a -> Module a
    eraseConfigLocation m :: Module a
    m@Module{[Located String]
    moduleConfig :: forall a. Module a -> [Located String]
    moduleConfig :: [Located String]
    moduleConfig} =
      Module a
    m{moduleConfig=map go moduleConfig}
     where
      go :: Located a -> Located a
    go (Located Location
    _ a
    a) = a -> Located a
    forall a. a -> Located a
    noLocation a
    a

    moduleParts :: String -> [String]
    moduleParts :: String -> [String]
    moduleParts = Char -> String -> [String]
    forall a. Eq a => a -> [a] -> [[a]]
    splitOn Char
    '.'

    findModulePath :: [FilePath] -> String -> IO FilePath
    findModulePath :: [String] -> String -> IO String
    findModulePath [String]
    importPaths String
    modName = do
      let
        modPath :: String
    modPath = (String -> ShowS) -> [String] -> String
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 String -> ShowS
    (</>) (String -> [String]
    moduleParts String
    modName) String -> ShowS
    <.> String
    "hs"

      found <- ([Maybe String] -> [String]) -> IO [Maybe String] -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Maybe String] -> [String]
    forall a. [Maybe a] -> [a]
    catMaybes (IO [Maybe String] -> IO [String])
    -> IO [Maybe String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> (String -> IO (Maybe String)) -> IO [Maybe String]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [String]
    importPaths ((String -> IO (Maybe String)) -> IO [Maybe String])
    -> (String -> IO (Maybe String)) -> IO [Maybe String]
    forall a b. (a -> b) -> a -> b
    $ \String
    importPath -> do
        let fullPath :: String
    fullPath = String
    importPath String -> ShowS
    </> String
    modPath
        exists <- String -> IO Bool
    doesFileExist String
    fullPath
        return $ if exists then Just fullPath else Nothing

      case found of
        [] -> ModuleNotFoundError -> IO String
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (String -> [String] -> ModuleNotFoundError
    ModuleNotFoundError String
    modName [String]
    importPaths)
        (String
    p:[String]
    _) -> String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    p

    -- | Parse a list of modules. Can throw an `ModuleNotFoundError` if a module's
    -- source file cannot be found. Can throw a `SourceError` if an error occurs
    -- while parsing.
    parse :: String -> Ghc ParsedSource
    parse :: String -> Ghc ParsedSource
    parse String
    modName = do
      -- Find all specified modules on disk
      importPaths0 <- DynFlags -> [String]
    importPaths (DynFlags -> [String]) -> Ghc DynFlags -> Ghc [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ghc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      path <- liftIO $ findModulePath importPaths0 modName

      -- LANGUAGE pragmas can influence how a file is parsed. For example, CPP
      -- means we need to preprocess the file before parsing it. We use GHC's
      -- `getOptionsFromFile` to parse these pragmas and then feed them as options
      -- to the "real" parser.
      dynFlags0 <- getDynFlags
    #if __GLASGOW_HASKELL__ < 904
      flagsFromFile <-
    #else
      (_, flagsFromFile) <-
    #endif
        liftIO $ getOptionsFromFile (initParserOpts dynFlags0) path
      (dynFlags1, _, _) <- parseDynamicFilePragma dynFlags0 flagsFromFile

    #if MIN_VERSION_ghc_exactprint(1,3,0)
      result <- parseModuleEpAnnsWithCppInternal defaultCppOptions dynFlags1 path
    #else
      result <- parseModuleApiAnnsWithCppInternal defaultCppOptions dynFlags1 path
    #endif

      case result of
        Left ErrorMessages
    errs -> ErrorMessages -> Ghc ParsedSource
    forall (io :: * -> *) a. MonadIO io => ErrorMessages -> io a
    throwErrors ErrorMessages
    errs
    #if MIN_VERSION_ghc_exactprint(1,3,0)
        Right ([LEpaComment]
    _cppComments, DynFlags
    _dynFlags, ParsedSource
    parsedSource) -> ParsedSource -> Ghc ParsedSource
    forall a. a -> Ghc a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ParsedSource
    parsedSource
    #else
        Right (_apiAnns, _cppComments, _dynFlags, parsedSource) -> pure parsedSource
    #endif

    -- | Like `extract`, but runs in the `IO` monad given GHC parse arguments.
    extractIO :: [String] -> String -> IO (Module (Located String))
    extractIO :: [String] -> String -> IO (Module (Located String))
    extractIO [String]
    parseArgs String
    modName = [String]
    -> Ghc (Module (Located String)) -> IO (Module (Located String))
    forall a. [String] -> Ghc a -> IO a
    withGhc [String]
    parseArgs (Ghc (Module (Located String)) -> IO (Module (Located String)))
    -> Ghc (Module (Located String)) -> IO (Module (Located String))
    forall a b. (a -> b) -> a -> b
    $ String -> Ghc (Module (Located String))
    extract String
    modName

    -- | 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).
    --
    -- Can throw `ExtractError` if an error occurs while extracting the docstrings,
    -- or a `SourceError` if an error occurs while parsing the module. Can throw a
    -- `ModuleNotFoundError` if a module's source file cannot be found.
    extract :: String -> Ghc (Module (Located String))
    extract :: String -> Ghc (Module (Located String))
    extract String
    modName = do
      mod <- String -> Ghc ParsedSource
    parse String
    modName
      let
        docs0 = String -> ParsedSource -> Module (Located String)
    extractFromModule String
    modName ParsedSource
    mod
        docs1 = 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 (Located String -> Located String)
    -> Module (Located String) -> Module (Located String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Module (Located String)
    docs0

      (docs1 `deepseq` return docs1) `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 -> Ghc (Module (Located String))
    forall a e. (HasCallStack, Exception e) => e -> a
    throw (AsyncException
    e :: AsyncException))
        , Handler (liftIO . throwIO . ExtractError)
        ]

    -- | Extract all docstrings from given module and attach the modules name.
    extractFromModule :: String -> ParsedSource -> Module (Located String)
    extractFromModule :: String -> ParsedSource -> Module (Located String)
    extractFromModule String
    modName ParsedSource
    m = Module
      { moduleName :: String
    moduleName = String
    modName
      , moduleSetup :: Maybe (Located String)
    moduleSetup = [Located String] -> Maybe (Located String)
    forall a. [a] -> Maybe a
    listToMaybe (((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)
      , moduleContent :: [Located String]
    moduleContent = ((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
      , moduleConfig :: [Located String]
    moduleConfig = ParsedSource -> [Located String]
    moduleAnnsFromModule ParsedSource
    m
      }
     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 (ParsedSource -> [(Maybe String, Located String)]
    docStringsFromModule ParsedSource
    m)

    -- | Extract all module annotations from given module.
    moduleAnnsFromModule :: ParsedSource -> [Located String]
    moduleAnnsFromModule :: ParsedSource -> [Located String]
    moduleAnnsFromModule ParsedSource
    mod =
      [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
    stripOptionString Located String
    ann | Located String
    ann <- [Located String]
    anns, Located String -> Bool
    isOption Located String
    ann]
     where
      optionPrefix :: String
    optionPrefix = String
    "doctest-parallel:"
      isOption :: Located String -> Bool
    isOption (Located Location
    _ String
    s) = String
    optionPrefix String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s
      stripOptionString :: ShowS
    stripOptionString String
    s = ShowS
    trim (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    optionPrefix) String
    s)
      anns :: [Located String]
    anns = HsModule GhcPs -> [Located String]
    forall a. Data a => a -> [Located String]
    extractModuleAnns HsModule GhcPs
    source
      source :: HsModule GhcPs
    source = ParsedSource -> HsModule GhcPs
    forall l e. GenLocated l e -> e
    unLoc ParsedSource
    mod

    -- | Extract all docstrings from given module.
    docStringsFromModule :: ParsedSource -> [(Maybe String, Located String)]
    docStringsFromModule :: ParsedSource -> [(Maybe String, Located String)]
    docStringsFromModule ParsedSource
    mod =
    #if __GLASGOW_HASKELL__ < 904
      map (fmap (toLocated . fmap unpackHDS)) docs
    #else
      ((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
    renderHsDocString)) [(Maybe String, GenLocated SrcSpan HsDocString)]
    docs
    #endif
     where
      source :: HsModule GhcPs
    source = ParsedSource -> HsModule GhcPs
    forall l e. GenLocated l e -> e
    unLoc ParsedSource
    mod

      -- we use dlist-style concatenation here
      docs :: [(Maybe String, LHsDocString)]
      docs :: [(Maybe String, GenLocated SrcSpan HsDocString)]
    docs = [(Maybe String, 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.
      header :: [(Maybe String, LHsDocString)]
    #if __GLASGOW_HASKELL__ < 904
      header  = [(Nothing, x) | Just x <- [hsmodHaddockModHeader source]]
    #elif __GLASGOW_HASKELL__ < 906
      header = [(Nothing, hsDocString <$> x) | Just x <- [hsmodHaddockModHeader source]]
    #else
      header :: [(Maybe String, GenLocated SrcSpan HsDocString)]
    header = [(Maybe String
    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)]]
    #endif

      exports :: [(Maybe String, LHsDocString)]
      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) HsDocString
    doc)
    #if __GLASGOW_HASKELL__ < 904
                | L loc (IEDoc _ doc) <- maybe [] unLoc (hsmodExports source)
    #else
                | L SrcSpanAnnA
    loc (IEDoc XIEDoc GhcPs
    _ (GenLocated SrcSpan HsDocString -> HsDocString
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan HsDocString -> HsDocString)
    -> (GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
        -> GenLocated SrcSpan HsDocString)
    -> GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    -> HsDocString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (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 -> HsDocString
    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)
    #endif
                ]

      decls :: [(Maybe String, LHsDocString)]
      decls :: [(Maybe String, GenLocated SrcSpan HsDocString)]
    decls   = Either (HsDecl GhcPs) [LHsDecl GhcPs]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    extractDocStrings ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> Either (HsDecl GhcPs) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    forall a b. b -> Either a b
    Right (HsModule GhcPs -> [LHsDecl GhcPs]
    forall p. HsModule p -> [LHsDecl p]
    hsmodDecls HsModule GhcPs
    source))

    type Selector b a = a -> ([b], Bool)

    type DocSelector a = Selector (Maybe String, LHsDocString) a
    type AnnSelector a = Selector (Located String) a

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

    #if __GLASGOW_HASKELL__ >= 904
    -- | Don't collect any values
    noSelect :: ([a], Bool)
    noSelect :: forall a. ([a], Bool)
    noSelect = ([], Bool
    False)
    #endif

    -- | Extract module annotations from given value.
    extractModuleAnns :: Data a => a -> [Located String]
    extractModuleAnns :: forall a. Data a => a -> [Located String]
    extractModuleAnns = ([Located String] -> [Located String] -> [Located String])
    -> GenericQ ([Located String], Bool)
    -> forall a. Data a => a -> [Located String]
    forall r. (r -> r -> r) -> GenericQ (r, Bool) -> GenericQ r
    everythingBut [Located String] -> [Located String] -> [Located String]
    forall a. [a] -> [a] -> [a]
    (++) (([], Bool
    False) ([Located String], Bool)
    -> (GenLocated SrcSpanAnnA (HsDecl GhcPs)
        -> ([Located String], Bool))
    -> a
    -> ([Located String], Bool)
    forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
    `mkQ` AnnSelector (LHsDecl GhcPs)
    GenLocated SrcSpanAnnA (HsDecl GhcPs) -> ([Located String], Bool)
    fromLHsDecl)
     where
      fromLHsDecl :: AnnSelector (LHsDecl GhcPs)
      fromLHsDecl :: AnnSelector (LHsDecl GhcPs)
    fromLHsDecl (L (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA -> SrcSpan
    loc) HsDecl GhcPs
    decl) = case HsDecl GhcPs
    decl of
    #if __GLASGOW_HASKELL__ < 906
        AnnD _ (HsAnnotation _ (SourceText _) ModuleAnnProvenance (L _loc expr))
    #else
        AnnD XAnnD GhcPs
    _ (HsAnnotation XHsAnnotation GhcPs
    _ AnnProvenance GhcPs
    ModuleAnnProvenance (L SrcSpanAnnA
    _loc HsExpr GhcPs
    expr))
    #endif
         | Just Located String
    s <- SrcSpan -> HsExpr GhcPs -> Maybe (Located String)
    extractLit SrcSpan
    loc HsExpr GhcPs
    expr
         -> Located String -> ([Located String], Bool)
    forall a. a -> ([a], Bool)
    select Located String
    s
        HsDecl GhcPs
    _ ->
          -- XXX: Shouldn't this be handled by 'everythingBut'?
          (HsDecl GhcPs -> [Located String]
    forall a. Data a => a -> [Located String]
    extractModuleAnns HsDecl GhcPs
    decl, Bool
    True)

    -- | Extract string literals. Looks through type annotations and parentheses.
    extractLit :: SrcSpan -> HsExpr GhcPs -> Maybe (Located String)
    extractLit :: SrcSpan -> HsExpr GhcPs -> Maybe (Located String)
    extractLit SrcSpan
    loc = \case
      -- well this is a holy mess innit
    #if __GLASGOW_HASKELL__ < 904
      HsPar _ (L l e) -> extractLit (locA l) e
    #elif __GLASGOW_HASKELL__ < 909
      HsPar _ _ (L l e) _ -> extractLit (locA l) e
    #else
      HsPar XPar GhcPs
    _ (L SrcSpanAnnA
    l HsExpr GhcPs
    e) -> SrcSpan -> HsExpr GhcPs -> Maybe (Located String)
    extractLit (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    l) HsExpr GhcPs
    e
    #endif
      ExprWithTySig XExprWithTySig GhcPs
    _ (L SrcSpanAnnA
    l HsExpr GhcPs
    e) LHsSigWcType (NoGhcTc GhcPs)
    _ -> SrcSpan -> HsExpr GhcPs -> Maybe (Located String)
    extractLit (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    l) HsExpr GhcPs
    e
      HsOverLit XOverLitE GhcPs
    _ OverLit{ol_val :: forall p. HsOverLit p -> OverLitVal
    ol_val=HsIsString SourceText
    _ FastString
    s} -> Located String -> Maybe (Located String)
    forall a. a -> Maybe a
    Just (Located String -> Located String
    forall a. Located a -> Located a
    toLocated (SrcSpan -> String -> Located String
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (FastString -> String
    unpackFS FastString
    s)))
      HsLit XLitE GhcPs
    _ (HsString XHsString GhcPs
    _ FastString
    s) -> Located String -> Maybe (Located String)
    forall a. a -> Maybe a
    Just (Located String -> Located String
    forall a. Located a -> Located a
    toLocated (SrcSpan -> String -> Located String
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (FastString -> String
    unpackFS FastString
    s)))
      HsExpr GhcPs
    _ -> Maybe (Located String)
    forall a. Maybe a
    Nothing

    -- | Extract all docstrings from given value.
    extractDocStrings :: Either (HsDecl GhcPs) [LHsDecl GhcPs] -> [(Maybe String, LHsDocString)]
    extractDocStrings :: Either (HsDecl GhcPs) [LHsDecl GhcPs]
    -> [(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)
    -> GenericQ [(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)
    -> (GenLocated SrcSpanAnnA (HsDecl 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`  DocSelector (LHsDecl GhcPs)
    GenLocated SrcSpanAnnA (HsDecl GhcPs)
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromLHsDecl
          (a -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool))
    -> (GenLocated SrcSpanAnnA (DocDecl GhcPs)
        -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool))
    -> a
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a b r.
    (Typeable a, Typeable b) =>
    (a -> r) -> (b -> r) -> a -> r
    `extQ` DocSelector (LDocDecl GhcPs)
    GenLocated SrcSpanAnnA (DocDecl GhcPs)
    -> ([(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 r.
    (Typeable a, Typeable b) =>
    (a -> r) -> (b -> r) -> a -> r
    `extQ` GenLocated SrcSpan HsDocString
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromLHsDocString
    #if __GLASGOW_HASKELL__ >= 904
          (a -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool))
    -> (HsType GhcPs
        -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool))
    -> a
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a b r.
    (Typeable a, Typeable b) =>
    (a -> r) -> (b -> r) -> a -> r
    `extQ` HsType GhcPs
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromHsType
    #endif
        )
      where
        fromLHsDecl :: DocSelector (LHsDecl GhcPs)
        fromLHsDecl :: DocSelector (LHsDecl GhcPs)
    fromLHsDecl (L SrcSpanAnnA
    loc 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.
          DocD XDocD GhcPs
    _ DocDecl GhcPs
    x -> (Maybe String, GenLocated SrcSpan HsDocString)
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a. a -> ([a], Bool)
    select (SrcSpan
    -> DocDecl GhcPs -> (Maybe String, GenLocated SrcSpan HsDocString)
    fromDocDecl (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    loc) DocDecl GhcPs
    x)

          HsDecl GhcPs
    _ -> (Either (HsDecl GhcPs) [LHsDecl GhcPs]
    -> [(Maybe String, GenLocated SrcSpan HsDocString)]
    extractDocStrings (HsDecl GhcPs
    -> Either (HsDecl GhcPs) [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    forall a b. a -> Either a b
    Left HsDecl GhcPs
    decl), Bool
    True)

        fromLDocDecl :: DocSelector
    #if __GLASGOW_HASKELL__ >= 901
                                 (LDocDecl GhcPs)
    #else
                                 LDocDecl
    #endif
        fromLDocDecl :: DocSelector (LDocDecl GhcPs)
    fromLDocDecl (L SrcSpanAnnA
    loc DocDecl GhcPs
    x) = (Maybe String, GenLocated SrcSpan HsDocString)
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a. a -> ([a], Bool)
    select (SrcSpan
    -> DocDecl GhcPs -> (Maybe String, GenLocated SrcSpan HsDocString)
    fromDocDecl (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    loc) DocDecl GhcPs
    x)

        fromLHsDocString :: DocSelector LHsDocString
        fromLHsDocString :: GenLocated SrcSpan HsDocString
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromLHsDocString 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)

    #if __GLASGOW_HASKELL__ >= 904
        fromHsType :: DocSelector (HsType GhcPs)
        fromHsType :: HsType GhcPs
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    fromHsType HsType GhcPs
    x = case HsType GhcPs
    x of
          HsDocTy XDocTy GhcPs
    _ LHsType GhcPs
    _ (L SrcSpan
    loc WithHsDocIdentifiers HsDocString GhcPs
    hsDoc) -> (Maybe String, GenLocated SrcSpan HsDocString)
    -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a. a -> ([a], Bool)
    select (Maybe String
    forall a. Maybe a
    Nothing, SrcSpan -> HsDocString -> GenLocated SrcSpan HsDocString
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (WithHsDocIdentifiers HsDocString GhcPs -> HsDocString
    forall a pass. WithHsDocIdentifiers a pass -> a
    hsDocString WithHsDocIdentifiers HsDocString GhcPs
    hsDoc))
          HsType GhcPs
    _ -> ([(Maybe String, GenLocated SrcSpan HsDocString)], Bool)
    forall a. ([a], Bool)
    noSelect
    #endif

    #if __GLASGOW_HASKELL__ < 904
        fromDocDecl :: SrcSpan -> DocDecl -> (Maybe String, LHsDocString)
    #else
        fromDocDecl :: SrcSpan -> DocDecl GhcPs -> (Maybe String, LHsDocString)
    #endif
        fromDocDecl :: SrcSpan
    -> DocDecl GhcPs -> (Maybe String, GenLocated SrcSpan HsDocString)
    fromDocDecl SrcSpan
    loc DocDecl GhcPs
    x = case DocDecl GhcPs
    x of
    #if __GLASGOW_HASKELL__ < 904
          DocCommentNamed name doc -> (Just name, L loc doc)
          _                        -> (Nothing, L loc $ docDeclDoc x)
    #else
          DocCommentNamed String
    name GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    doc -> (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    name, 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)
    doc)
          DocDecl GhcPs
    _                        -> (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
    $ WithHsDocIdentifiers HsDocString GhcPs -> HsDocString
    forall a pass. WithHsDocIdentifiers a pass -> a
    hsDocString (WithHsDocIdentifiers HsDocString GhcPs -> HsDocString)
    -> WithHsDocIdentifiers HsDocString GhcPs -> HsDocString
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    -> WithHsDocIdentifiers HsDocString GhcPs
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
     -> WithHsDocIdentifiers HsDocString GhcPs)
    -> GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    -> WithHsDocIdentifiers HsDocString GhcPs
    forall a b. (a -> b) -> a -> b
    $ DocDecl GhcPs
    -> GenLocated SrcSpan (WithHsDocIdentifiers HsDocString GhcPs)
    forall pass. DocDecl pass -> LHsDoc pass
    docDeclDoc DocDecl GhcPs
    x)
    #endif

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