diff options
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 10 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/LexParseRn.hs | 15 |
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 |