[commit: haddock] wip/ast-prepare-annotations-final: FixitySig has multiple names (d86af79)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : wip/ast-prepare-annotations-final
Link       : http://git.haskell.org/haddock.git/commitdiff/d86af79f2c314193a89fc40c7204d9b4198ce738

>---------------------------------------------------------------

commit d86af79f2c314193a89fc40c7204d9b4198ce738
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Wed Nov 12 18:22:10 2014 +0200

    FixitySig has multiple names


>---------------------------------------------------------------

d86af79f2c314193a89fc40c7204d9b4198ce738
 src/Haddock/GhcUtils.hs         | 25 ++++++++++++++-----------
 src/Haddock/Interface/Create.hs |  3 ++-
 src/Haddock/Interface/Rename.hs |  6 +++---
 3 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index a81fc42..ef20d02 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -97,11 +97,14 @@ filterLSigNames :: (name -> Bool) -> LSig name -> Maybe (LSig name)
 filterLSigNames p (L loc sig) = L loc <$> (filterSigNames p sig)
 
 filterSigNames :: (name -> Bool) -> Sig name -> Maybe (Sig name)
-filterSigNames p orig@(SpecSig n _ _)          = ifTrueJust (p $ unLoc n) orig
-filterSigNames p orig@(InlineSig n _)          = ifTrueJust (p $ unLoc n) orig
-filterSigNames p orig@(FixSig (FixitySig n _)) = ifTrueJust (p $ unLoc n) orig
-filterSigNames _ orig@(MinimalSig _)           = Just orig
-filterSigNames p (TypeSig ns ty)               =
+filterSigNames p orig@(SpecSig n _ _)           = ifTrueJust (p $ unLoc n) orig
+filterSigNames p orig@(InlineSig n _)           = ifTrueJust (p $ unLoc n) orig
+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)                =
   case filter (p . unLoc) ns of
     []       -> Nothing
     filtered -> Just (TypeSig filtered ty)
@@ -115,12 +118,12 @@ sigName :: LSig name -> [name]
 sigName (L _ sig) = sigNameNoLoc sig
 
 sigNameNoLoc :: Sig name -> [name]
-sigNameNoLoc (TypeSig   ns _)         = map unLoc ns
-sigNameNoLoc (PatSynSig n _ _ _ _)    = [unLoc n]
-sigNameNoLoc (SpecSig   n _ _)        = [unLoc n]
-sigNameNoLoc (InlineSig n _)          = [unLoc n]
-sigNameNoLoc (FixSig (FixitySig n _)) = [unLoc n]
-sigNameNoLoc _                        = []
+sigNameNoLoc (TypeSig   ns _)          = map unLoc ns
+sigNameNoLoc (PatSynSig n _ _ _ _)     = [unLoc n]
+sigNameNoLoc (SpecSig   n _ _)         = [unLoc n]
+sigNameNoLoc (InlineSig n _)           = [unLoc n]
+sigNameNoLoc (FixSig (FixitySig ns _)) = map unLoc ns
+sigNameNoLoc _                         = []
 
 
 isTyClD :: HsDecl a -> Bool
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 1e2ab40..6fa95de 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -374,7 +374,8 @@ topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup
 -- | Extract a map of fixity declarations only
 mkFixMap :: HsGroup Name -> FixMap
 mkFixMap group_ = M.fromList [ (n,f)
-                             | L _ (FixitySig (L _ n) f) <- hs_fixds group_ ]
+                             | L _ (FixitySig ns f) <- hs_fixds group_,
+                               L _ n <- ns ]
 
 
 -- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index e3932d4..7c870d9 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -416,9 +416,9 @@ renameSig sig = case sig of
     lreq' <- renameLContext lreq
     lprov' <- renameLContext lprov
     return $ PatSynSig lname' args' ltype' lreq' lprov'
-  FixSig (FixitySig lname fixity) -> do
-    lname' <- renameL lname
-    return $ FixSig (FixitySig lname' fixity)
+  FixSig (FixitySig lnames fixity) -> do
+    lnames' <- mapM renameL lnames
+    return $ FixSig (FixitySig lnames' fixity)
   MinimalSig s -> MinimalSig <$> traverse renameL s
   -- we have filtered out all other kinds of signatures in Interface.Create
   _ -> error "expected TypeSig"