-- | Types and functions for raw and lexed docstrings.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}

module GHC.Hs.Doc
  ( HsDoc
  , WithHsDocIdentifiers(..)
  , hsDocIds
  , LHsDoc
  , pprHsDocDebug
  , pprWithDoc
  , pprMaybeWithDoc

  , module GHC.Hs.DocString

  , ExtractedTHDocs(..)

  , DocStructureItem(..)
  , DocStructure

  , Docs(..)
  , emptyDocs
  ) where

import GHC.Prelude

import GHC.Utils.Binary
import GHC.Types.Name
import GHC.Utils.Outputable as Outputable hiding ((<>))
import GHC.Types.SrcLoc
import qualified GHC.Data.EnumSet as EnumSet
import GHC.Data.EnumSet (EnumSet)
import GHC.Types.Avail
import GHC.Types.Name.Set
import GHC.Driver.Flags

import Control.DeepSeq
import Data.Data
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Map (Map)
import qualified Data.Map as Map
import Data.List.NonEmpty (NonEmpty(..))
import GHC.LanguageExtensions.Type
import qualified GHC.Utils.Outputable as O
import GHC.Hs.Extension
import GHC.Types.Unique.Map
import Data.List (sortBy)

import GHC.Hs.DocString

import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Module.Name

-- | A docstring with the (probable) identifiers found in it.
type HsDoc = WithHsDocIdentifiers HsDocString

-- | Annotate a value with the probable identifiers found in it
-- These will be used by haddock to generate links.
--
-- The identifiers are bundled along with their location in the source file.
-- This is useful for tooling to know exactly where they originate.
--
-- This type is currently used in two places - for regular documentation comments,
-- with 'a' set to 'HsDocString', and for adding identifier information to
-- warnings, where 'a' is 'StringLiteral'
data WithHsDocIdentifiers a pass = WithHsDocIdentifiers
  { forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString      :: !a
  , forall a pass. WithHsDocIdentifiers a pass -> [Located (IdP pass)]
hsDocIdentifiers :: ![Located (IdP pass)]
  }

deriving instance (Data pass, Data (IdP pass), Data a) => Data (WithHsDocIdentifiers a pass)
deriving instance (Eq (IdP pass), Eq a) => Eq (WithHsDocIdentifiers a pass)
instance (NFData (IdP pass), NFData a) => NFData (WithHsDocIdentifiers a pass) where
  rnf :: WithHsDocIdentifiers a pass -> ()
rnf (WithHsDocIdentifiers a
d [Located (IdP pass)]
i) = forall a. NFData a => a -> ()
rnf a
d seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Located (IdP pass)]
i

-- | For compatibility with the existing @-ddump-parsed' output, we only show
-- the docstring.
--
-- Use 'pprHsDoc' to show `HsDoc`'s internals.
instance Outputable a => Outputable (WithHsDocIdentifiers a pass) where
  ppr :: WithHsDocIdentifiers a pass -> SDoc
ppr (WithHsDocIdentifiers a
s [Located (IdP pass)]
_ids) = forall a. Outputable a => a -> SDoc
ppr a
s

instance Binary a => Binary (WithHsDocIdentifiers a GhcRn) where
  put_ :: BinHandle -> WithHsDocIdentifiers a GhcRn -> IO ()
put_ BinHandle
bh (WithHsDocIdentifiers a
s [Located (IdP GhcRn)]
ids) = do
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
s
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh forall a b. (a -> b) -> a -> b
$ forall a. Located a -> BinLocated a
BinLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located (IdP GhcRn)]
ids
  get :: BinHandle -> IO (WithHsDocIdentifiers a GhcRn)
get BinHandle
bh =
    forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a pass.
a -> [Located (IdP pass)] -> WithHsDocIdentifiers a pass
WithHsDocIdentifiers (forall a. Binary a => BinHandle -> IO a
get BinHandle
bh) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. BinLocated a -> Located a
unBinLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)

-- | Extract a mapping from the lexed identifiers to the names they may
-- correspond to.
hsDocIds :: WithHsDocIdentifiers a GhcRn -> NameSet
hsDocIds :: forall a. WithHsDocIdentifiers a GhcRn -> NameSet
hsDocIds (WithHsDocIdentifiers a
_ [Located (IdP GhcRn)]
ids) = [Name] -> NameSet
mkNameSet forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc [Located (IdP GhcRn)]
ids

-- | Pretty print a thing with its doc
-- The docstring will include the comment decorators '-- |', '{-|' etc
-- and will come either before or after depending on how it was written
-- i.e it will come after the thing if it is a '-- ^' or '{-^' and before
-- otherwise.
pprWithDoc :: LHsDoc name -> SDoc -> SDoc
pprWithDoc :: forall name. LHsDoc name -> SDoc -> SDoc
pprWithDoc LHsDoc name
doc = HsDocString -> SDoc -> SDoc
pprWithDocString (forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc LHsDoc name
doc)

-- | See 'pprWithHsDoc'
pprMaybeWithDoc :: Maybe (LHsDoc name) -> SDoc -> SDoc
pprMaybeWithDoc :: forall name. Maybe (LHsDoc name) -> SDoc -> SDoc
pprMaybeWithDoc Maybe (LHsDoc name)
Nothing    = forall a. a -> a
id
pprMaybeWithDoc (Just LHsDoc name
doc) = forall name. LHsDoc name -> SDoc -> SDoc
pprWithDoc LHsDoc name
doc

-- | Print a doc with its identifiers, useful for debugging
pprHsDocDebug :: (Outputable (IdP name)) => HsDoc name -> SDoc
pprHsDocDebug :: forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug (WithHsDocIdentifiers HsDocString
s [Located (IdP name)]
ids) =
    forall doc. IsDoc doc => [doc] -> doc
vcat [ forall doc. IsLine doc => String -> doc
text String
"text:" forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (HsDocString -> SDoc
pprHsDocString HsDocString
s)
         , forall doc. IsLine doc => String -> doc
text String
"identifiers:" forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall doc. IsDoc doc => [doc] -> doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall l e. (Outputable l, Outputable e) => GenLocated l e -> SDoc
pprLocatedAlways [Located (IdP name)]
ids))
         ]

type LHsDoc pass = Located (HsDoc pass)

-- | A simplified version of 'HsImpExp.IE'.
data DocStructureItem
  = DsiSectionHeading !Int !(HsDoc GhcRn)
  | DsiDocChunk !(HsDoc GhcRn)
  | DsiNamedChunkRef !(String)
  | DsiExports !Avails
  | DsiModExport
      !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple
                            -- modules with a single export declaration. E.g.
                            -- when we have
                            --
                            -- > module M (module X) where
                            -- > import R0 as X
                            -- > import R1 as X
      !Avails

instance Binary DocStructureItem where
  put_ :: BinHandle -> DocStructureItem -> IO ()
put_ BinHandle
bh = \case
    DsiSectionHeading Int
level HsDoc GhcRn
doc -> do
      BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
level
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HsDoc GhcRn
doc
    DsiDocChunk HsDoc GhcRn
doc -> do
      BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HsDoc GhcRn
doc
    DsiNamedChunkRef String
name -> do
      BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
name
    DsiExports Avails
avails -> do
      BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Avails
avails
    DsiModExport NonEmpty ModuleName
mod_names Avails
avails -> do
      BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh NonEmpty ModuleName
mod_names
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Avails
avails

  get :: BinHandle -> IO DocStructureItem
get BinHandle
bh = do
    Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
    case Word8
tag of
      Word8
0 -> Int -> HsDoc GhcRn -> DocStructureItem
DsiSectionHeading forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
1 -> HsDoc GhcRn -> DocStructureItem
DsiDocChunk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
2 -> String -> DocStructureItem
DsiNamedChunkRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
3 -> Avails -> DocStructureItem
DsiExports forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
4 -> NonEmpty ModuleName -> Avails -> DocStructureItem
DsiModExport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"instance Binary DocStructureItem: Invalid tag"

instance Outputable DocStructureItem where
  ppr :: DocStructureItem -> SDoc
ppr = \case
    DsiSectionHeading Int
level HsDoc GhcRn
doc -> forall doc. IsDoc doc => [doc] -> doc
vcat
      [ forall doc. IsLine doc => String -> doc
text String
"section heading, level" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr Int
level forall doc. IsLine doc => doc -> doc -> doc
O.<> forall doc. IsLine doc => doc
colon
      , Int -> SDoc -> SDoc
nest Int
2 (forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug HsDoc GhcRn
doc)
      ]
    DsiDocChunk HsDoc GhcRn
doc -> forall doc. IsDoc doc => [doc] -> doc
vcat
      [ forall doc. IsLine doc => String -> doc
text String
"documentation chunk:"
      , Int -> SDoc -> SDoc
nest Int
2 (forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug HsDoc GhcRn
doc)
      ]
    DsiNamedChunkRef String
name ->
      forall doc. IsLine doc => String -> doc
text String
"reference to named chunk:" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => String -> doc
text String
name
    DsiExports Avails
avails ->
      forall doc. IsLine doc => String -> doc
text String
"avails:" forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr Avails
avails)
    DsiModExport NonEmpty ModuleName
mod_names Avails
avails ->
      forall doc. IsLine doc => String -> doc
text String
"re-exported module(s):" forall doc. IsLine doc => doc -> doc -> doc
<+> forall a. Outputable a => a -> SDoc
ppr NonEmpty ModuleName
mod_names forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr Avails
avails)

instance NFData DocStructureItem where
  rnf :: DocStructureItem -> ()
rnf = \case
    DsiSectionHeading Int
level HsDoc GhcRn
doc -> forall a. NFData a => a -> ()
rnf Int
level seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf HsDoc GhcRn
doc
    DsiDocChunk HsDoc GhcRn
doc -> forall a. NFData a => a -> ()
rnf HsDoc GhcRn
doc
    DsiNamedChunkRef String
name -> forall a. NFData a => a -> ()
rnf String
name
    DsiExports Avails
avails -> forall a. NFData a => a -> ()
rnf Avails
avails
    DsiModExport NonEmpty ModuleName
mod_names Avails
avails -> forall a. NFData a => a -> ()
rnf NonEmpty ModuleName
mod_names seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Avails
avails


type DocStructure = [DocStructureItem]

data Docs = Docs
  { Docs -> Maybe (HsDoc GhcRn)
docs_mod_hdr      :: Maybe (HsDoc GhcRn)
    -- ^ Module header.
  , Docs -> UniqMap Name [HsDoc GhcRn]
docs_decls        :: UniqMap Name [HsDoc GhcRn]
    -- ^ Docs for declarations: functions, data types, instances, methods etc.
    -- A list because sometimes subsequent haddock comments can be combined into one
  , Docs -> UniqMap Name (IntMap (HsDoc GhcRn))
docs_args         :: UniqMap Name (IntMap (HsDoc GhcRn))
    -- ^ Docs for arguments. E.g. function arguments, method arguments.
  , Docs -> DocStructure
docs_structure    :: DocStructure
  , Docs -> Map String (HsDoc GhcRn)
docs_named_chunks :: Map String (HsDoc GhcRn)
    -- ^ Map from chunk name to content.
    --
    -- This map will be empty unless we have an explicit export list from which
    -- we can reference the chunks.
  , Docs -> Maybe String
docs_haddock_opts :: Maybe String
    -- ^ Haddock options from @OPTIONS_HADDOCK@ or from @-haddock-opts@.
  , Docs -> Maybe Language
docs_language     :: Maybe Language
    -- ^ The 'Language' used in the module, for example 'Haskell2010'.
  , Docs -> EnumSet Extension
docs_extensions   :: EnumSet Extension
    -- ^ The full set of language extensions used in the module.
  }

instance NFData Docs where
  rnf :: Docs -> ()
rnf (Docs Maybe (HsDoc GhcRn)
mod_hdr UniqMap Name [HsDoc GhcRn]
decls UniqMap Name (IntMap (HsDoc GhcRn))
args DocStructure
structure Map String (HsDoc GhcRn)
named_chunks Maybe String
haddock_opts Maybe Language
language EnumSet Extension
extentions)
    = forall a. NFData a => a -> ()
rnf Maybe (HsDoc GhcRn)
mod_hdr seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf UniqMap Name [HsDoc GhcRn]
decls seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf UniqMap Name (IntMap (HsDoc GhcRn))
args seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf DocStructure
structure seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Map String (HsDoc GhcRn)
named_chunks
    seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe String
haddock_opts seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Maybe Language
language seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf EnumSet Extension
extentions
    seq :: forall a b. a -> b -> b
`seq` ()

instance Binary Docs where
  put_ :: BinHandle -> Docs -> IO ()
put_ BinHandle
bh Docs
docs = do
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Docs -> Maybe (HsDoc GhcRn)
docs_mod_hdr Docs
docs)
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Name, [HsDoc GhcRn])
a (Name, [HsDoc GhcRn])
b -> (forall a b. (a, b) -> a
fst (Name, [HsDoc GhcRn])
a) Name -> Name -> Ordering
`stableNameCmp` forall a b. (a, b) -> a
fst (Name, [HsDoc GhcRn])
b) forall a b. (a -> b) -> a -> b
$ forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap forall a b. (a -> b) -> a -> b
$ Docs -> UniqMap Name [HsDoc GhcRn]
docs_decls Docs
docs)
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Name, IntMap (HsDoc GhcRn))
a (Name, IntMap (HsDoc GhcRn))
b -> (forall a b. (a, b) -> a
fst (Name, IntMap (HsDoc GhcRn))
a) Name -> Name -> Ordering
`stableNameCmp` forall a b. (a, b) -> a
fst (Name, IntMap (HsDoc GhcRn))
b) forall a b. (a -> b) -> a -> b
$ forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap forall a b. (a -> b) -> a -> b
$ Docs -> UniqMap Name (IntMap (HsDoc GhcRn))
docs_args Docs
docs)
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Docs -> DocStructure
docs_structure Docs
docs)
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Docs -> Map String (HsDoc GhcRn)
docs_named_chunks Docs
docs)
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Docs -> Maybe String
docs_haddock_opts Docs
docs)
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Docs -> Maybe Language
docs_language Docs
docs)
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Docs -> EnumSet Extension
docs_extensions Docs
docs)
  get :: BinHandle -> IO Docs
get BinHandle
bh = do
    Maybe (HsDoc GhcRn)
mod_hdr <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    UniqMap Name [HsDoc GhcRn]
decls <- forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    UniqMap Name (IntMap (HsDoc GhcRn))
args <- forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    DocStructure
structure <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Map String (HsDoc GhcRn)
named_chunks <- forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe String
haddock_opts <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe Language
language <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    EnumSet Extension
exts <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Docs { docs_mod_hdr :: Maybe (HsDoc GhcRn)
docs_mod_hdr = Maybe (HsDoc GhcRn)
mod_hdr
              , docs_decls :: UniqMap Name [HsDoc GhcRn]
docs_decls =  UniqMap Name [HsDoc GhcRn]
decls
              , docs_args :: UniqMap Name (IntMap (HsDoc GhcRn))
docs_args = UniqMap Name (IntMap (HsDoc GhcRn))
args
              , docs_structure :: DocStructure
docs_structure = DocStructure
structure
              , docs_named_chunks :: Map String (HsDoc GhcRn)
docs_named_chunks = Map String (HsDoc GhcRn)
named_chunks
              , docs_haddock_opts :: Maybe String
docs_haddock_opts = Maybe String
haddock_opts
              , docs_language :: Maybe Language
docs_language = Maybe Language
language
              , docs_extensions :: EnumSet Extension
docs_extensions = EnumSet Extension
exts
              }

instance Outputable Docs where
  ppr :: Docs -> SDoc
ppr Docs
docs =
      forall doc. IsDoc doc => [doc] -> doc
vcat
        [ forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField (forall {doc} {t}. IsLine doc => (t -> doc) -> Maybe t -> doc
pprMaybe forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug) String
"module header" Docs -> Maybe (HsDoc GhcRn)
docs_mod_hdr
        , forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField (forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug)) String
"declaration docs" Docs -> UniqMap Name [HsDoc GhcRn]
docs_decls
        , forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField (forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {t}. (Int -> SDoc) -> (t -> SDoc) -> IntMap t -> SDoc
pprIntMap forall a. Outputable a => a -> SDoc
ppr forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug)) String
"arg docs" Docs -> UniqMap Name (IntMap (HsDoc GhcRn))
docs_args
        , forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField (forall doc. IsDoc doc => [doc] -> doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr) String
"documentation structure" Docs -> DocStructure
docs_structure
        , forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField (forall {t} {t}. (t -> SDoc) -> (t -> SDoc) -> Map t t -> SDoc
pprMap (forall doc. IsLine doc => doc -> doc
doubleQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall doc. IsLine doc => String -> doc
text) forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug) String
"named chunks"
                   Docs -> Map String (HsDoc GhcRn)
docs_named_chunks
        , forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField forall {doc}. IsLine doc => Maybe String -> doc
pprMbString String
"haddock options" Docs -> Maybe String
docs_haddock_opts
        , forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField forall a. Outputable a => a -> SDoc
ppr String
"language" Docs -> Maybe Language
docs_language
        , forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField (forall doc. IsDoc doc => [doc] -> doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => EnumSet a -> [a]
EnumSet.toList) String
"language extensions"
                   Docs -> EnumSet Extension
docs_extensions
        ]
    where
      pprField :: (a -> SDoc) -> String -> (Docs -> a) -> SDoc
      pprField :: forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField a -> SDoc
ppr' String
heading Docs -> a
lbl =
        forall doc. IsLine doc => String -> doc
text String
heading forall doc. IsLine doc => doc -> doc -> doc
O.<> forall doc. IsLine doc => doc
colon forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (a -> SDoc
ppr' (Docs -> a
lbl Docs
docs))
      pprMap :: (t -> SDoc) -> (t -> SDoc) -> Map t t -> SDoc
pprMap t -> SDoc
pprKey t -> SDoc
pprVal Map t t
m =
        forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall k a. Map k a -> [(k, a)]
Map.toList Map t t
m) forall a b. (a -> b) -> a -> b
$ \(t
k, t
v) ->
          t -> SDoc
pprKey t
k forall doc. IsLine doc => doc -> doc -> doc
O.<> forall doc. IsLine doc => doc
colon forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (t -> SDoc
pprVal t
v)
      pprIntMap :: (Int -> SDoc) -> (t -> SDoc) -> IntMap t -> SDoc
pprIntMap Int -> SDoc
pprKey t -> SDoc
pprVal IntMap t
m =
        forall doc. IsDoc doc => [doc] -> doc
vcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap t
m) forall a b. (a -> b) -> a -> b
$ \(Int
k, t
v) ->
          Int -> SDoc
pprKey Int
k forall doc. IsLine doc => doc -> doc -> doc
O.<> forall doc. IsLine doc => doc
colon forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 (t -> SDoc
pprVal t
v)
      pprMbString :: Maybe String -> doc
pprMbString Maybe String
Nothing = forall doc. IsOutput doc => doc
empty
      pprMbString (Just String
s) = forall doc. IsLine doc => String -> doc
text String
s
      pprMaybe :: (t -> doc) -> Maybe t -> doc
pprMaybe t -> doc
ppr' = \case
        Maybe t
Nothing -> forall doc. IsLine doc => String -> doc
text String
"Nothing"
        Just t
x -> forall doc. IsLine doc => String -> doc
text String
"Just" forall doc. IsLine doc => doc -> doc -> doc
<+> t -> doc
ppr' t
x

emptyDocs :: Docs
emptyDocs :: Docs
emptyDocs = Docs
  { docs_mod_hdr :: Maybe (HsDoc GhcRn)
docs_mod_hdr = forall a. Maybe a
Nothing
  , docs_decls :: UniqMap Name [HsDoc GhcRn]
docs_decls = forall k a. UniqMap k a
emptyUniqMap
  , docs_args :: UniqMap Name (IntMap (HsDoc GhcRn))
docs_args = forall k a. UniqMap k a
emptyUniqMap
  , docs_structure :: DocStructure
docs_structure = []
  , docs_named_chunks :: Map String (HsDoc GhcRn)
docs_named_chunks = forall k a. Map k a
Map.empty
  , docs_haddock_opts :: Maybe String
docs_haddock_opts = forall a. Maybe a
Nothing
  , docs_language :: Maybe Language
docs_language = forall a. Maybe a
Nothing
  , docs_extensions :: EnumSet Extension
docs_extensions = forall a. EnumSet a
EnumSet.empty
  }

-- | Maps of docs that were added via Template Haskell's @putDoc@.
data ExtractedTHDocs =
  ExtractedTHDocs
    { ExtractedTHDocs -> Maybe (HsDoc GhcRn)
ethd_mod_header :: Maybe (HsDoc GhcRn)
      -- ^ The added module header documentation, if it exists.
    , ExtractedTHDocs -> UniqMap Name (HsDoc GhcRn)
ethd_decl_docs  :: UniqMap Name (HsDoc GhcRn)
      -- ^ The documentation added to declarations.
    , ExtractedTHDocs -> UniqMap Name (IntMap (HsDoc GhcRn))
ethd_arg_docs   :: UniqMap Name (IntMap (HsDoc GhcRn))
      -- ^ The documentation added to function arguments.
    , ExtractedTHDocs -> UniqMap Name (HsDoc GhcRn)
ethd_inst_docs  :: UniqMap Name (HsDoc GhcRn)
      -- ^ The documentation added to class and family instances.
    }