summaryrefslogtreecommitdiff
path: root/compiler/hsSyn/HsDoc.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/hsSyn/HsDoc.hs')
-rw-r--r--compiler/hsSyn/HsDoc.hs92
1 files changed, 90 insertions, 2 deletions
diff --git a/compiler/hsSyn/HsDoc.hs b/compiler/hsSyn/HsDoc.hs
index cbe1d94bec..ed887636a6 100644
--- a/compiler/hsSyn/HsDoc.hs
+++ b/compiler/hsSyn/HsDoc.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module HsDoc
( HsDocString
@@ -8,33 +10,59 @@ module HsDoc
, unpackHDS
, hsDocStringToByteString
, ppr_mbDoc
+
+ , appendDocs
+ , concatDocs
+
+ , DeclDocMap(..)
+ , emptyDeclDocMap
+
+ , ArgDocMap(..)
+ , emptyArgDocMap
) where
#include "HsVersions.h"
import GhcPrelude
+import Binary
import Encoding
import FastFunctions
+import Name
import Outputable
import 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 = text . unpackHDS
+ ppr = doubleQuotes . text . unpackHDS
mkHsDocString :: String -> HsDocString
mkHsDocString s =
@@ -59,3 +87,63 @@ 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.toAscList m)
+ get bh = DeclDocMap . Map.fromDistinctAscList <$> 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.toAscList (Map.toAscList <$> m))
+ get bh = ArgDocMap . fmap Map.fromDistinctAscList . Map.fromDistinctAscList
+ <$> 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