aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2015-05-25 17:14:01 +0200
committerMatthew Pickering <matthewtpickering@gmail.com>2015-12-14 15:10:59 +0000
commit75a23ec042888ba5387ad653b74fe170a6721784 (patch)
tree5986f3522f8bcbbe3a69947c2b7a630c23555ed5
parent53ae59ff35fefacff28823f5b7c9e86535cbf024 (diff)
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.
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs6
1 files changed, 3 insertions, 3 deletions
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