diff options
Diffstat (limited to 'compiler/hsSyn/HsDoc.hs')
-rw-r--r-- | compiler/hsSyn/HsDoc.hs | 92 |
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 |