1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
module GHC.Hs.Doc
( HsDocString
, LHsDocString
, mkHsDocString
, mkHsDocStringUtf8ByteString
, isEmptyDocString
, unpackHDS
, hsDocStringToByteString
, ppr_mbDoc
, appendDocs
, concatDocs
, DeclDocMap(..)
, emptyDeclDocMap
, ArgDocMap(..)
, emptyArgDocMap
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Utils.Binary
import GHC.Utils.Encoding
import GHC.Utils.IO.Unsafe
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 qualified Data.ByteString.Internal as BS
import Data.Data
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Foreign
-- | 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 (Eq, Show, Data)
-- | Located Haskell Documentation String
type LHsDocString = Located HsDocString
instance Binary HsDocString where
put_ bh (HsDocString bs) = put_ bh bs
get bh = HsDocString <$> get bh
instance Outputable HsDocString where
ppr = doubleQuotes . text . unpackHDS
isEmptyDocString :: HsDocString -> Bool
isEmptyDocString (HsDocString bs) = BS.null bs
mkHsDocString :: String -> HsDocString
mkHsDocString s =
inlinePerformIO $ do
let len = utf8EncodedLength s
buf <- mallocForeignPtrBytes len
withForeignPtr buf $ \ptr -> do
utf8EncodeString ptr s
pure (HsDocString (BS.fromForeignPtr buf 0 len))
-- | Create a 'HsDocString' from a UTF8-encoded 'ByteString'.
mkHsDocStringUtf8ByteString :: ByteString -> HsDocString
mkHsDocStringUtf8ByteString = HsDocString
unpackHDS :: HsDocString -> String
unpackHDS = utf8DecodeByteString . hsDocStringToByteString
-- | Return the contents of a 'HsDocString' as a UTF8-encoded 'ByteString'.
hsDocStringToByteString :: HsDocString -> ByteString
hsDocStringToByteString (HsDocString bs) = bs
ppr_mbDoc :: Maybe LHsDocString -> SDoc
ppr_mbDoc (Just doc) = ppr doc
ppr_mbDoc Nothing = empty
-- | Join two docstrings.
--
-- Non-empty docstrings are joined with two newlines in between,
-- resulting in separate paragraphs.
appendDocs :: HsDocString -> HsDocString -> HsDocString
appendDocs x y =
fromMaybe
(HsDocString BS.empty)
(concatDocs [x, 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 xs =
if BS.null b
then Nothing
else Just (HsDocString b)
where
b = BS.intercalate (C8.pack "\n\n")
. filter (not . BS.null)
. map hsDocStringToByteString
$ xs
-- | Docs for declarations: functions, data types, instances, methods etc.
newtype DeclDocMap = DeclDocMap (Map Name HsDocString)
instance Binary DeclDocMap where
put_ bh (DeclDocMap m) = put_ bh (Map.toList 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 bh = DeclDocMap . Map.fromList <$> get bh
instance Outputable DeclDocMap where
ppr (DeclDocMap m) = vcat (map pprPair (Map.toAscList m))
where
pprPair (name, doc) = ppr name Outputable.<> colon $$ nest 2 (ppr doc)
emptyDeclDocMap :: DeclDocMap
emptyDeclDocMap = DeclDocMap Map.empty
-- | Docs for arguments. E.g. function arguments, method arguments.
newtype ArgDocMap = ArgDocMap (Map Name (Map Int HsDocString))
instance Binary ArgDocMap where
put_ bh (ArgDocMap m) = put_ bh (Map.toList (Map.toAscList <$> 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 bh = ArgDocMap . fmap Map.fromDistinctAscList . Map.fromList <$> get bh
instance Outputable ArgDocMap where
ppr (ArgDocMap m) = vcat (map pprPair (Map.toAscList m))
where
pprPair (name, int_map) =
ppr name Outputable.<> colon $$ nest 2 (pprIntMap int_map)
pprIntMap im = vcat (map pprIPair (Map.toAscList im))
pprIPair (i, doc) = ppr i Outputable.<> colon $$ nest 2 (ppr doc)
emptyArgDocMap :: ArgDocMap
emptyArgDocMap = ArgDocMap Map.empty
|
