From 75a23ec042888ba5387ad653b74fe170a6721784 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Mon, 25 May 2015 17:14:01 +0200
Subject: ApiAnnotations : strings in warnings do not return SourceText

The strings used in a WARNING pragma are captured via

strings :: { Located ([AddAnn],[Located FastString]) }
    : STRING { sL1 $1 ([],[L (gl $1) (getSTRING $1)]) }
..

The STRING token has a method getSTRINGs that returns the original
source text for a string.

A warning of the form

{-# WARNING Logic
          , mkSolver
          , mkSimpleSolver
          , mkSolverForLogic
          , solverSetParams
          , solverPush
          , solverPop
          , solverReset
          , solverGetNumScopes
          , solverAssertCnstr
          , solverAssertAndTrack
          , solverCheck
          , solverCheckAndGetModel
          , solverGetReasonUnknown
          "New Z3 API support is still incomplete and fragile: \
          \you may experience segmentation faults!"
  #-}

returns the concatenated warning string rather than the original source.
---
 haddock-api/src/Haddock/Interface/Create.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 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 0599151e..8b4605a7 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -164,7 +164,7 @@ mkAliasMap dflags mRenamedSource =
         return $
           (lookupModuleDyn dflags
              (fmap Module.fsToPackageKey $
-              ideclPkgQual impDecl)
+              fmap snd $ ideclPkgQual impDecl)
              (case ideclName impDecl of SrcLoc.L _ name -> name),
            alias))
         impDecls
@@ -200,8 +200,8 @@ moduleWarning dflags gre (WarnAll w) = Just $ parseWarning dflags gre w
 
 parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> Doc Name
 parseWarning dflags gre w = force $ case w of
-  DeprecatedTxt _ msg -> format "Deprecated: " (concatFS $ map unLoc msg)
-  WarningTxt    _ msg -> format "Warning: "    (concatFS $ map unLoc msg)
+  DeprecatedTxt _ msg -> format "Deprecated: " (concatFS $ map (snd . unLoc) msg)
+  WarningTxt    _ msg -> format "Warning: "    (concatFS $ map (snd . unLoc) msg)
   where
     format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
                   . processDocString dflags gre $ HsDocString xs
-- 
cgit v1.2.3