diff --git a/src/Config/Haskell.hs b/src/Config/Haskell.hs index dd79af99..2be9201e 100644 --- a/src/Config/Haskell.hs +++ b/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 "") diff --git a/src/GHC/Util/ApiAnnotation.hs b/src/GHC/Util/ApiAnnotation.hs index 5497e4c9..d613e40d 100644 --- a/src/GHC/Util/ApiAnnotation.hs +++ b/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) diff --git a/src/GHC/Util/Brackets.hs b/src/GHC/Util/Brackets.hs index c3f27c8a..e543a7fd 100644 --- a/src/GHC/Util/Brackets.hs +++ b/src/GHC/Util/Brackets.hs @@ -59,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 @@ -131,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 diff --git a/src/GHC/Util/SrcLoc.hs b/src/GHC/Util/SrcLoc.hs index de3942d6..84b4c0e0 100644 --- a/src/GHC/Util/SrcLoc.hs +++ b/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'. diff --git a/src/GHC/Util/Unify.hs b/src/GHC/Util/Unify.hs index d83aa0cf..db44b74c 100644 --- a/src/GHC/Util/Unify.hs +++ b/src/GHC/Util/Unify.hs @@ -120,6 +120,9 @@ unify' nm root x y | Just (x :: EpAnn AnnExplicitSum) <- cast x = Just mempty | Just (x :: EpAnn AnnFieldLabel) <- 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 diff --git a/src/Hint/Comment.hs b/src/Hint/Comment.hs index b66c632a..b8ae2be7 100644 --- a/src/Hint/Comment.hs +++ b/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 diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs index a8577ec0..a2f6ddf3 100644 --- a/src/Hint/Extensions.hs +++ b/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] ++ diff --git a/src/Hint/Pattern.hs b/src/Hint/Pattern.hs index 1b642547..8da7b0d2 100644 --- a/src/Hint/Pattern.hs +++ b/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 hiding(asPattern) +import GHC.Hs hiding (asPattern) import GHC.Types.SrcLoc import GHC.Types.Name.Reader import GHC.Types.Name.Occurrence