From 090813eaa7a7dbc5ba20a979150ca37521849994 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Mon, 28 May 2018 03:13:15 +0200
Subject: Adjust to new HsDocString internals

---
 haddock-api/src/Haddock/Interface/Create.hs     | 10 +++++-----
 haddock-api/src/Haddock/Interface/LexParseRn.hs | 15 +++++++--------
 2 files changed, 12 insertions(+), 13 deletions(-)

(limited to 'haddock-api/src/Haddock/Interface')

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
-- 
cgit v1.2.3