Match changes in GHC for TTG

1 files changed, 59 insertions, 59 deletions

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index c119f3c3..bc93449f 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -125,7 +125,7 @@ createInterface tm flags modMap instIfaceMap = do
                         $  map getName instances
                         ++ map getName fam_instances
       -- Locations of all TH splices
-      splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ]
+      splices = [ l | L l (SpliceD _ _) <- hsmodDecls hsm ]
 
   warningMap <- liftErrMsg (mkWarningMap dflags warnings gre exportedNames)
 
@@ -406,9 +406,9 @@ mkMaps dflags gre instances decls = do
     instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ]
 
     names :: SrcSpan -> HsDecl GhcRn -> [Name]
-    names l (InstD d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
+    names l (InstD _ d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
       where loc = case d of
-              TyFamInstD _ -> l -- The CoAx's loc is the whole line, but only for TFs
+              TyFamInstD _ _ -> l -- The CoAx's loc is the whole line, but only for TFs
               _ -> getInstLoc d
     names l (DerivD {}) = maybeToList (M.lookup l instanceMap) -- See note [2].
     names _ decl = getMainDeclBinder decl
@@ -433,16 +433,16 @@ subordinates :: InstMap
              -> HsDecl GhcRn
              -> [(Name, [HsDocString], Map Int HsDocString)]
 subordinates instMap decl = case decl of
-  InstD (ClsInstD d) -> do
+  InstD _ (ClsInstD _ d) -> do
     DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
       FamEqn { feqn_tycon = L l _
              , feqn_rhs   = defn }}} <- unLoc <$> cid_datafam_insts d
     [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs defn
 
-  InstD (DataFamInstD (DataFamInstDecl (HsIB { hsib_body = d })))
+  InstD _ (DataFamInstD _ (DataFamInstDecl (HsIB { hsib_body = d })))
     -> dataSubs (feqn_rhs d)
-  TyClD d | isClassDecl d -> classSubs d
-          | isDataDecl  d -> dataSubs (tcdDataDefn d)
+  TyClD _ d | isClassDecl d -> classSubs d
+            | isDataDecl  d -> dataSubs (tcdDataDefn d)
   _ -> []
   where
     classSubs dd = [ (name, doc, declTypeDocs d) | (L _ d, doc) <- classDecls dd
@@ -456,7 +456,7 @@ subordinates instMap decl = case decl of
                   | c <- cons, cname <- getConNames c ]
         fields  = [ (extFieldOcc n, maybeToList $ fmap unL doc, M.empty)
                   | RecCon flds <- map getConArgs cons
-                  , L _ (ConDeclField ns _ doc) <- (unLoc flds)
+                  , L _ (ConDeclField _ ns _ doc) <- (unLoc flds)
                   , L _ n <- ns ]
         derivs  = [ (instName, [unL doc], M.empty)
                   | HsIB { hsib_body = L l (HsDocTy _ _ doc) }
@@ -481,11 +481,11 @@ conArgDocs con = case getConArgs con of
 
 -- | Extract function argument docs from inside top-level decls.
 declTypeDocs :: HsDecl GhcRn -> Map Int HsDocString
-declTypeDocs (SigD (TypeSig _ _ ty))      = typeDocs (unLoc (hsSigWcType ty))
-declTypeDocs (SigD (ClassOpSig _ _ _ ty)) = typeDocs (unLoc (hsSigType ty))
-declTypeDocs (SigD (PatSynSig _ _ ty))    = typeDocs (unLoc (hsSigType ty))
-declTypeDocs (ForD (ForeignImport _ ty _ _))   = typeDocs (unLoc (hsSigType ty))
-declTypeDocs (TyClD (SynDecl { tcdRhs = ty })) = typeDocs (unLoc ty)
+declTypeDocs (SigD  _ (TypeSig _ _ ty))          = typeDocs (unLoc (hsSigWcType ty))
+declTypeDocs (SigD  _ (ClassOpSig _ _ _ ty))     = typeDocs (unLoc (hsSigType ty))
+declTypeDocs (SigD  _ (PatSynSig _ _ ty))        = typeDocs (unLoc (hsSigType ty))
+declTypeDocs (ForD  _ (ForeignImport _ _ ty _))  = typeDocs (unLoc (hsSigType ty))
+declTypeDocs (TyClD _ (SynDecl { tcdRhs = ty })) = typeDocs (unLoc ty)
 declTypeDocs _ = M.empty
 
 -- | Extract function argument docs from inside types.
@@ -505,10 +505,10 @@ classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
 classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
   where
     decls = docs ++ defs ++ sigs ++ ats
-    docs  = mkDecls tcdDocs DocD class_
-    defs  = mkDecls (bagToList . tcdMeths) ValD class_
-    sigs  = mkDecls tcdSigs SigD class_
-    ats   = mkDecls tcdATs (TyClD . FamDecl) class_
+    docs  = mkDecls tcdDocs (DocD noExt) class_
+    defs  = mkDecls (bagToList . tcdMeths) (ValD noExt) class_
+    sigs  = mkDecls tcdSigs (SigD noExt) class_
+    ats   = mkDecls tcdATs (TyClD noExt . FamDecl noExt) class_
 
 
 -- | The top-level declarations of a module that we care about,
@@ -526,14 +526,14 @@ mkFixMap group_ = M.fromList [ (n,f)
 -- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
 ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]
 ungroup group_ =
-  mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD  group_ ++
-  mkDecls hs_derivds             DerivD group_ ++
-  mkDecls hs_defds               DefD   group_ ++
-  mkDecls hs_fords               ForD   group_ ++
-  mkDecls hs_docs                DocD   group_ ++
-  mkDecls (tyClGroupInstDecls . hs_tyclds) InstD  group_ ++
-  mkDecls (typesigs . hs_valds)  SigD   group_ ++
-  mkDecls (valbinds . hs_valds)  ValD   group_
+  mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExt)  group_ ++
+  mkDecls hs_derivds             (DerivD noExt) group_ ++
+  mkDecls hs_defds               (DefD noExt)   group_ ++
+  mkDecls hs_fords               (ForD noExt)   group_ ++
+  mkDecls hs_docs                (DocD noExt)   group_ ++
+  mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExt)  group_ ++
+  mkDecls (typesigs . hs_valds)  (SigD noExt)   group_ ++
+  mkDecls (valbinds . hs_valds)  (ValD noExt)   group_
   where
     typesigs (XValBindsLR (NValBinds _ sigs)) = filter isUserLSig sigs
     typesigs _ = error "expected ValBindsOut"
@@ -564,14 +564,14 @@ sortByLoc = sortBy (comparing getLoc)
 filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
 filterDecls = filter (isHandled . unL . fst)
   where
-    isHandled (ForD (ForeignImport {})) = True
+    isHandled (ForD _ (ForeignImport {})) = True
     isHandled (TyClD {})  = True
     isHandled (InstD {})  = True
     isHandled (DerivD {}) = True
-    isHandled (SigD d) = isUserLSig (reL d)
-    isHandled (ValD _) = True
+    isHandled (SigD _ d)  = isUserLSig (reL d)
+    isHandled (ValD {})   = True
     -- we keep doc declarations to be able to get at named docs
-    isHandled (DocD _) = True
+    isHandled (DocD {})   = True
     isHandled _ = False
 
 
@@ -580,8 +580,8 @@ filterClasses :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
 filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x
                       | x@(L loc d, doc) <- decls ]
   where
-    filterClass (TyClD c) =
-      TyClD $ c { tcdSigs = filter (liftA2 (||) isUserLSig isMinimalLSig) $ tcdSigs c }
+    filterClass (TyClD x c) =
+      TyClD x $ c { tcdSigs = filter (liftA2 (||) isUserLSig isMinimalLSig) $ tcdSigs c }
     filterClass _ = error "expected TyClD"
 
 
@@ -600,10 +600,10 @@ collectDocs = go Nothing []
   where
     go Nothing _ [] = []
     go (Just prev) docs [] = finished prev docs []
-    go prev docs (L _ (DocD (DocCommentNext str)) : ds)
+    go prev docs (L _ (DocD _ (DocCommentNext str)) : ds)
       | Nothing <- prev = go Nothing (str:docs) ds
       | Just decl <- prev = finished decl docs (go Nothing [str] ds)
-    go prev docs (L _ (DocD (DocCommentPrev str)) : ds) = go prev (str:docs) ds
+    go prev docs (L _ (DocD _ (DocCommentPrev str)) : ds) = go prev (str:docs) ds
     go Nothing docs (d:ds) = go (Just d) docs ds
     go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)
 
@@ -644,22 +644,22 @@ mkExportItems
         decls maps fixMap splices instIfaceMap dflags allExports
     Just exports -> liftM concat $ mapM lookupExport exports
   where
-    lookupExport (IEGroup lev docStr, _)  = liftErrMsg $ do
+    lookupExport (IEGroup _ lev docStr, _)  = liftErrMsg $ do
       doc <- processDocString dflags gre docStr
       return [ExportGroup lev "" doc]
 
-    lookupExport (IEDoc docStr, _)        = liftErrMsg $ do
+    lookupExport (IEDoc _ docStr, _)        = liftErrMsg $ do
       doc <- processDocStringParas dflags gre docStr
       return [ExportDoc doc]
 
-    lookupExport (IEDocNamed str, _)      = liftErrMsg $
+    lookupExport (IEDocNamed _ str, _)      = liftErrMsg $
       findNamedDoc str [ unL d | d <- decls ] >>= \case
         Nothing -> return  []
         Just docStr -> do
           doc <- processDocStringParas dflags gre docStr
           return [ExportDoc doc]
 
-    lookupExport (IEModuleContents (L _ mod_name), _)
+    lookupExport (IEModuleContents _ (L _ mod_name), _)
       -- only consider exporting a module if we are sure we
       -- are really exporting the whole module and not some
       -- subset. We also look through module aliases here.
@@ -696,7 +696,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
       let t = availName avail
       r    <- findDecl avail
       case r of
-        ([L l (ValD _)], (doc, _)) -> do
+        ([L l (ValD _ _)], (doc, _)) -> do
           -- Top-level binding without type signature
           export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap
           return [export]
@@ -721,17 +721,17 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
                   -- A single signature might refer to many names, but we
                   -- create an export item for a single name only.  So we
                   -- modify the signature to contain only that single name.
-                  L loc (SigD sig) ->
+                  L loc (SigD _ sig) ->
                     -- fromJust is safe since we already checked in guards
                     -- that 't' is a name declared in this declaration.
-                    let newDecl = L loc . SigD . fromJust $ filterSigNames (== t) sig
+                    let newDecl = L loc . SigD noExt . fromJust $ filterSigNames (== t) sig
                     in availExportDecl avail newDecl docs_
 
-                  L loc (TyClD cl@ClassDecl{}) -> do
+                  L loc (TyClD _ cl@ClassDecl{}) -> do
                     mdef <- liftGhcToErrMsgGhc $ minimalDef t
                     let sig = maybeToList $ fmap (noLoc . MinimalSig noExt NoSourceText . noLoc . fmap noLoc) mdef
                     availExportDecl avail
-                      (L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_
+                      (L loc $ TyClD noExt cl { tcdSigs = sig ++ tcdSigs cl }) docs_
 
                   _ -> availExportDecl avail decl docs_
 
@@ -994,7 +994,7 @@ fullModuleContents is_sig modMap thisMod semMod warnings exportedNames
     for (getMainDeclBinder (unLoc decl)) $ \nm -> do
       case lookupNameEnv availEnv nm of
         Just avail
-          | L _ (ValD valDecl) <- decl
+          | L _ (ValD _ valDecl) <- decl
           , (name:_) <- collectHsBindBinders valDecl
           , Just (L _ SigD{}:_) <- filter isSigD <$> M.lookup name declMap
           -> pure []
@@ -1017,7 +1017,7 @@ extractDecl declMap name decl
   | name `elem` getMainDeclBinder (unLoc decl) = decl
   | otherwise  =
     case unLoc decl of
-      TyClD d@ClassDecl {} ->
+      TyClD _ d@ClassDecl {} ->
         let
           matchesMethod =
             [ lsig
@@ -1037,8 +1037,8 @@ extractDecl declMap name decl
         in case (matchesMethod, matchesAssociatedType)  of
           ([s0], _) -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d)
                            L pos sig = addClassContext n tyvar_names s0
-                       in L pos (SigD sig)
-          (_, [L pos fam_decl]) -> L pos (TyClD (FamDecl fam_decl))
+                       in L pos (SigD noExt sig)
+          (_, [L pos fam_decl]) -> L pos (TyClD noExt (FamDecl noExt fam_decl))
 
           ([], [])
             | Just (famInstDecl:_) <- M.lookup name declMap
@@ -1047,21 +1047,21 @@ extractDecl declMap name decl
                                          O.$$ O.nest 4 (O.ppr d)
                                          O.$$ O.text "Matches:"
                                          O.$$ O.nest 4 (O.ppr matchesMethod O.<+> O.ppr matchesAssociatedType))
-      TyClD d@DataDecl {} ->
+      TyClD _ d@DataDecl {} ->
         let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d))
         in if isDataConName name
-           then SigD <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d))
-           else SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))
-      TyClD FamDecl {}
+           then SigD noExt <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d))
+           else SigD noExt <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))
+      TyClD _ FamDecl {}
         | isValName name
         , Just (famInst:_) <- M.lookup name declMap
         -> extractDecl declMap name famInst
-      InstD (DataFamInstD (DataFamInstDecl (HsIB { hsib_body =
+      InstD _ (DataFamInstD _ (DataFamInstDecl (HsIB { hsib_body =
                              FamEqn { feqn_tycon = L _ n
                                     , feqn_pats  = tys
                                     , feqn_rhs   = defn }}))) ->
-        SigD <$> extractRecSel name n tys (dd_cons defn)
-      InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) ->
+        SigD noExt <$> extractRecSel name n tys (dd_cons defn)
+      InstD _ (ClsInstD _ ClsInstDecl { cid_datafam_insts = insts }) ->
         let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))
                                <- insts
                              -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (feqn_rhs d)
@@ -1071,7 +1071,7 @@ extractDecl declMap name decl
                            , extFieldOcc n == name
                       ]
         in case matches of
-          [d0] -> extractDecl declMap name (noLoc . InstD $ DataFamInstD d0)
+          [d0] -> extractDecl declMap name (noLoc . InstD noExt $ DataFamInstD noExt d0)
           _ -> error "internal: extractDecl (ClsInstD)"
       _ -> error "internal: extractDecl"
 
@@ -1112,12 +1112,12 @@ extractRecSel _ _ _ [] = error "extractRecSel: selector not found"
 
 extractRecSel nm t tvs (L _ con : rest) =
   case getConArgs con of
-    RecCon (L _ fields) | ((l,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
+    RecCon (L _ fields) | ((l,L _ (ConDeclField _ _nn ty _)) : _) <- matching_fields fields ->
       L l (TypeSig noExt [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExt data_ty (getBangType ty)))))
     _ -> extractRecSel nm t tvs rest
  where
   matching_fields :: [LConDeclField GhcRn] -> [(SrcSpan, LConDeclField GhcRn)]
-  matching_fields flds = [ (l,f) | f@(L _ (ConDeclField ns _ _)) <- flds
+  matching_fields flds = [ (l,f) | f@(L _ (ConDeclField _ ns _ _)) <- flds
                                  , L l n <- ns, extFieldOcc n == nm ]
   data_ty
     -- ResTyGADT _ ty <- con_res con = ty
@@ -1142,8 +1142,8 @@ mkVisibleNames (_, _, _, instMap) exports opts
       where subs    = map fst (expItemSubDocs e)
             patsyns = concatMap (getMainDeclBinder . fst) (expItemPats e)
             name = case unLoc $ expItemDecl e of
-              InstD d -> maybeToList $ M.lookup (getInstLoc d) instMap
-              decl    -> getMainDeclBinder decl
+              InstD _ d -> maybeToList $ M.lookup (getInstLoc d) instMap
+              decl      -> getMainDeclBinder decl
     exportName ExportNoDecl {} = [] -- we don't count these as visible, since
                                     -- we don't want links to go to them.
     exportName _ = []
@@ -1184,7 +1184,7 @@ findNamedDoc name = search
     search [] = do
       tell ["Cannot find documentation for: $" ++ name]
       return Nothing
-    search (DocD (DocCommentNamed name' doc) : rest)
+    search (DocD _ (DocCommentNamed name' doc) : rest)
       | name == name' = return (Just doc)
       | otherwise = search rest
     search (_other_decl : rest) = search rest