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

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

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

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

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

import           System.Directory
import           System.FilePath

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

import           System.Posix.Internals (c_getpid)

import           GhcUtil (withGhc)
import           Location hiding (unLoc)

import           Util (convertDosLineEndings)
import           PackageDBs (getPackageDBArgs)

#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

-- | 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
"    " forall a. [a] -> [a] -> [a]
++ String
msg
      , String
""
      , String
"This is most likely a bug in doctest."
      , String
""
      , String
"Please report it here: https://github.com/sol/doctest/issues/new"
      ]
    where
      msg :: String
msg = case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
        Just (Panic String
s) -> String
"GHC panic: " forall a. [a] -> [a] -> [a]
++ String
s
        Maybe GhcException
_              -> forall a. Show a => a -> String
show SomeException
e

instance Exception ExtractError

-- | Documentation for a module grouped together with the modules name.
data Module a = Module {
  forall a. Module a -> String
moduleName    :: String
, forall a. Module a -> Maybe a
moduleSetup   :: Maybe a
, forall a. Module a -> [a]
moduleContent :: [a]
} deriving (Module a -> Module a -> Bool
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, Int -> Module a -> ShowS
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
showList :: [Module a] -> ShowS
$cshowList :: forall a. Show a => [Module a] -> ShowS
show :: Module a -> String
$cshow :: forall a. Show a => Module a -> String
showsPrec :: Int -> Module a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Module a -> ShowS
Show, 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
<$ :: forall a b. a -> Module b -> Module a
$c<$ :: forall a b. a -> Module b -> Module a
fmap :: forall a b. (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 String
name Maybe a
setup [a]
content) = String
name forall a b. NFData a => a -> b -> b
`deepseq` Maybe a
setup forall a b. NFData a => a -> b -> b
`deepseq` [a]
content forall a b. NFData a => a -> b -> b
`deepseq` ()

#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 = forall a. [String] -> ([String] -> Ghc a) -> IO a
withGhc [String]
args forall a b. (a -> b) -> a -> b
$ \[String]
modules_ -> forall a. Ghc a -> Ghc a
withTempOutputDir forall a b. (a -> b) -> a -> b
$ do

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

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

  let sortedMods :: [ModSummary]
sortedMods = forall a. [SCC a] -> [a]
flattenSCCs
#if __GLASGOW_HASKELL__ >= 901
                     forall a b. (a -> b) -> a -> b
$ [SCC ModuleGraphNode] -> [SCC ModSummary]
filterToposortToModules
#endif
                     forall a b. (a -> b) -> a -> b
$ Bool -> ModuleGraph -> Maybe ModuleName -> [SCC ModuleGraphNode]
topSortModuleGraph Bool
False ModuleGraph
mods forall a. Maybe a
Nothing
  forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}. GhcMonad m => ModSummary -> m ModSummary
loadModPlugins forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> 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 <- forall (m :: * -> *). GhcMonad m => m DynFlags
getSessionDynFlags
      -- GHCi 7.7 now uses dynamic linking.
      let dflags' :: DynFlags
dflags' = case 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
      ()
_ <- forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
setSessionDynFlags (DynFlags -> DynFlags
f DynFlags
dflags')
      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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getTemporaryDirectory
      CPid
x   <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CPid
c_getpid
      let dir :: String
dir = String
tmp String -> ShowS
</> String
".doctest-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CPid
x
      (DynFlags -> DynFlags) -> Ghc ()
modifySessionDynFlags (String -> DynFlags -> DynFlags
setOutputDir String
dir)
      forall (m :: * -> *) a b c.
ExceptionMonad m =>
m a -> m b -> m c -> m c
gbracket_
        (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
createDirectory String
dir)
        (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket m a
before_ (\ a
_ ExitCase c
_ -> m b
after) (forall a b. a -> b -> a
const m c
thing)
#endif

    setOutputDir :: String -> DynFlags -> DynFlags
setOutputDir String
f DynFlags
d = DynFlags
d {
        objectDir :: Maybe String
objectDir  = forall a. a -> Maybe a
Just String
f
      , hiDir :: Maybe String
hiDir      = forall a. a -> Maybe a
Just String
f
      , stubDir :: Maybe String
stubDir    = 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 ModSummary
modsum = do
      ()
_ <- forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
setSessionDynFlags (ModSummary -> DynFlags
GHC.ms_hspp_opts ModSummary
modsum)
      HscEnv
hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
getSession

# if __GLASGOW_HASKELL__ >= 902
      HscEnv
hsc_env' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> IO HscEnv
initializePlugins HscEnv
hsc_env)
      forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
setSession HscEnv
hsc_env'
      forall (m :: * -> *) a. Monad m => a -> m a
return 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
  [String]
packageDBArgs <- IO [String]
getPackageDBArgs
  let args' :: [String]
args'  = [String]
args forall a. [a] -> [a] -> [a]
++ [String]
packageDBArgs
  [ParsedModule]
mods <- [String] -> IO [ParsedModule]
parse [String]
args'
  let docs :: [Module (Located String)]
docs = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
convertDosLineEndings) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> Module (Located String)
extractFromModule) [ParsedModule]
mods

  ([Module (Located String)]
docs forall a b. NFData a => a -> b -> b
`deepseq` forall (m :: * -> *) a. Monad m => a -> m a
return [Module (Located String)]
docs) 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.
      forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\AsyncException
e -> forall a e. Exception e => e -> a
throw (AsyncException
e :: AsyncException))
    , forall a e. Exception e => (e -> IO a) -> Handler a
Handler (forall e a. Exception e => e -> IO a
throwIO 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 = forall a. String -> Maybe a -> [a] -> Module a
Module String
name (forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Maybe String, Located String)]
setup) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Maybe String, Located String)]
docs)
  where
    isSetup :: (Maybe String, b) -> Bool
isSetup = (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"setup") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
    ([(Maybe String, Located String)]
setup, [(Maybe String, Located String)]
docs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition forall {b}. (Maybe String, b) -> Bool
isSetup (ParsedModule -> [(Maybe String, Located String)]
docStringsFromModule ParsedModule
m)
    name :: String
name = (ModuleName -> String
moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
GHC.moduleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> GenModule Unit
ms_mod forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedModule -> ModSummary
pm_mod_summary) ParsedModule
m

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

-- | Extract all docstrings from given module.
docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)]
docStringsFromModule :: ParsedModule -> [(Maybe String, Located String)]
docStringsFromModule ParsedModule
mod = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Located a -> Located a
toLocated forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
source   = (forall l e. GenLocated l e -> e
unLoc 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, LHsDocString)]
    docs :: [(Maybe String, GenLocated SrcSpan HsDocString)]
docs     = forall {a}. [(Maybe a, GenLocated SrcSpan HsDocString)]
header forall a. [a] -> [a] -> [a]
++ [(Maybe String, GenLocated SrcSpan HsDocString)]
exports forall a. [a] -> [a] -> [a]
++ [(Maybe String, GenLocated SrcSpan HsDocString)]
decls

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

-- | Extract all docstrings from given value.
extractDocStrings :: Data a => a -> [(Maybe String, LHsDocString)]
extractDocStrings :: forall a.
Data a =>
a -> [(Maybe String, GenLocated SrcSpan HsDocString)]
extractDocStrings a
d =
#if __GLASGOW_HASKELL__ >= 904
  let
    docStrs = extractAll extractDocDocString d
    docStrNames = catMaybes $ extractAll extractDocName d
  in
    flip fmap docStrs $ \docStr -> (lookup (getLoc docStr) docStrNames, docStr)
  where
    extractAll z = everything (++) ((mkQ [] ((:[]) . z)))

    extractDocDocString :: LHsDoc GhcPs -> LHsDocString
    extractDocDocString = fmap hsDocString

    extractDocName :: DocDecl GhcPs -> Maybe (SrcSpan, String)
    extractDocName docDecl = case docDecl of
      DocCommentNamed name y ->
        Just (getLoc y, name)
      _ ->
        Nothing
#else
  forall r. (r -> r -> r) -> GenericQ (r, Bool) -> GenericQ r
everythingBut forall a. [a] -> [a] -> [a]
(++) (([], Bool
False) forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`mkQ` Selector (LHsDecl GhcPs)
fromLHsDecl
  forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` Selector (LDocDecl GhcPs)
fromLDocDecl
  forall a b r.
(Typeable a, Typeable b) =>
(a -> r) -> (b -> r) -> a -> r
`extQ` Selector (GenLocated SrcSpan HsDocString)
fromLHsDocString
  ) a
d
  where
    fromLHsDecl :: Selector (LHsDecl GhcPs)
    fromLHsDecl :: Selector (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
x
#endif
               -> forall a. a -> ([a], Bool)
select (SrcSpan
-> DocDecl -> (Maybe String, GenLocated SrcSpan HsDocString)
fromDocDecl (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) DocDecl
x)

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

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

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

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

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

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