[commit: haddock] wip/api-ann-hstylit-2, wip/api-ann-hstylit-3, wip/api-ann-hstylit-4, wip/api-ann-hstylit-5: Adding SourceText to pragma declarations (23a6b47)
git at git.haskell.org
git at git.haskell.org
Wed Jul 8 08:33:58 UTC 2015
Repository : ssh://git@git.haskell.org/haddock
On branches: wip/api-ann-hstylit-2,wip/api-ann-hstylit-3,wip/api-ann-hstylit-4,wip/api-ann-hstylit-5
Link : http://git.haskell.org/haddock.git/commitdiff/23a6b47ebf1d08b9683b32ef0fe00f1e95911105
>---------------------------------------------------------------
commit 23a6b47ebf1d08b9683b32ef0fe00f1e95911105
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date: Sun Dec 7 10:42:56 2014 +0200
Adding SourceText to pragma declarations
>---------------------------------------------------------------
23a6b47ebf1d08b9683b32ef0fe00f1e95911105
src/Haddock/Backends/Hoogle.hs | 2 +-
src/Haddock/Backends/Xhtml/Decl.hs | 2 +-
src/Haddock/Convert.hs | 6 +++---
src/Haddock/GhcUtils.hs | 4 ++--
src/Haddock/Interface/Create.hs | 8 ++++----
src/Haddock/Interface/Rename.hs | 2 +-
6 files changed, 12 insertions(+), 12 deletions(-)
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 1df6d9b..a0f3036 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/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/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 3353afe..30912eb 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -471,7 +471,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/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index e8f29d3..bfc42bc 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -73,7 +73,7 @@ tyThingToLHsDecl t = noLoc $ 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
@@ -245,8 +245,8 @@ synifyDataCon use_gadt_syntax dc = noLoc $
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/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index 5aa9b81..cbf554a 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/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/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 396c138..a9c6fb8 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/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
@@ -550,7 +550,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_ ]
@@ -734,7 +734,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/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index b08cd27..a0bb2cb 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -416,7 +416,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