{-# 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
newtype HsDocString = HsDocString ByteString
deriving (HsDocString -> HsDocString -> Bool
(HsDocString -> HsDocString -> Bool)
-> (HsDocString -> HsDocString -> Bool) -> Eq HsDocString
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
(Int -> HsDocString -> ShowS)
-> (HsDocString -> String)
-> ([HsDocString] -> ShowS)
-> Show HsDocString
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
Typeable HsDocString
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocString -> c HsDocString)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocString)
-> (HsDocString -> Constr)
-> (HsDocString -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> HsDocString -> HsDocString)
-> (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 u. (forall d. Data d => d -> u) -> HsDocString -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> HsDocString -> u)
-> (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 (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString)
-> Data 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)
type LHsDocString = Located HsDocString
instance Binary HsDocString where
put_ :: BinHandle -> HsDocString -> IO ()
put_ BinHandle
bh (HsDocString ByteString
bs) = BinHandle -> ByteString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
bs
get :: BinHandle -> IO HsDocString
get BinHandle
bh = ByteString -> HsDocString
HsDocString (ByteString -> HsDocString) -> IO ByteString -> IO HsDocString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Outputable HsDocString where
ppr :: HsDocString -> SDoc
ppr = SDoc -> SDoc
doubleQuotes (SDoc -> SDoc) -> (HsDocString -> SDoc) -> HsDocString -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
text (String -> SDoc) -> (HsDocString -> String) -> HsDocString -> SDoc
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)
mkHsDocStringUtf8ByteString :: ByteString -> HsDocString
mkHsDocStringUtf8ByteString :: ByteString -> HsDocString
mkHsDocStringUtf8ByteString = ByteString -> HsDocString
HsDocString
unpackHDS :: HsDocString -> String
unpackHDS :: HsDocString -> String
unpackHDS = ByteString -> String
utf8DecodeByteString (ByteString -> String)
-> (HsDocString -> ByteString) -> HsDocString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDocString -> ByteString
hsDocStringToByteString
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) = LHsDocString -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsDocString
doc
ppr_mbDoc Maybe LHsDocString
Nothing = SDoc
empty
appendDocs :: HsDocString -> HsDocString -> HsDocString
appendDocs :: HsDocString -> HsDocString -> HsDocString
appendDocs HsDocString
x HsDocString
y =
HsDocString -> Maybe HsDocString -> HsDocString
forall a. a -> Maybe a -> a
fromMaybe
(ByteString -> HsDocString
HsDocString ByteString
BS.empty)
([HsDocString] -> Maybe HsDocString
concatDocs [HsDocString
x, HsDocString
y])
concatDocs :: [HsDocString] -> Maybe HsDocString
concatDocs :: [HsDocString] -> Maybe HsDocString
concatDocs [HsDocString]
xs =
if ByteString -> Bool
BS.null ByteString
b
then Maybe HsDocString
forall a. Maybe a
Nothing
else HsDocString -> Maybe HsDocString
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")
([ByteString] -> ByteString)
-> ([HsDocString] -> [ByteString]) -> [HsDocString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null)
([ByteString] -> [ByteString])
-> ([HsDocString] -> [ByteString]) -> [HsDocString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsDocString -> ByteString) -> [HsDocString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map HsDocString -> ByteString
hsDocStringToByteString
([HsDocString] -> ByteString) -> [HsDocString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [HsDocString]
xs
newtype DeclDocMap = DeclDocMap (Map Name HsDocString)
instance Binary DeclDocMap where
put_ :: BinHandle -> DeclDocMap -> IO ()
put_ BinHandle
bh (DeclDocMap Map Name HsDocString
m) = BinHandle -> [(Name, HsDocString)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Map Name HsDocString -> [(Name, HsDocString)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name HsDocString
m)
get :: BinHandle -> IO DeclDocMap
get BinHandle
bh = Map Name HsDocString -> DeclDocMap
DeclDocMap (Map Name HsDocString -> DeclDocMap)
-> ([(Name, HsDocString)] -> Map Name HsDocString)
-> [(Name, HsDocString)]
-> DeclDocMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, HsDocString)] -> Map Name HsDocString
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, HsDocString)] -> DeclDocMap)
-> IO [(Name, HsDocString)] -> IO DeclDocMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [(Name, HsDocString)]
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 (((Name, HsDocString) -> SDoc) -> [(Name, HsDocString)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Name, HsDocString) -> SDoc
forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
pprPair (Map Name HsDocString -> [(Name, HsDocString)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Name HsDocString
m))
where
pprPair :: (a, a) -> SDoc
pprPair (a
name, a
doc) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
name SDoc -> SDoc -> SDoc
Outputable.<> SDoc
colon SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
doc)
emptyDeclDocMap :: DeclDocMap
emptyDeclDocMap :: DeclDocMap
emptyDeclDocMap = Map Name HsDocString -> DeclDocMap
DeclDocMap Map Name HsDocString
forall k a. Map k a
Map.empty
newtype ArgDocMap = ArgDocMap (Map Name (IntMap HsDocString))
instance Binary ArgDocMap where
put_ :: BinHandle -> ArgDocMap -> IO ()
put_ BinHandle
bh (ArgDocMap Map Name (IntMap HsDocString)
m) = BinHandle -> [(Name, [(Int, HsDocString)])] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Map Name [(Int, HsDocString)] -> [(Name, [(Int, HsDocString)])]
forall k a. Map k a -> [(k, a)]
Map.toList (IntMap HsDocString -> [(Int, HsDocString)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList (IntMap HsDocString -> [(Int, HsDocString)])
-> Map Name (IntMap HsDocString) -> Map Name [(Int, HsDocString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Name (IntMap HsDocString)
m))
get :: BinHandle -> IO ArgDocMap
get BinHandle
bh = Map Name (IntMap HsDocString) -> ArgDocMap
ArgDocMap (Map Name (IntMap HsDocString) -> ArgDocMap)
-> ([(Name, [(Int, HsDocString)])]
-> Map Name (IntMap HsDocString))
-> [(Name, [(Int, HsDocString)])]
-> ArgDocMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, HsDocString)] -> IntMap HsDocString)
-> Map Name [(Int, HsDocString)] -> Map Name (IntMap HsDocString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Int, HsDocString)] -> IntMap HsDocString
forall a. [(Int, a)] -> IntMap a
IntMap.fromDistinctAscList (Map Name [(Int, HsDocString)] -> Map Name (IntMap HsDocString))
-> ([(Name, [(Int, HsDocString)])]
-> Map Name [(Int, HsDocString)])
-> [(Name, [(Int, HsDocString)])]
-> Map Name (IntMap HsDocString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, [(Int, HsDocString)])] -> Map Name [(Int, HsDocString)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, [(Int, HsDocString)])] -> ArgDocMap)
-> IO [(Name, [(Int, HsDocString)])] -> IO ArgDocMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [(Name, [(Int, HsDocString)])]
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 (((Name, IntMap HsDocString) -> SDoc)
-> [(Name, IntMap HsDocString)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Name, IntMap HsDocString) -> SDoc
forall {a} {a}.
(Outputable a, Outputable a) =>
(a, IntMap a) -> SDoc
pprPair (Map Name (IntMap HsDocString) -> [(Name, IntMap HsDocString)]
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) =
a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
name SDoc -> SDoc -> SDoc
Outputable.<> SDoc
colon SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (IntMap a -> SDoc
forall {a}. Outputable a => IntMap a -> SDoc
pprIntMap IntMap a
int_map)
pprIntMap :: IntMap a -> SDoc
pprIntMap IntMap a
im = [SDoc] -> SDoc
vcat (((Int, a) -> SDoc) -> [(Int, a)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> SDoc
forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
pprIPair (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toAscList IntMap a
im))
pprIPair :: (a, a) -> SDoc
pprIPair (a
i, a
doc) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
i SDoc -> SDoc -> SDoc
Outputable.<> SDoc
colon SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest Int
2 (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
doc)
emptyArgDocMap :: ArgDocMap
emptyArgDocMap :: ArgDocMap
emptyArgDocMap = Map Name (IntMap HsDocString) -> ArgDocMap
ArgDocMap Map Name (IntMap HsDocString)
forall k a. Map k a
Map.empty
data =
{ :: Maybe HsDocString
, ExtractedTHDocs -> DeclDocMap
ethd_decl_docs :: DeclDocMap
, ExtractedTHDocs -> ArgDocMap
ethd_arg_docs :: ArgDocMap
, ExtractedTHDocs -> DeclDocMap
ethd_inst_docs :: DeclDocMap
}