-- | 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.Unit.Module.Name
import GHC.Driver.Flags

import Control.Applicative (liftA2)
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 Language.Haskell.Syntax.Extension
import GHC.Hs.Extension
import GHC.Types.Unique.Map
import Data.List (sortBy)

import GHC.Hs.DocString

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

-- | 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) = a -> SDoc
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
    BinHandle -> a -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
s
    BinHandle -> [Located Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Located (IdP GhcRn)]
[Located Name]
ids
  get :: BinHandle -> IO (WithHsDocIdentifiers a GhcRn)
get BinHandle
bh =
    (a -> [Located Name] -> WithHsDocIdentifiers a GhcRn)
-> IO a -> IO [Located Name] -> IO (WithHsDocIdentifiers a GhcRn)
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> [Located (IdP GhcRn)] -> WithHsDocIdentifiers a GhcRn
a -> [Located Name] -> WithHsDocIdentifiers a GhcRn
forall a pass.
a -> [Located (IdP pass)] -> WithHsDocIdentifiers a pass
WithHsDocIdentifiers (BinHandle -> IO a
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh) (BinHandle -> IO [Located Name]
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 ([Name] -> NameSet) -> [Name] -> NameSet
forall a b. (a -> b) -> a -> b
$ (Located Name -> Name) -> [Located Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Located Name -> Name
forall l e. GenLocated l e -> e
unLoc [Located (IdP GhcRn)]
[Located Name]
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 (WithHsDocIdentifiers HsDocString name -> HsDocString
forall a pass. WithHsDocIdentifiers a pass -> a
hsDocString (WithHsDocIdentifiers HsDocString name -> HsDocString)
-> WithHsDocIdentifiers HsDocString name -> HsDocString
forall a b. (a -> b) -> a -> b
$ LHsDoc name -> WithHsDocIdentifiers HsDocString name
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    = SDoc -> SDoc
forall a. a -> a
id
pprMaybeWithDoc (Just LHsDoc name
doc) = LHsDoc name -> SDoc -> SDoc
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) =
    [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"text:" SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (HsDocString -> SDoc
pprHsDocString HsDocString
s)
         , String -> SDoc
text String
"identifiers:" SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat ((Located (IdP name) -> SDoc) -> [Located (IdP name)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP name) -> SDoc
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
      BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
level
      BinHandle -> HsDoc GhcRn -> IO ()
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
      BinHandle -> HsDoc GhcRn -> IO ()
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
      BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
name
    DsiExports Avails
avails -> do
      BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
      BinHandle -> Avails -> IO ()
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
      BinHandle -> NonEmpty ModuleName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh NonEmpty ModuleName
mod_names
      BinHandle -> Avails -> IO ()
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 (Int -> HsDoc GhcRn -> DocStructureItem)
-> IO Int -> IO (HsDoc GhcRn -> DocStructureItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (HsDoc GhcRn -> DocStructureItem)
-> IO (HsDoc GhcRn) -> IO DocStructureItem
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO (HsDoc GhcRn)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
1 -> HsDoc GhcRn -> DocStructureItem
DsiDocChunk (HsDoc GhcRn -> DocStructureItem)
-> IO (HsDoc GhcRn) -> IO DocStructureItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (HsDoc GhcRn)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
2 -> String -> DocStructureItem
DsiNamedChunkRef (String -> DocStructureItem) -> IO String -> IO DocStructureItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
3 -> Avails -> DocStructureItem
DsiExports (Avails -> DocStructureItem) -> IO Avails -> IO DocStructureItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Avails
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
4 -> NonEmpty ModuleName -> Avails -> DocStructureItem
DsiModExport (NonEmpty ModuleName -> Avails -> DocStructureItem)
-> IO (NonEmpty ModuleName) -> IO (Avails -> DocStructureItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO (NonEmpty ModuleName)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (Avails -> DocStructureItem) -> IO Avails -> IO DocStructureItem
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO Avails
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
_ -> String -> IO DocStructureItem
forall a. String -> IO a
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 -> [SDoc] -> SDoc
vcat
      [ String -> SDoc
text String
"section heading, level" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
level SDoc -> SDoc -> SDoc
O.<> SDoc
colon
      , Int -> SDoc -> SDoc
nest Int
2 (HsDoc GhcRn -> SDoc
forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug HsDoc GhcRn
doc)
      ]
    DsiDocChunk HsDoc GhcRn
doc -> [SDoc] -> SDoc
vcat
      [ String -> SDoc
text String
"documentation chunk:"
      , Int -> SDoc -> SDoc
nest Int
2 (HsDoc GhcRn -> SDoc
forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug HsDoc GhcRn
doc)
      ]
    DsiNamedChunkRef String
name ->
      String -> SDoc
text String
"reference to named chunk:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
name
    DsiExports Avails
avails ->
      String -> SDoc
text String
"avails:" SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (Avails -> SDoc
forall a. Outputable a => a -> SDoc
ppr Avails
avails)
    DsiModExport NonEmpty ModuleName
mod_names Avails
avails ->
      String -> SDoc
text String
"re-exported module(s):" SDoc -> SDoc -> SDoc
<+> NonEmpty ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr NonEmpty ModuleName
mod_names SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (Avails -> SDoc
forall a. Outputable a => a -> SDoc
ppr 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 Binary Docs where
  put_ :: BinHandle -> Docs -> IO ()
put_ BinHandle
bh Docs
docs = do
    BinHandle -> Maybe (HsDoc GhcRn) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Docs -> Maybe (HsDoc GhcRn)
docs_mod_hdr Docs
docs)
    BinHandle -> [(Name, [HsDoc GhcRn])] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (((Name, [HsDoc GhcRn]) -> (Name, [HsDoc GhcRn]) -> Ordering)
-> [(Name, [HsDoc GhcRn])] -> [(Name, [HsDoc GhcRn])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Name, [HsDoc GhcRn])
a (Name, [HsDoc GhcRn])
b -> ((Name, [HsDoc GhcRn]) -> Name
forall a b. (a, b) -> a
fst (Name, [HsDoc GhcRn])
a) Name -> Name -> Ordering
`stableNameCmp` (Name, [HsDoc GhcRn]) -> Name
forall a b. (a, b) -> a
fst (Name, [HsDoc GhcRn])
b) ([(Name, [HsDoc GhcRn])] -> [(Name, [HsDoc GhcRn])])
-> [(Name, [HsDoc GhcRn])] -> [(Name, [HsDoc GhcRn])]
forall a b. (a -> b) -> a -> b
$ UniqMap Name [HsDoc GhcRn] -> [(Name, [HsDoc GhcRn])]
forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap (UniqMap Name [HsDoc GhcRn] -> [(Name, [HsDoc GhcRn])])
-> UniqMap Name [HsDoc GhcRn] -> [(Name, [HsDoc GhcRn])]
forall a b. (a -> b) -> a -> b
$ Docs -> UniqMap Name [HsDoc GhcRn]
docs_decls Docs
docs)
    BinHandle -> [(Name, IntMap (HsDoc GhcRn))] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (((Name, IntMap (HsDoc GhcRn))
 -> (Name, IntMap (HsDoc GhcRn)) -> Ordering)
-> [(Name, IntMap (HsDoc GhcRn))] -> [(Name, IntMap (HsDoc GhcRn))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Name, IntMap (HsDoc GhcRn))
a (Name, IntMap (HsDoc GhcRn))
b -> ((Name, IntMap (HsDoc GhcRn)) -> Name
forall a b. (a, b) -> a
fst (Name, IntMap (HsDoc GhcRn))
a) Name -> Name -> Ordering
`stableNameCmp` (Name, IntMap (HsDoc GhcRn)) -> Name
forall a b. (a, b) -> a
fst (Name, IntMap (HsDoc GhcRn))
b) ([(Name, IntMap (HsDoc GhcRn))] -> [(Name, IntMap (HsDoc GhcRn))])
-> [(Name, IntMap (HsDoc GhcRn))] -> [(Name, IntMap (HsDoc GhcRn))]
forall a b. (a -> b) -> a -> b
$ UniqMap Name (IntMap (HsDoc GhcRn))
-> [(Name, IntMap (HsDoc GhcRn))]
forall k a. UniqMap k a -> [(k, a)]
nonDetEltsUniqMap (UniqMap Name (IntMap (HsDoc GhcRn))
 -> [(Name, IntMap (HsDoc GhcRn))])
-> UniqMap Name (IntMap (HsDoc GhcRn))
-> [(Name, IntMap (HsDoc GhcRn))]
forall a b. (a -> b) -> a -> b
$ Docs -> UniqMap Name (IntMap (HsDoc GhcRn))
docs_args Docs
docs)
    BinHandle -> DocStructure -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Docs -> DocStructure
docs_structure Docs
docs)
    BinHandle -> [(String, HsDoc GhcRn)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Map String (HsDoc GhcRn) -> [(String, HsDoc GhcRn)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String (HsDoc GhcRn) -> [(String, HsDoc GhcRn)])
-> Map String (HsDoc GhcRn) -> [(String, HsDoc GhcRn)]
forall a b. (a -> b) -> a -> b
$ Docs -> Map String (HsDoc GhcRn)
docs_named_chunks Docs
docs)
    BinHandle -> Maybe String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Docs -> Maybe String
docs_haddock_opts Docs
docs)
    BinHandle -> Maybe Language -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Docs -> Maybe Language
docs_language Docs
docs)
    BinHandle -> EnumSet Extension -> IO ()
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 <- BinHandle -> IO (Maybe (HsDoc GhcRn))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    UniqMap Name [HsDoc GhcRn]
decls <- [(Name, [HsDoc GhcRn])] -> UniqMap Name [HsDoc GhcRn]
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap ([(Name, [HsDoc GhcRn])] -> UniqMap Name [HsDoc GhcRn])
-> IO [(Name, [HsDoc GhcRn])] -> IO (UniqMap Name [HsDoc GhcRn])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [(Name, [HsDoc GhcRn])]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    UniqMap Name (IntMap (HsDoc GhcRn))
args <- [(Name, IntMap (HsDoc GhcRn))]
-> UniqMap Name (IntMap (HsDoc GhcRn))
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap ([(Name, IntMap (HsDoc GhcRn))]
 -> UniqMap Name (IntMap (HsDoc GhcRn)))
-> IO [(Name, IntMap (HsDoc GhcRn))]
-> IO (UniqMap Name (IntMap (HsDoc GhcRn)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [(Name, IntMap (HsDoc GhcRn))]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    DocStructure
structure <- BinHandle -> IO DocStructure
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Map String (HsDoc GhcRn)
named_chunks <- [(String, HsDoc GhcRn)] -> Map String (HsDoc GhcRn)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, HsDoc GhcRn)] -> Map String (HsDoc GhcRn))
-> IO [(String, HsDoc GhcRn)] -> IO (Map String (HsDoc GhcRn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [(String, HsDoc GhcRn)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe String
haddock_opts <- BinHandle -> IO (Maybe String)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Maybe Language
language <- BinHandle -> IO (Maybe Language)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    EnumSet Extension
exts <- BinHandle -> IO (EnumSet Extension)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Docs -> IO Docs
forall a. a -> IO a
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 =
      [SDoc] -> SDoc
vcat
        [ (Maybe (HsDoc GhcRn) -> SDoc)
-> String -> (Docs -> Maybe (HsDoc GhcRn)) -> SDoc
forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField ((HsDoc GhcRn -> SDoc) -> Maybe (HsDoc GhcRn) -> SDoc
forall {t}. (t -> SDoc) -> Maybe t -> SDoc
pprMaybe HsDoc GhcRn -> SDoc
forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug) String
"module header" Docs -> Maybe (HsDoc GhcRn)
docs_mod_hdr
        , (UniqMap Name [HsDoc GhcRn] -> SDoc)
-> String -> (Docs -> UniqMap Name [HsDoc GhcRn]) -> SDoc
forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField (UniqMap Name SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UniqMap Name SDoc -> SDoc)
-> (UniqMap Name [HsDoc GhcRn] -> UniqMap Name SDoc)
-> UniqMap Name [HsDoc GhcRn]
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([HsDoc GhcRn] -> SDoc)
-> UniqMap Name [HsDoc GhcRn] -> UniqMap Name SDoc
forall a b. (a -> b) -> UniqMap Name a -> UniqMap Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SDoc] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([SDoc] -> SDoc)
-> ([HsDoc GhcRn] -> [SDoc]) -> [HsDoc GhcRn] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsDoc GhcRn -> SDoc) -> [HsDoc GhcRn] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map HsDoc GhcRn -> SDoc
forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug)) String
"declaration docs" Docs -> UniqMap Name [HsDoc GhcRn]
docs_decls
        , (UniqMap Name (IntMap (HsDoc GhcRn)) -> SDoc)
-> String -> (Docs -> UniqMap Name (IntMap (HsDoc GhcRn))) -> SDoc
forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField (UniqMap Name SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UniqMap Name SDoc -> SDoc)
-> (UniqMap Name (IntMap (HsDoc GhcRn)) -> UniqMap Name SDoc)
-> UniqMap Name (IntMap (HsDoc GhcRn))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap (HsDoc GhcRn) -> SDoc)
-> UniqMap Name (IntMap (HsDoc GhcRn)) -> UniqMap Name SDoc
forall a b. (a -> b) -> UniqMap Name a -> UniqMap Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> SDoc)
-> (HsDoc GhcRn -> SDoc) -> IntMap (HsDoc GhcRn) -> SDoc
forall {t}. (Int -> SDoc) -> (t -> SDoc) -> IntMap t -> SDoc
pprIntMap Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsDoc GhcRn -> SDoc
forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug)) String
"arg docs" Docs -> UniqMap Name (IntMap (HsDoc GhcRn))
docs_args
        , (DocStructure -> SDoc) -> String -> (Docs -> DocStructure) -> SDoc
forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc)
-> (DocStructure -> [SDoc]) -> DocStructure -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocStructureItem -> SDoc) -> DocStructure -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map DocStructureItem -> SDoc
forall a. Outputable a => a -> SDoc
ppr) String
"documentation structure" Docs -> DocStructure
docs_structure
        , (Map String (HsDoc GhcRn) -> SDoc)
-> String -> (Docs -> Map String (HsDoc GhcRn)) -> SDoc
forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField ((String -> SDoc)
-> (HsDoc GhcRn -> SDoc) -> Map String (HsDoc GhcRn) -> SDoc
forall {t} {t}. (t -> SDoc) -> (t -> SDoc) -> Map t t -> SDoc
pprMap (SDoc -> SDoc
doubleQuotes (SDoc -> SDoc) -> (String -> SDoc) -> String -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
text) HsDoc GhcRn -> SDoc
forall name. Outputable (IdP name) => HsDoc name -> SDoc
pprHsDocDebug) String
"named chunks"
                   Docs -> Map String (HsDoc GhcRn)
docs_named_chunks
        , (Maybe String -> SDoc) -> String -> (Docs -> Maybe String) -> SDoc
forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField Maybe String -> SDoc
pprMbString String
"haddock options" Docs -> Maybe String
docs_haddock_opts
        , (Maybe Language -> SDoc)
-> String -> (Docs -> Maybe Language) -> SDoc
forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField Maybe Language -> SDoc
forall a. Outputable a => a -> SDoc
ppr String
"language" Docs -> Maybe Language
docs_language
        , (EnumSet Extension -> SDoc)
-> String -> (Docs -> EnumSet Extension) -> SDoc
forall a. (a -> SDoc) -> String -> (Docs -> a) -> SDoc
pprField ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc)
-> (EnumSet Extension -> [SDoc]) -> EnumSet Extension -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Extension -> SDoc) -> [Extension] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([Extension] -> [SDoc])
-> (EnumSet Extension -> [Extension])
-> EnumSet Extension
-> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumSet Extension -> [Extension]
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 =
        String -> SDoc
text String
heading SDoc -> SDoc -> SDoc
O.<> SDoc
colon SDoc -> SDoc -> SDoc
$$ 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 =
        [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (((t, t) -> SDoc) -> [(t, t)] -> [SDoc])
-> [(t, t)] -> ((t, t) -> SDoc) -> [SDoc]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((t, t) -> SDoc) -> [(t, t)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Map t t -> [(t, t)]
forall k a. Map k a -> [(k, a)]
Map.toList Map t t
m) (((t, t) -> SDoc) -> [SDoc]) -> ((t, t) -> SDoc) -> [SDoc]
forall a b. (a -> b) -> a -> b
$ \(t
k, t
v) ->
          t -> SDoc
pprKey t
k SDoc -> SDoc -> SDoc
O.<> SDoc
colon SDoc -> SDoc -> SDoc
$$ 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 =
        [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (((Int, t) -> SDoc) -> [(Int, t)] -> [SDoc])
-> [(Int, t)] -> ((Int, t) -> SDoc) -> [SDoc]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, t) -> SDoc) -> [(Int, t)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (IntMap t -> [(Int, t)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap t
m) (((Int, t) -> SDoc) -> [SDoc]) -> ((Int, t) -> SDoc) -> [SDoc]
forall a b. (a -> b) -> a -> b
$ \(Int
k, t
v) ->
          Int -> SDoc
pprKey Int
k SDoc -> SDoc -> SDoc
O.<> SDoc
colon SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (t -> SDoc
pprVal t
v)
      pprMbString :: Maybe String -> SDoc
pprMbString Maybe String
Nothing = SDoc
empty
      pprMbString (Just String
s) = String -> SDoc
text String
s
      pprMaybe :: (t -> SDoc) -> Maybe t -> SDoc
pprMaybe t -> SDoc
ppr' = \case
        Maybe t
Nothing -> String -> SDoc
text String
"Nothing"
        Just t
x -> String -> SDoc
text String
"Just" SDoc -> SDoc -> SDoc
<+> t -> SDoc
ppr' t
x

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