diff options
author | Simon Jakobi <simon.jakobi@gmail.com> | 2018-05-28 03:13:15 +0200 |
---|---|---|
committer | Simon Jakobi <simon.jakobi@gmail.com> | 2018-06-13 23:05:08 +0200 |
commit | 090813eaa7a7dbc5ba20a979150ca37521849994 (patch) | |
tree | fff9e458a132069a10f79538f965ad43450da75d /haddock-api/src/Haddock/Interface | |
parent | 9b9fb7ed2e7f30cca8693cdb186eaea8eeca0860 (diff) |
Adjust to new HsDocString internals
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-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 |