diff options
author | Simon Jakobi <simon.jakobi@gmail.com> | 2018-05-28 03:13:15 +0200 |
---|---|---|
committer | Simon Jakobi <simon.jakobi@gmail.com> | 2018-05-31 04:17:47 +0200 |
commit | 6857aefd94db1e25cd560a3c409a1d4e0efa3b4f (patch) | |
tree | 1bf674ceb674b7b45f5f4312f73b1687d5008515 | |
parent | 46ff2306f580c44915a6f3adb652f02b7f4edfe9 (diff) |
Adjust to new HsDocString internals
-rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 10 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/LexParseRn.hs | 12 |
2 files changed, 11 insertions, 11 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index bc93449f..2c91f142 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -58,7 +58,7 @@ import NameEnv import Bag import RdrName import TcRnTypes -import FastString (concatFS) +import FastString (fastStringToByteString) import BasicTypes ( StringLiteral(..), SourceText(..) ) import qualified Outputable as O import HsDecls ( getConArgs ) @@ -293,11 +293,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 75b2f223..ce1dbc62 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -46,12 +46,12 @@ processDocStrings dflags gre strs = do x -> pure (Just x) processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (MDoc Name) -processDocStringParas dflags gre (HsDocString fs) = - overDocF (rename dflags gre) $ parseParas dflags (unpackFS fs) +processDocStringParas dflags gre hds = + overDocF (rename dflags gre) $ parseParas dflags (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 -> GlobalRdrEnv -> SafeHaskellMode -> Maybe LHsDocString -> ErrMsgM (HaddockModInfo Name, Maybe (MDoc Name)) @@ -59,8 +59,8 @@ processModuleHeader dflags 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 str !descr <- case hmi_description hmi of Just hmi_descr -> Just <$> rename dflags gre hmi_descr |