[commit: haddock] wip/D538: Adding SourceText to pragma declarations (ade0426)
git at git.haskell.org
git at git.haskell.org
Wed Jul 8 08:35:19 UTC 2015
Repository : ssh://git@git.haskell.org/haddock
On branch : wip/D538
Link : http://git.haskell.org/haddock.git/commitdiff/ade04264df95ebebec1a4c15b2ba222aa40b67ed
>---------------------------------------------------------------
commit ade04264df95ebebec1a4c15b2ba222aa40b67ed
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date: Sun Dec 7 10:42:56 2014 +0200
Adding SourceText to pragma declarations
>---------------------------------------------------------------
ade04264df95ebebec1a4c15b2ba222aa40b67ed
haddock-api/src/Haddock/Backends/Hoogle.hs | 2 +-
haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 2 +-
haddock-api/src/Haddock/Convert.hs | 6 +++---
haddock-api/src/Haddock/GhcUtils.hs | 4 ++--
haddock-api/src/Haddock/Interface/Create.hs | 8 ++++----
haddock-api/src/Haddock/Interface/Rename.hs | 2 +-
6 files changed, 12 insertions(+), 12 deletions(-)
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index dd10bb0..6353a5f 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -145,7 +145,7 @@ ppClass dflags x = out dflags x{tcdSigs=[]} :
concatMap (ppSig dflags . addContext . unL) (tcdSigs x)
where
addContext (TypeSig name (L l sig) nwcs) = TypeSig name (L l $ f sig) nwcs
- addContext (MinimalSig sig) = MinimalSig sig
+ addContext (MinimalSig src sig) = MinimalSig src sig
addContext _ = error "expected TypeSig"
f (HsForAllTy a b c con d) = HsForAllTy a b c (reL (context : unLoc con)) d
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index ae89fb3..20cac37 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -470,7 +470,7 @@ ppClassDecl summary links instances fixities loc d subdocs
-- there are different subdocs for different names in a single
-- type signature?
- minimalBit = case [ s | L _ (MinimalSig s) <- lsigs ] of
+ minimalBit = case [ s | L _ (MinimalSig _ s) <- lsigs ] of
-- Miminal complete definition = every shown method
And xs : _ | sort [getName n | Var (L _ n) <- xs] ==
sort [getName n | L _ (TypeSig ns _ _) <- lsigs, L _ n <- ns]
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 4c019bc..a5b97ad 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -77,7 +77,7 @@ tyThingToLHsDecl t = case t of
, tcdFDs = map (\ (l,r) -> noLoc
(map getName l, map getName r) ) $
snd $ classTvsFds cl
- , tcdSigs = noLoc (MinimalSig . fmap noLoc $ classMinimalDef cl) :
+ , tcdSigs = noLoc (MinimalSig mempty . fmap noLoc $ classMinimalDef cl) :
map (noLoc . synifyIdSig DeleteTopLevelQuantification)
(classMethods cl)
, tcdMeths = emptyBag --ignore default method definitions, they don't affect signature
@@ -265,8 +265,8 @@ synifyDataCon use_gadt_syntax dc =
linear_tys = zipWith (\ty bang ->
let tySyn = synifyType WithinType ty
src_bang = case bang of
- HsUnpack {} -> HsUserBang (Just True) True
- HsStrict -> HsUserBang (Just False) True
+ HsUnpack {} -> HsUserBang Nothing (Just True) True
+ HsStrict -> HsUserBang Nothing (Just False) True
_ -> bang
in case src_bang of
HsNoBang -> tySyn
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 5aa9b81..cbf554a 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -104,8 +104,8 @@ filterSigNames p (FixSig (FixitySig ns ty)) =
case filter (p . unLoc) ns of
[] -> Nothing
filtered -> Just (FixSig (FixitySig filtered ty))
-filterSigNames _ orig@(MinimalSig _) = Just orig
-filterSigNames p (TypeSig ns ty nwcs) =
+filterSigNames _ orig@(MinimalSig _ _) = Just orig
+filterSigNames p (TypeSig ns ty nwcs) =
case filter (p . unLoc) ns of
[] -> Nothing
filtered -> Just (TypeSig filtered ty nwcs)
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 98a715a..8de8c62 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -194,8 +194,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 unLoc msg)
+ WarningTxt _ msg -> format "Warning: " (concatFS $ map unLoc msg)
where
format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
. processDocString dflags gre $ HsDocString xs
@@ -553,7 +553,7 @@ mkExportItems
L loc (TyClD cl at ClassDecl{}) -> do
mdef <- liftGhcToErrMsgGhc $ minimalDef t
- let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+ let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . fmap noLoc) mdef
return [ mkExportDecl t
(L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ]
@@ -745,7 +745,7 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
mkExportItem (L l (TyClD cl at ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
mdef <- liftGhcToErrMsgGhc $ minimalDef name
- let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+ let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . fmap noLoc) mdef
expDecl (L l (TyClD cl { tcdSigs = sig ++ sigs })) l name
mkExportItem decl@(L l d)
| name:_ <- getMainDeclBinder d = expDecl decl l name
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 1ea212f..719c068 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -415,7 +415,7 @@ renameSig sig = case sig of
FixSig (FixitySig lnames fixity) -> do
lnames' <- mapM renameL lnames
return $ FixSig (FixitySig lnames' fixity)
- MinimalSig s -> MinimalSig <$> traverse renameL s
+ MinimalSig src s -> MinimalSig src <$> traverse renameL s
-- we have filtered out all other kinds of signatures in Interface.Create
_ -> error "expected TypeSig"
More information about the ghc-commits
mailing list