[commit: haddock] wip/D538: FunDeps are Located (39f8cae)
git at git.haskell.org
git at git.haskell.org
Wed Jul 8 08:35:21 UTC 2015
Repository : ssh://git@git.haskell.org/haddock
On branch : wip/D538
Link : http://git.haskell.org/haddock.git/commitdiff/39f8cae1051b7fe9f6fbf97ad2ae58ba5db23520
>---------------------------------------------------------------
commit 39f8cae1051b7fe9f6fbf97ad2ae58ba5db23520
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date: Tue Dec 9 23:49:49 2014 +0200
FunDeps are Located
>---------------------------------------------------------------
39f8cae1051b7fe9f6fbf97ad2ae58ba5db23520
haddock-api/src/Haddock/Backends/LaTeX.hs | 8 ++++----
haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 6 +++---
haddock-api/src/Haddock/Convert.hs | 2 +-
haddock-api/src/Haddock/Interface/Rename.hs | 6 +++---
4 files changed, 11 insertions(+), 11 deletions(-)
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 9bac9d0..5046da8 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -477,7 +477,7 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace
ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
- -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
+ -> LHsTyVarBndrs DocName -> [Located ([Located DocName], [Located DocName])]
-> Bool -> LaTeX
ppClassHdr summ lctxt n tvs fds unicode =
keyword "class"
@@ -486,13 +486,13 @@ ppClassHdr summ lctxt n tvs fds unicode =
<+> ppFds fds unicode
-ppFds :: [Located ([DocName], [DocName])] -> Bool -> LaTeX
+ppFds :: [Located ([Located DocName], [Located DocName])] -> Bool -> LaTeX
ppFds fds unicode =
if null fds then empty else
char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
where
- fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> arrow unicode <+>
- hsep (map ppDocName vars2)
+ fundep (vars1,vars2) = hsep (map (ppDocName . unLoc) vars1) <+> arrow unicode <+>
+ hsep (map (ppDocName . unLoc) vars2)
ppClassDecl :: [DocInstance DocName] -> SrcSpan
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 20cac37..5b88fb4 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -381,7 +381,7 @@ ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
- -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
+ -> LHsTyVarBndrs DocName -> [Located ([Located DocName], [Located DocName])]
-> Unicode -> Qualification -> Html
ppClassHdr summ lctxt n tvs fds unicode qual =
keyword "class"
@@ -390,13 +390,13 @@ ppClassHdr summ lctxt n tvs fds unicode qual =
<+> ppFds fds unicode qual
-ppFds :: [Located ([DocName], [DocName])] -> Unicode -> Qualification -> Html
+ppFds :: [Located ([Located DocName], [Located DocName])] -> Unicode -> Qualification -> Html
ppFds fds unicode qual =
if null fds then noHtml else
char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
where
fundep (vars1,vars2) = ppVars vars1 <+> arrow unicode <+> ppVars vars2
- ppVars = hsep . map (ppDocName qual Prefix True)
+ ppVars = hsep . map ((ppDocName qual Prefix True) . unLoc)
ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
-> [(DocName, DocForDecl DocName)]
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index a5b97ad..5606abf 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -75,7 +75,7 @@ tyThingToLHsDecl t = case t of
, tcdLName = synifyName cl
, tcdTyVars = synifyTyVars (classTyVars cl)
, tcdFDs = map (\ (l,r) -> noLoc
- (map getName l, map getName r) ) $
+ (map (noLoc . getName) l, map (noLoc . getName) r) ) $
snd $ classTvsFds cl
, tcdSigs = noLoc (MinimalSig mempty . fmap noLoc $ classMinimalDef cl) :
map (noLoc . synifyIdSig DeleteTopLevelQuantification)
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 719c068..b222a39 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -331,9 +331,9 @@ renameTyClD d = case d of
where
renameLFunDep (L loc (xs, ys)) = do
- xs' <- mapM rename xs
- ys' <- mapM rename ys
- return (L loc (xs', ys'))
+ xs' <- mapM rename (map unLoc xs)
+ ys' <- mapM rename (map unLoc ys)
+ return (L loc (map noLoc xs', map noLoc ys'))
renameLSig (L loc sig) = return . L loc =<< renameSig sig
More information about the ghc-commits
mailing list