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