aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs10
-rw-r--r--haddock-api/src/Haddock/Interface/LexParseRn.hs15
2 files changed, 12 insertions, 13 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 8b929e15..b04a3777 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -58,7 +58,7 @@ import Packages ( lookupModuleInAllPackages, PackageName(..) )
import Bag
import RdrName
import TcRnTypes
-import FastString ( concatFS, unpackFS )
+import FastString ( concatFS, unpackFS, fastStringToByteString)
import BasicTypes ( StringLiteral(..), SourceText(..) )
import qualified Outputable as O
import HsDecls ( getConArgs )
@@ -304,11 +304,11 @@ moduleWarning dflags gre (WarnAll w) = Just <$> parseWarning dflags gre w
parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name)
parseWarning dflags gre w = case w of
- DeprecatedTxt _ msg -> format "Deprecated: " (concatFS $ map (sl_fs . unLoc) msg)
- WarningTxt _ msg -> format "Warning: " (concatFS $ map (sl_fs . unLoc) msg)
+ DeprecatedTxt _ msg -> format "Deprecated: " (foldMap (fastStringToByteString . sl_fs . unLoc) msg)
+ WarningTxt _ msg -> format "Warning: " (foldMap (fastStringToByteString . sl_fs . unLoc) msg)
where
- format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
- <$> processDocString dflags gre (HsDocString xs)
+ format x bs = DocWarning . DocParagraph . DocAppend (DocString x)
+ <$> processDocString dflags gre (mkHsDocStringUtf8ByteString bs)
-------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index 9a978f9f..c598cb75 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -44,14 +44,13 @@ processDocStrings dflags pkg gre strs = do
MetaDoc { _meta = Meta Nothing Nothing, _doc = DocEmpty } -> pure Nothing
x -> pure (Just x)
-processDocStringParas :: DynFlags -> Maybe Package -> GlobalRdrEnv -> HsDocString
- -> ErrMsgM (MDoc Name)
-processDocStringParas dflags pkg gre (HsDocString fs) =
- overDocF (rename dflags gre) $ parseParas dflags pkg (unpackFS fs)
+processDocStringParas :: DynFlags -> Maybe Package -> GlobalRdrEnv -> HsDocString -> ErrMsgM (MDoc Name)
+processDocStringParas dflags pkg gre hds =
+ overDocF (rename dflags gre) $ parseParas dflags pkg (unpackHDS hds)
processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name)
-processDocString dflags gre (HsDocString fs) =
- rename dflags gre $ parseString dflags (unpackFS fs)
+processDocString dflags gre hds =
+ rename dflags gre $ parseString dflags (unpackHDS hds)
processModuleHeader :: DynFlags -> Maybe Package -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString
-> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name))
@@ -59,8 +58,8 @@ processModuleHeader dflags pkgName gre safety mayStr = do
(hmi, doc) <-
case mayStr of
Nothing -> return failure
- Just (L _ (HsDocString fs)) -> do
- let str = unpackFS fs
+ Just (L _ hds) -> do
+ let str = unpackHDS hds
(hmi, doc) = parseModuleHeader dflags pkgName str
!descr <- case hmi_description hmi of
Just hmi_descr -> Just <$> rename dflags gre hmi_descr