Match GHC for TTG implemented on HsBinds, D4581

4 files changed, 27 insertions, 27 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 9e0b5102..09f62a19 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -138,7 +138,7 @@ ppExport dflags ExportDecl { expItemDecl    = L _ decl
 ppExport _ _ = []
 
 ppSigWithDoc :: DynFlags -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String]
-ppSigWithDoc dflags (TypeSig names sig) subdocs
+ppSigWithDoc dflags (TypeSig _ names sig) subdocs
     = concatMap mkDocSig names
     where
         mkDocSig n = concatMap (ppDocumentation dflags) (getDoc n)
@@ -262,7 +262,7 @@ ppCtor dflags _dat subdocs con@(ConDeclGADT { })
         name = out dflags $ map unL $ getConNames con
 
 ppFixity :: DynFlags -> (Name, Fixity) -> [String]
-ppFixity dflags (name, fixity) = [out dflags ((FixitySig [noLoc name] fixity) :: FixitySig GhcRn)]
+ppFixity dflags (name, fixity) = [out dflags ((FixitySig noExt [noLoc name] fixity) :: FixitySig GhcRn)]
 
 
 ---------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 3d7575eb..19d638d9 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -114,7 +114,7 @@ binds = everythingInRenamedSource
       (fun `Syb.combine` pat `Syb.combine` tvar)
   where
     fun term = case cast term of
-        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn)) ->
+        (Just (GHC.FunBind _ (GHC.L sspan name) _ _ _ :: GHC.HsBind GHC.GhcRn)) ->
             pure (sspan, RtkBind name)
         _ -> empty
     pat term = case cast term of
@@ -150,7 +150,7 @@ decls (group, _, _, _) = concatMap ($ group)
         GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam
         GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs
     fun term = case cast term of
-        (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.GhcRn))
+        (Just (GHC.FunBind _ (GHC.L sspan name) _ _ _ :: GHC.HsBind GHC.GhcRn))
             | GHC.isExternalName name -> pure (sspan, RtkDecl name)
         _ -> empty
     con term = case cast term of
@@ -169,7 +169,7 @@ decls (group, _, _, _) = concatMap ($ group)
         Just (field :: GHC.ConDeclField GHC.GhcRn)
           -> map (decl . fmap GHC.extFieldOcc) $ GHC.cd_fld_names field
         Nothing -> empty
-    sig (GHC.L _ (GHC.TypeSig names _)) = map decl names
+    sig (GHC.L _ (GHC.TypeSig _ names _)) = map decl names
     sig _ = []
     decl (GHC.L sspan name) = (sspan, RtkDecl name)
     tyref (GHC.L sspan name) = (sspan, RtkType name)
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 1229a8d3..4535979e 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -216,7 +216,7 @@ processExports (e : es) =
 
 
 isSimpleSig :: ExportItem DocNameI -> Maybe ([DocName], HsType DocNameI)
-isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig lnames t))
+isSimpleSig ExportDecl { expItemDecl = L _ (SigD (TypeSig _ lnames t))
                        , expItemMbDoc = (Documentation Nothing Nothing, argDocs) }
   | Map.null argDocs = Just (map unLoc lnames, unLoc (hsSigWcType t))
 isSimpleSig _ = Nothing
@@ -257,8 +257,8 @@ declNames :: LHsDecl DocNameI
              )
 declNames (L _ decl) = case decl of
   TyClD d  -> (empty, [tcdName d])
-  SigD (TypeSig lnames _ ) -> (empty, map unLoc lnames)
-  SigD (PatSynSig lnames _) -> (text "pattern", map unLoc lnames)
+  SigD (TypeSig _ lnames _ ) -> (empty, map unLoc lnames)
+  SigD (PatSynSig _ lnames _) -> (text "pattern", map unLoc lnames)
   ForD (ForeignImport (L _ n) _ _ _) -> (empty, [n])
   ForD (ForeignExport (L _ n) _ _ _) -> (empty, [n])
   _ -> error "declaration not supported by declNames"
@@ -300,13 +300,13 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
 --  TyClD d@TySynonym{}
 --    | Just _  <- tcdTyPats d    -> ppTyInst False loc doc d unicode
 -- Family instances happen via FamInst now
-  TyClD d@ClassDecl{}        -> ppClassDecl instances doc subdocs d unicode
-  SigD (TypeSig lnames ty)   -> ppFunSig (doc, fnArgsDoc) (map unLoc lnames) (hsSigWcType ty) unicode
-  SigD (PatSynSig lnames ty) -> ppLPatSig (doc, fnArgsDoc) (map unLoc lnames) ty unicode
-  ForD d                     -> ppFor (doc, fnArgsDoc) d unicode
-  InstD _                    -> empty
-  DerivD _                   -> empty
-  _                          -> error "declaration not supported by ppDecl"
+  TyClD d@ClassDecl{}          -> ppClassDecl instances doc subdocs d unicode
+  SigD (TypeSig _ lnames ty)   -> ppFunSig (doc, fnArgsDoc) (map unLoc lnames) (hsSigWcType ty) unicode
+  SigD (PatSynSig _ lnames ty) -> ppLPatSig (doc, fnArgsDoc) (map unLoc lnames) ty unicode
+  ForD d                       -> ppFor (doc, fnArgsDoc) d unicode
+  InstD _                      -> empty
+  DerivD _                     -> empty
+  _                            -> error "declaration not supported by ppDecl"
   where
     unicode = False
 
@@ -548,7 +548,7 @@ ppClassDecl instances doc subdocs
     methodTable =
       text "\\haddockpremethods{}\\textbf{Methods}" $$
       vcat  [ ppFunSig doc names (hsSigWcType typ) unicode
-            | L _ (TypeSig lnames typ) <- lsigs
+            | L _ (TypeSig _ lnames typ) <- lsigs
             , let doc = lookupAnySubdoc (head names) subdocs
                   names = map unLoc lnames ]
               -- FIXME: is taking just the first name ok? Is it possible that
@@ -647,7 +647,7 @@ ppDataDecl pats instances subdocs doc dataDecl unicode =
           text "\\enspace" <+> emph (text "Bundled Patterns") <> text "\\par" $$
           text "\\haddockbeginconstrs" $$
           vcat [ empty <-> ppSideBySidePat lnames typ d unicode
-               | (SigD (PatSynSig lnames typ), d) <- pats
+               | (SigD (PatSynSig _ lnames typ), d) <- pats
                ] $$
           text "\\end{tabulary}\\par"
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index a4f2a4a5..5f253cbd 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -58,9 +58,9 @@ ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdoc
   TyClD d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode qual
   TyClD d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
   TyClD d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
-  SigD (TypeSig lnames lty)    -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
+  SigD (TypeSig _ lnames lty)  -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
                                          (hsSigWcType lty) fixities splice unicode qual
-  SigD (PatSynSig lnames lty)   -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames
+  SigD (PatSynSig _ lnames lty) -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames
                                          (hsSigType lty) fixities splice unicode qual
   ForD d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
   InstD _                      -> noHtml
@@ -513,7 +513,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
 
             [ ppFunSig summary links loc doc names (hsSigWcType typ)
                        [] splice unicode qual
-              | L _ (TypeSig lnames typ) <- sigs
+              | L _ (TypeSig _ lnames typ) <- sigs
               , let doc = lookupAnySubdoc (head names) subdocs
                     names = map unLoc lnames ]
               -- FIXME: is taking just the first name ok? Is it possible that
@@ -561,7 +561,7 @@ ppClassDecl summary links instances fixities loc d subdocs
 
     methodBit = subMethods [ ppFunSig summary links loc doc names (hsSigType typ)
                                       subfixs splice unicode qual
-                           | L _ (ClassOpSig _ lnames typ) <- lsigs
+                           | L _ (ClassOpSig _ _ lnames typ) <- lsigs
                            , let doc = lookupAnySubdoc (head names) subdocs
                                  subfixs = [ f | n <- names
                                                , f@(n',_) <- fixities
@@ -570,15 +570,15 @@ ppClassDecl summary links instances fixities loc d subdocs
                            -- N.B. taking just the first name is ok. Signatures with multiple names
                            -- are expanded so that each name gets its own signature.
 
-    minimalBit = case [ s | MinimalSig _ (L _ s) <- sigs ] of
+    minimalBit = case [ s | MinimalSig _ _ (L _ s) <- sigs ] of
       -- Miminal complete definition = every shown method
       And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] ==
-                   sort [getName n | TypeSig ns _ <- sigs, L _ n <- ns]
+                   sort [getName n | TypeSig _ ns _ <- sigs, L _ n <- ns]
         -> noHtml
 
       -- Minimal complete definition = the only shown method
       Var (L _ n) : _ | [getName n] ==
-                        [getName n' | L _ (TypeSig ns _) <- lsigs, L _ n' <- ns]
+                        [getName n' | L _ (TypeSig _ ns _) <- lsigs, L _ n' <- ns]
         -> noHtml
 
       -- Minimal complete definition = nothing
@@ -679,7 +679,7 @@ ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
               -> [Sig DocNameI]
               -> [Html]
 ppInstanceSigs links splice unicode qual sigs = do
-    TypeSig lnames typ <- sigs
+    TypeSig _ lnames typ <- sigs
     let names = map unLoc lnames
         L _ rtyp = hsSigWcType typ
     -- Instance methods signatures are synified and thus don't have a useful
@@ -746,7 +746,7 @@ ppShortDataDecl summary dataInst dataDecl pats unicode qual
                    , dcolon unicode
                    , ppPatSigType unicode qual (hsSigType typ)
                    ]
-            | (SigD (PatSynSig lnames typ),_) <- pats
+            | (SigD (PatSynSig _ lnames typ),_) <- pats
             ]
 
 
@@ -793,7 +793,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
 
     patternBit = subPatterns qual
       [ ppSideBySidePat subfixs unicode qual lnames typ d
-      | (SigD (PatSynSig lnames typ), d) <- pats
+      | (SigD (PatSynSig _ lnames typ), d) <- pats
       , let subfixs = filter (\(n,_) -> any (\cn -> cn == n)
                                             (map unLoc lnames)) fixities
       ]