updates for compatibility with GHC HEAD

src/Config/Haskell.hs

@@ -85,6 +85,6 @@ errorOn (L pos val) msg = exitMessageImpure $
 errorOnComment :: LEpaComment -> String -> b
 errorOnComment c@(L s _) msg = exitMessageImpure $
     let isMultiline = isCommentMultiline c in
-    showSrcSpan (RealSrcSpan (anchor s) GHC.Data.Strict.Nothing) ++
+    showSrcSpan (RealSrcSpan (epaLocationRealSrcSpan s) GHC.Data.Strict.Nothing) ++
     ": Error while reading hint file, " ++ msg ++ "\n" ++
     (if isMultiline then "{-" else "--") ++ commentText c ++ (if isMultiline then "-}" else "")

src/GHC/Util/ApiAnnotation.hs

@@ -107,8 +107,8 @@ languagePragmas ps =
 -- Given a list of flags, make a GHC options pragma.
 mkFlags :: NoCommentsLocation -> [String] -> LEpaComment
 mkFlags anc flags =
-  L anc $ EpaComment (EpaBlockComment ("{-# " ++ "OPTIONS_GHC " ++ unwords flags ++ " #-}")) (anchor anc)
+  L anc $ EpaComment (EpaBlockComment ("{-# " ++ "OPTIONS_GHC " ++ unwords flags ++ " #-}")) (epaLocationRealSrcSpan anc)
 
 mkLanguagePragmas :: NoCommentsLocation -> [String] -> LEpaComment
 mkLanguagePragmas anc exts =
-  L anc $ EpaComment (EpaBlockComment ("{-# " ++ "LANGUAGE " ++ intercalate ", " exts ++ " #-}")) (anchor anc)
+  L anc $ EpaComment (EpaBlockComment ("{-# " ++ "LANGUAGE " ++ intercalate ", " exts ++ " #-}")) (epaLocationRealSrcSpan anc)

src/GHC/Util/Brackets.hs

@@ -36,8 +36,6 @@ instance Brackets (LocatedA (HsExpr GhcPs)) where
   isAtom (L _ x) = case x of
       HsVar{} -> True
       HsUnboundVar{} -> True
-      -- Technically atomic, but lots of people think it shouldn't be
-      HsRecSel{} -> False
       -- Only relevant for OverloadedRecordDot extension
       HsGetField{} -> True
       HsOverLabel{} -> True
@@ -61,12 +59,10 @@ instance Brackets (LocatedA (HsExpr GhcPs)) where
       _  -> False
       where
         isNegativeLit (HsInt _ i) = il_neg i
-        isNegativeLit (HsRat _ f _) = fl_neg f
         isNegativeLit (HsFloatPrim _ f) = fl_neg f
         isNegativeLit (HsDoublePrim _ f) = fl_neg f
         isNegativeLit (HsIntPrim _ x) = x < 0
         isNegativeLit (HsInt64Prim _ x) = x < 0
-        isNegativeLit (HsInteger _ x _) = x < 0
         isNegativeLit _ = False
         isNegativeOverLit OverLit {ol_val=HsIntegral i} = il_neg i
         isNegativeOverLit OverLit {ol_val=HsFractional f} = fl_neg f
@@ -133,8 +129,6 @@ instance Brackets (LocatedA (Pat GhcPs)) where
       isSignedLit HsInt{} = True
       isSignedLit HsIntPrim{} = True
       isSignedLit HsInt64Prim{} = True
-      isSignedLit HsInteger{} = True
-      isSignedLit HsRat{} = True
       isSignedLit HsFloatPrim{} = True
       isSignedLit HsDoublePrim{} = True
       isSignedLit _ = False

src/GHC/Util/FreeVars.hs

@@ -128,7 +128,6 @@ instance FreeVars (LocatedA (HsExpr GhcPs)) where
   freeVars (L _ (HsUntypedBracket _ (ExpBr _ e))) = freeVars e
   freeVars (L _ (HsUntypedBracket _ (VarBr _ _ v))) = Set.fromList [occName (unLoc v)]
 
-  freeVars (L _ HsRecSel{}) = mempty -- Variable pointing to a record selector.
   freeVars (L _ HsOverLabel{}) = mempty -- Overloaded label. The id of the in-scope fromLabel.
   freeVars (L _ HsIPVar{}) = mempty -- Implicit parameter.
   freeVars (L _ HsOverLit{}) = mempty -- Overloaded literal.
@@ -172,10 +171,6 @@ instance FreeVars (LocatedA (HsFieldBind (LocatedA (FieldOcc GhcPs)) (LocatedA (
    freeVars o@(L _ (HsFieldBind _ x _ True)) = Set.singleton $ occName $ unLoc $ foLabel $ unLoc x -- a pun
    freeVars o@(L _ (HsFieldBind _ _ x _)) = freeVars x
 
-instance FreeVars (LocatedA (HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where
-  freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $ ambiguousFieldOccRdrName $ unLoc x -- a pun
-  freeVars (L _ (HsFieldBind _ _ x _)) = freeVars x
-
 instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) (LocatedA (HsExpr GhcPs)))) where
   freeVars (L _ (HsFieldBind _ _ x _)) = freeVars x
 

src/GHC/Util/Scope.hs

@@ -119,7 +119,7 @@ possImport (L _ i) (L _ (Unqual x)) =
     then maybe PossiblyImported (f . first (== EverythingBut)) (ideclImportList i)
     else NotImported
   where
-    f :: (Bool, LocatedL [LIE GhcPs]) -> IsImported
+    f :: (Bool, LocatedLI [LocatedA (IE GhcPs)]) -> IsImported
     f (hide, L _ xs)
       | hide = if Just True `elem` ms then NotImported else PossiblyImported
       | Just True `elem` ms = Imported

src/GHC/Util/SrcLoc.hs

@@ -20,7 +20,7 @@ import Data.Generics.Uniplate.DataOnly
 -- Get the 'SrcSpan' out of a value located by an 'NoCommentsLocation'
 -- (e.g. comments).
 getAncLoc :: GenLocated NoCommentsLocation a -> SrcSpan
-getAncLoc o = RealSrcSpan (GHC.Parser.Annotation.anchor (GHC.Types.SrcLoc.getLoc o)) GHC.Data.Strict.Nothing
+getAncLoc o = RealSrcSpan (GHC.Parser.Annotation.epaLocationRealSrcSpan (GHC.Types.SrcLoc.getLoc o)) GHC.Data.Strict.Nothing
 
 -- 'stripLocs x' is 'x' with all contained source locs replaced by
 -- 'noSrcSpan'.

src/GHC/Util/Unify.hs

@@ -119,7 +119,10 @@ unify' nm root x y
     | Just (x :: EpAnn AnnContext) <- cast x = Just mempty
     | Just (x :: EpAnn AnnExplicitSum) <- cast x = Just mempty
     | Just (x :: EpAnn AnnFieldLabel) <- cast x = Just mempty
-    | Just (x :: EpAnn AnnList) <- cast x = Just mempty
+    | Just (x :: EpAnn (AnnList [EpToken ","])) <- cast x = Just mempty
+    | Just (x :: EpAnn (AnnList ())) <- cast x = Just mempty
+    | Just (x :: EpAnn (AnnList (EpToken "where"))) <- cast x = Just mempty
+    | Just (x :: EpAnn (AnnList (EpToken "hiding", [EpToken ","]))) <- cast x = Just mempty
     | Just (x :: EpAnn AnnListItem) <- cast x = Just mempty
     | Just (x :: EpAnn AnnParen) <- cast x = Just mempty
     | Just (x :: EpAnn AnnPragma) <- cast x = Just mempty
@@ -135,18 +138,33 @@ unify' nm root x y
     | Just (x :: EpAnn HsRuleAnn) <- cast x = Just mempty
     | Just (x :: EpAnn NameAnn) <- cast x = Just mempty
     | Just (x :: EpAnn NoEpAnns) <- cast x = Just mempty
-    | Just (x :: EpAnn [AddEpAnn]) <- cast x = Just mempty
-    | Just (x :: EpAnn (AddEpAnn, AddEpAnn)) <- cast x = Just mempty
-    | Just (x :: EpToken "let") <- cast x = Just mempty
-    | Just (x :: EpToken "in") <- cast x = Just mempty
-    | Just (x :: EpToken "@") <- cast x = Just mempty
+    | Just (x :: EpToken "|") <- cast x = Just mempty
+    | Just (x :: EpToken ",") <- cast x = Just mempty
+    | Just (x :: EpToken ";") <- cast x = Just mempty
+    | Just (x :: EpToken "`") <- cast x = Just mempty
+    | Just (x :: EpToken ".") <- cast x = Just mempty
+    | Just (x :: EpToken "\\") <- cast x = Just mempty
     | Just (x :: EpToken "(") <- cast x = Just mempty
     | Just (x :: EpToken ")") <- cast x = Just mempty
+    | Just (x :: EpToken "@") <- cast x = Just mempty
+    | Just (x :: EpToken "#-}") <- cast x = Just mempty
+    | Just (x :: EpToken "if") <- cast x = Just mempty
+    | Just (x :: EpToken "then") <- cast x = Just mempty
+    | Just (x :: EpToken "else") <- cast x = Just mempty
+    | Just (x :: EpToken "case") <- cast x = Just mempty
+    | Just (x :: EpToken "of") <- cast x = Just mempty
+    | Just (x :: EpToken "in") <- cast x = Just mempty
     | Just (x :: EpToken "type") <- cast x = Just mempty
     | Just (x :: EpToken "%") <- cast x = Just mempty
     | Just (x :: EpToken "%1") <- cast x = Just mempty
-    | Just (x :: EpToken "⊸") <- cast x = Just mempty
+    | Just (x :: EpToken "proc") <- cast x = Just mempty
+    | Just (x :: EpToken "static") <- cast x = Just mempty
+    | Just (x :: EpToken "qualified") <- cast x = Just mempty
+    | Just (x :: EpToken "safe") <- cast x = Just mempty
+    | Just (x :: EpToken "as") <- cast x = Just mempty
+    | Just (x :: EpToken "import") <- cast x = Just mempty
     | Just (x :: EpUniToken "->" "→") <- cast x = Just mempty
+    | Just (x :: EpUniToken "::" "∷") <- cast x = Just mempty
     | Just (x :: TokenLocation) <- cast y = Just mempty
     | Just (y :: SrcSpan) <- cast y = Just mempty
 

src/Hint/Comment.hs

@@ -46,7 +46,7 @@ commentHint _ m = concatMap chk (ghcComments m)
         grab :: String -> LEpaComment -> String -> Idea
         grab msg o@(L pos _) s2 =
           let s1 = commentText o
-              loc = RealSrcSpan (anchor pos) GHC.Data.Strict.Nothing
+              loc = RealSrcSpan (epaLocationRealSrcSpan pos) GHC.Data.Strict.Nothing
           in
           rawIdea Suggestion msg loc (f s1) (Just $ f s2) [] (refact loc)
             where f s = if isCommentMultiline o then "{-" ++ s ++ "-}" else "--" ++ s

src/Hint/Extensions.hs

@@ -301,7 +301,7 @@ extensionsHint :: ModuHint
 extensionsHint _ x =
     [
         rawIdea Hint.Type.Warning "Unused LANGUAGE pragma"
-        (RealSrcSpan (anchor sl) GHC.Data.Strict.Nothing)
+        (RealSrcSpan (epaLocationRealSrcSpan sl) GHC.Data.Strict.Nothing)
         (comment_ (mkLanguagePragmas sl exts))
         (Just newPragma)
         ( [RequiresExtension (show gone) | (_, Just x) <- before \\ after, gone <- Map.findWithDefault [] x disappear] ++

src/Hint/Pattern.hs

@@ -69,7 +69,7 @@ import Data.Either
 import Refact.Types hiding (RType(Pattern, Match), SrcSpan)
 import Refact.Types qualified as R (RType(Pattern, Match), SrcSpan)
 
-import GHC.Hs
+import GHC.Hs hiding (asPattern)
 import GHC.Types.SrcLoc
 import GHC.Types.Name.Reader
 import GHC.Types.Name.Occurrence