never executed always true always false

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