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