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

module Test.DocTest.Internal.Extract (Module(..), extract, eraseConfigLocation) where

import           Prelude hiding (mod, concat)
import           Control.Monad
import           Control.Exception
import           Data.List (partition, isPrefixOf)
import           Data.List.Extra (trim)
import           Data.Maybe

import           Control.DeepSeq (NFData, deepseq)
import           Data.Generics (Data, Typeable, extQ, mkQ, everythingBut)

import qualified GHC

#if __GLASGOW_HASKELL__ < 900
import           GHC hiding (Module, Located, moduleName)
import           DynFlags
import           MonadUtils (liftIO)
#else
import           GHC hiding (Module, Located, moduleName)
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

#if __GLASGOW_HASKELL__ < 900
import           BasicTypes (SourceText(SourceText))
import           FastString (unpackFS)
#elif __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           System.Posix.Internals (c_getpid)

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

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

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

import           GHC.Generics (Generic)


-- | 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 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

-- | 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)

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

#if __GLASGOW_HASKELL__ < 803
type GhcPs = RdrName
#endif

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

-- | 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
  [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)
  ModuleGraph
mods <- [ModuleName] -> Bool -> Ghc ModuleGraph
forall (m :: * -> *).
GhcMonad m =>
[ModuleName] -> Bool -> m ModuleGraph
depanal [] Bool
False

  let sortedMods :: [ModSummary]
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
  [ParsedModule] -> [ParsedModule]
forall a. [a] -> [a]
reverse ([ParsedModule] -> [ParsedModule])
-> Ghc [ParsedModule] -> Ghc [ParsedModule]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModSummary -> Ghc ParsedModule)
-> [ModSummary] -> Ghc [ParsedModule]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ModSummary -> Ghc ModSummary
forall {m :: * -> *}. GhcMonad m => ModSummary -> m ModSummary
loadModPlugins (ModSummary -> Ghc ModSummary)
-> (ModSummary -> Ghc ParsedModule)
-> ModSummary
-> Ghc ParsedModule
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]
sortedMods

  where
    -- copied from Haddock/GhcUtils.hs
    modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc ()
    modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc ()
modifySessionDynFlags DynFlags -> DynFlags
f = do
      DynFlags
dflags <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
      let dflags' :: DynFlags
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
      ()
_ <- DynFlags -> Ghc ()
forall (m :: * -> *).
(HasCallStack, GhcMonad m) =>
DynFlags -> m ()
setSessionDynFlags (DynFlags -> DynFlags
f DynFlags
dflags')
      () -> Ghc ()
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    withTempOutputDir :: Ghc a -> Ghc a
    withTempOutputDir :: forall a. Ghc a -> Ghc a
withTempOutputDir Ghc a
action = do
      String
tmp <- IO String -> Ghc String
forall a. IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getTemporaryDirectory
      CPid
x   <- IO CPid -> Ghc CPid
forall a. IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CPid
c_getpid
      let dir :: String
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
      (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 a. IO a -> Ghc a
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 a. IO a -> Ghc a
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
#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]
      }


#if __GLASGOW_HASKELL__ >= 806
    -- 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)
      HscEnv
hsc_env <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession

# if __GLASGOW_HASKELL__ >= 901
      HscEnv
hsc_env' <- IO HscEnv -> m HscEnv
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> IO HscEnv
initializePlugins HscEnv
hsc_env)
      HscEnv -> m ()
forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession HscEnv
hsc_env'
      ModSummary -> m ModSummary
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModSummary -> m ModSummary) -> ModSummary -> m ModSummary
forall a b. (a -> b) -> a -> b
$ ModSummary
modsum
# else
      dynflags' <- liftIO (initializePlugins hsc_env (GHC.ms_hspp_opts modsum))
      return $ modsum { ms_hspp_opts = dynflags' }
# endif
#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 [String]
args = do
  [ParsedModule]
mods <- [String] -> IO [ParsedModule]
parse [String]
args
  let docs :: [Module (Located String)]
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

  ([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 a. a -> IO a
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 (\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 ParsedModule
m = Module
  { moduleName :: String
moduleName = String
name
  , 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 = ParsedModule -> [Located String]
moduleAnnsFromModule ParsedModule
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 (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

-- | Extract all module annotations from given module.
moduleAnnsFromModule :: ParsedModule -> [Located String]
moduleAnnsFromModule :: ParsedModule -> [Located String]
moduleAnnsFromModule ParsedModule
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 = (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

-- | Extract all docstrings from given module.
docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)]
docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)]
docStringsFromModule ParsedModule
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 = (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)]
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. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) HsDocString
doc)
#if __GLASGOW_HASKELL__ < 710
            | L loc (IEDoc doc) <- concat (hsmodExports source)
#elif __GLASGOW_HASKELL__ < 805
            | L loc (IEDoc doc) <- maybe [] unLoc (hsmodExports source)
#elif __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. SrcSpanAnn' a -> SrcSpan
locA -> SrcSpan
loc) HsDecl GhcPs
decl) = case HsDecl GhcPs
decl of
#if __GLASGOW_HASKELL__ < 805
    AnnD (HsAnnotation (SourceText _) ModuleAnnProvenance (L _loc expr))
#elif __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__ < 805
  HsPar (L l e) -> extractLit l e
  ExprWithTySig (L l e) _ -> extractLit l e
  HsOverLit OverLit{ol_val=HsIsString _ s} -> Just (toLocated (L loc (unpackFS s)))
  HsLit (HsString _ s) -> Just (toLocated (L loc (unpackFS s)))
  _ -> Nothing
#else
#if __GLASGOW_HASKELL__ < 904
  HsPar _ (L l e) -> extractLit (locA l) e
#else
  HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ (L SrcSpanAnnA
l HsExpr GhcPs
e) LHsToken ")" GhcPs
_ -> SrcSpan -> HsExpr GhcPs -> Maybe (Located String)
extractLit (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) HsExpr GhcPs
e
#endif
#if __GLASGOW_HASKELL__ < 807
  ExprWithTySig _ (L l e) -> extractLit l e
#else
  ExprWithTySig XExprWithTySig GhcPs
_ (L SrcSpanAnnA
l HsExpr GhcPs
e) LHsSigWcType (NoGhcTc GhcPs)
_ -> SrcSpan -> HsExpr GhcPs -> Maybe (Located String)
extractLit (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) HsExpr GhcPs
e
#endif
  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
#endif

-- | 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.
#if __GLASGOW_HASKELL__ < 805
      DocD x
#else
      DocD XDocD GhcPs
_ DocDecl GhcPs
x
#endif
           -> (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. SrcSpanAnn' 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. SrcSpanAnn' 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__ < 805
-- | Convert a docstring to a plain string.
unpackHDS :: HsDocString -> String
unpackHDS (HsDocString s) = unpackFS s
#endif

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