{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}

module GHC.Hs.Doc
  ( HsDocString
  , LHsDocString
  , mkHsDocString
  , mkHsDocStringUtf8ByteString
  , isEmptyDocString
  , unpackHDS
  , hsDocStringToByteString
  , ppr_mbDoc

  , appendDocs
  , concatDocs

  , DeclDocMap(..)
  , emptyDeclDocMap

  , ArgDocMap(..)
  , emptyArgDocMap

  , ExtractedTHDocs(..)
  ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Utils.Binary
import GHC.Utils.Encoding
import GHC.Types.Name
import GHC.Utils.Outputable as Outputable
import GHC.Types.SrcLoc

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8
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.Maybe

-- | Haskell Documentation String
--
-- Internally this is a UTF8-Encoded 'ByteString'.
newtype HsDocString = HsDocString ByteString
  -- There are at least two plausible Semigroup instances for this type:
  --
  -- 1. Simple string concatenation.
  -- 2. Concatenation as documentation paragraphs with newlines in between.
  --
  -- To avoid confusion, we pass on defining an instance at all.
  deriving (HsDocString -> HsDocString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HsDocString -> HsDocString -> Bool
$c/= :: HsDocString -> HsDocString -> Bool
== :: HsDocString -> HsDocString -> Bool
$c== :: HsDocString -> HsDocString -> Bool
Eq, Int -> HsDocString -> ShowS
[HsDocString] -> ShowS
HsDocString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsDocString] -> ShowS
$cshowList :: [HsDocString] -> ShowS
show :: HsDocString -> String
$cshow :: HsDocString -> String
showsPrec :: Int -> HsDocString -> ShowS
$cshowsPrec :: Int -> HsDocString -> ShowS
Show, Typeable HsDocString
HsDocString -> DataType
HsDocString -> Constr
(forall b. Data b => b -> b) -> HsDocString -> HsDocString
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HsDocString -> u
forall u. (forall d. Data d => d -> u) -> HsDocString -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocString
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocString -> c HsDocString
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocString)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocString)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HsDocString -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HsDocString -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsDocString -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsDocString -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
gmapT :: (forall b. Data b => b -> b) -> HsDocString -> HsDocString
$cgmapT :: (forall b. Data b => b -> b) -> HsDocString -> HsDocString
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocString)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocString)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocString)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocString)
dataTypeOf :: HsDocString -> DataType
$cdataTypeOf :: HsDocString -> DataType
toConstr :: HsDocString -> Constr
$ctoConstr :: HsDocString -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocString
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocString
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocString -> c HsDocString
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocString -> c HsDocString
Data)

-- | Located Haskell Documentation String
type LHsDocString = Located HsDocString

instance Binary HsDocString where
  put_ :: BinHandle -> HsDocString -> IO ()
put_ BinHandle
bh (HsDocString ByteString
bs) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
bs
  get :: BinHandle -> IO HsDocString
get BinHandle
bh = ByteString -> HsDocString
HsDocString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Outputable HsDocString where
  ppr :: HsDocString -> SDoc
ppr = SDoc -> SDoc
doubleQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDocString -> String
unpackHDS

isEmptyDocString :: HsDocString -> Bool
isEmptyDocString :: HsDocString -> Bool
isEmptyDocString (HsDocString ByteString
bs) = ByteString -> Bool
BS.null ByteString
bs

mkHsDocString :: String -> HsDocString
mkHsDocString :: String -> HsDocString
mkHsDocString String
s = ByteString -> HsDocString
HsDocString (String -> ByteString
utf8EncodeString String
s)

-- | Create a 'HsDocString' from a UTF8-encoded 'ByteString'.
mkHsDocStringUtf8ByteString :: ByteString -> HsDocString
mkHsDocStringUtf8ByteString :: ByteString -> HsDocString
mkHsDocStringUtf8ByteString = ByteString -> HsDocString
HsDocString

unpackHDS :: HsDocString -> String
unpackHDS :: HsDocString -> String
unpackHDS = ByteString -> String
utf8DecodeByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDocString -> ByteString
hsDocStringToByteString

-- | Return the contents of a 'HsDocString' as a UTF8-encoded 'ByteString'.
hsDocStringToByteString :: HsDocString -> ByteString
hsDocStringToByteString :: HsDocString -> ByteString
hsDocStringToByteString (HsDocString ByteString
bs) = ByteString
bs

ppr_mbDoc :: Maybe LHsDocString -> SDoc
ppr_mbDoc :: Maybe LHsDocString -> SDoc
ppr_mbDoc (Just LHsDocString
doc) = forall a. Outputable a => a -> SDoc
ppr LHsDocString
doc
ppr_mbDoc Maybe LHsDocString
Nothing    = SDoc
empty

-- | Join two docstrings.
--
-- Non-empty docstrings are joined with two newlines in between,
-- resulting in separate paragraphs.
appendDocs :: HsDocString -> HsDocString -> HsDocString
appendDocs :: HsDocString -> HsDocString -> HsDocString
appendDocs HsDocString
x HsDocString
y =
  forall a. a -> Maybe a -> a
fromMaybe
    (ByteString -> HsDocString
HsDocString ByteString
BS.empty)
    ([HsDocString] -> Maybe HsDocString
concatDocs [HsDocString
x, HsDocString
y])

-- | Concat docstrings with two newlines in between.
--
-- Empty docstrings are skipped.
--
-- If all inputs are empty, 'Nothing' is returned.
concatDocs :: [HsDocString] -> Maybe HsDocString
concatDocs :: [HsDocString] -> Maybe HsDocString
concatDocs [HsDocString]
xs =
    if ByteString -> Bool
BS.null ByteString
b
      then forall a. Maybe a
Nothing
      else forall a. a -> Maybe a
Just (ByteString -> HsDocString
HsDocString ByteString
b)
  where
    b :: ByteString
b = ByteString -> [ByteString] -> ByteString
BS.intercalate (String -> ByteString
C8.pack String
"\n\n")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map HsDocString -> ByteString
hsDocStringToByteString
      forall a b. (a -> b) -> a -> b
$ [HsDocString]
xs

-- | Docs for declarations: functions, data types, instances, methods etc.
newtype DeclDocMap = DeclDocMap (Map Name HsDocString)

instance Binary DeclDocMap where
  put_ :: BinHandle -> DeclDocMap -> IO ()
put_ BinHandle
bh (DeclDocMap Map Name HsDocString
m) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall k a. Map k a -> [(k, a)]
Map.toList Map Name HsDocString
m)
  -- We can't rely on a deterministic ordering of the `Name`s here.
  -- See the comments on `Name`'s `Ord` instance for context.
  get :: BinHandle -> IO DeclDocMap
get BinHandle
bh = Map Name HsDocString -> DeclDocMap
DeclDocMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

instance Outputable DeclDocMap where
  ppr :: DeclDocMap -> SDoc
ppr (DeclDocMap Map Name HsDocString
m) = [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
pprPair (forall k a. Map k a -> [(k, a)]
Map.toAscList Map Name HsDocString
m))
    where
      pprPair :: (a, a) -> SDoc
pprPair (a
name, a
doc) = forall a. Outputable a => a -> SDoc
ppr a
name SDoc -> SDoc -> SDoc
Outputable.<> SDoc
colon SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr a
doc)

emptyDeclDocMap :: DeclDocMap
emptyDeclDocMap :: DeclDocMap
emptyDeclDocMap = Map Name HsDocString -> DeclDocMap
DeclDocMap forall k a. Map k a
Map.empty

-- | Docs for arguments. E.g. function arguments, method arguments.
newtype ArgDocMap = ArgDocMap (Map Name (IntMap HsDocString))

instance Binary ArgDocMap where
  put_ :: BinHandle -> ArgDocMap -> IO ()
put_ BinHandle
bh (ArgDocMap Map Name (IntMap HsDocString)
m) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall k a. Map k a -> [(k, a)]
Map.toList (forall a. IntMap a -> [(Int, a)]
IntMap.toAscList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name (IntMap HsDocString)
m))
  -- We can't rely on a deterministic ordering of the `Name`s here.
  -- See the comments on `Name`'s `Ord` instance for context.
  get :: BinHandle -> IO ArgDocMap
get BinHandle
bh = Map Name (IntMap HsDocString) -> ArgDocMap
ArgDocMap 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. [(Int, a)] -> IntMap a
IntMap.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

instance Outputable ArgDocMap where
  ppr :: ArgDocMap -> SDoc
ppr (ArgDocMap Map Name (IntMap HsDocString)
m) = [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}.
(Outputable a, Outputable a) =>
(a, IntMap a) -> SDoc
pprPair (forall k a. Map k a -> [(k, a)]
Map.toAscList Map Name (IntMap HsDocString)
m))
    where
      pprPair :: (a, IntMap a) -> SDoc
pprPair (a
name, IntMap a
int_map) =
        forall a. Outputable a => a -> SDoc
ppr a
name SDoc -> SDoc -> SDoc
Outputable.<> SDoc
colon SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall {a}. Outputable a => IntMap a -> SDoc
pprIntMap IntMap a
int_map)
      pprIntMap :: IntMap a -> SDoc
pprIntMap IntMap a
im = [SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
pprIPair (forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap a
im))
      pprIPair :: (a, a) -> SDoc
pprIPair (a
i, a
doc) = forall a. Outputable a => a -> SDoc
ppr a
i SDoc -> SDoc -> SDoc
Outputable.<> SDoc
colon SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (forall a. Outputable a => a -> SDoc
ppr a
doc)

emptyArgDocMap :: ArgDocMap
emptyArgDocMap :: ArgDocMap
emptyArgDocMap = Map Name (IntMap HsDocString) -> ArgDocMap
ArgDocMap forall k a. Map k a
Map.empty

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