From 09b1c66fee53b2b3211e6dd25c62865ca93833d0 Mon Sep 17 00:00:00 2001 From: Tom Ellis Date: Sat, 1 Jun 2024 08:54:16 +0100 Subject: [PATCH] Support GHC 9.10 Thanks to @philderbeast --- src/Stan/Ghc/Compat.hs | 2 ++ src/Stan/Ghc/Compat906.hs | 2 +- src/Stan/Hie/Compat.hs | 2 ++ src/Stan/Hie/Compat904.hs | 2 +- src/Stan/Hie/Debug.hs | 2 ++ src/Stan/Hie/Debug908.hs | 2 +- src/Stan/Inspection/AntiPattern.hs | 31 ++++++++++++++---- src/Stan/Inspection/Partial.hs | 33 +++++++++++++++---- src/Stan/NameMeta.hs | 40 +++++++++++++++++++++-- src/Stan/Pattern/Ast.hs | 8 ++++- src/Stan/Pattern/Type.hs | 52 +++++++++++++++++++++++++----- stan.cabal | 10 +++--- 12 files changed, 153 insertions(+), 33 deletions(-) diff --git a/src/Stan/Ghc/Compat.hs b/src/Stan/Ghc/Compat.hs index 9e65b99f..d3e24ba3 100644 --- a/src/Stan/Ghc/Compat.hs +++ b/src/Stan/Ghc/Compat.hs @@ -14,4 +14,6 @@ import Stan.Ghc.Compat902 as Compat import Stan.Ghc.Compat906 as Compat #elif __GLASGOW_HASKELL__ == 908 import Stan.Ghc.Compat906 as Compat +#elif __GLASGOW_HASKELL__ == 910 +import Stan.Ghc.Compat906 as Compat #endif diff --git a/src/Stan/Ghc/Compat906.hs b/src/Stan/Ghc/Compat906.hs index b438ca57..28b185ca 100644 --- a/src/Stan/Ghc/Compat906.hs +++ b/src/Stan/Ghc/Compat906.hs @@ -4,7 +4,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Stan.Ghc.Compat906 -#if __GLASGOW_HASKELL__ == 906 || __GLASGOW_HASKELL__ == 908 +#if __GLASGOW_HASKELL__ == 906 || __GLASGOW_HASKELL__ == 908 || __GLASGOW_HASKELL__ == 910 ( -- * Modules Module , ModuleName diff --git a/src/Stan/Hie/Compat.hs b/src/Stan/Hie/Compat.hs index f2cbcdcc..d3bf0a8a 100644 --- a/src/Stan/Hie/Compat.hs +++ b/src/Stan/Hie/Compat.hs @@ -14,4 +14,6 @@ import Stan.Hie.Compat904 as Compat import Stan.Hie.Compat904 as Compat #elif __GLASGOW_HASKELL__ == 908 import Stan.Hie.Compat904 as Compat +#elif __GLASGOW_HASKELL__ == 910 +import Stan.Hie.Compat904 as Compat #endif diff --git a/src/Stan/Hie/Compat904.hs b/src/Stan/Hie/Compat904.hs index f0dd6cdf..625e1824 100644 --- a/src/Stan/Hie/Compat904.hs +++ b/src/Stan/Hie/Compat904.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} module Stan.Hie.Compat904 -#if __GLASGOW_HASKELL__ == 904 || __GLASGOW_HASKELL__ == 906 || __GLASGOW_HASKELL__ == 908 +#if __GLASGOW_HASKELL__ == 904 || __GLASGOW_HASKELL__ == 906 || __GLASGOW_HASKELL__ == 908 || __GLASGOW_HASKELL__== 910 ( -- * Main HIE types ContextInfo (..) , HieArgs (..) diff --git a/src/Stan/Hie/Debug.hs b/src/Stan/Hie/Debug.hs index 2ead6bb3..dce1b9c8 100644 --- a/src/Stan/Hie/Debug.hs +++ b/src/Stan/Hie/Debug.hs @@ -14,4 +14,6 @@ import Stan.Hie.Debug902 as Compat import Stan.Hie.Debug902 as Compat #elif __GLASGOW_HASKELL__ == 908 import Stan.Hie.Debug908 as Compat +#elif __GLASGOW_HASKELL__ == 910 +import Stan.Hie.Debug908 as Compat #endif diff --git a/src/Stan/Hie/Debug908.hs b/src/Stan/Hie/Debug908.hs index 062691ca..b8f97b67 100644 --- a/src/Stan/Hie/Debug908.hs +++ b/src/Stan/Hie/Debug908.hs @@ -21,7 +21,7 @@ package to dependencies and use the @pPrint@ function from the -} module Stan.Hie.Debug908 -#if __GLASGOW_HASKELL__ == 908 +#if __GLASGOW_HASKELL__ == 908 || __GLASGOW_HASKELL__ == 910 ( debugHieFile ) where diff --git a/src/Stan/Inspection/AntiPattern.hs b/src/Stan/Inspection/AntiPattern.hs index 2f63202a..8009cc01 100644 --- a/src/Stan/Inspection/AntiPattern.hs +++ b/src/Stan/Inspection/AntiPattern.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {- | Copyright: (c) 2020 Kowainik SPDX-License-Identifier: MPL-2.0 @@ -55,7 +57,7 @@ import Stan.Core.Id (Id (..)) import Stan.Inspection (Inspection (..), InspectionAnalysis (..), InspectionsMap, categoryL, descriptionL, severityL, solutionL) import Stan.NameMeta (NameMeta (..), baseNameFrom, mkBaseFoldableMeta, mkBaseOldListMeta, - primTypeMeta, textNameFrom, unorderedNameFrom) + primTypeMeta, textNameFrom, unorderedNameFrom, _nameFrom) import Stan.Pattern.Ast (Literal (..), PatternAst (..), anyNamesToPatternAst, app, namesToPatternAst, opApp, range) import Stan.Pattern.Edsl (PatternBool (..)) @@ -327,7 +329,13 @@ filepathOperator = PatternAstName operatorPosix fun This is odd and needs more investigation. -} filePathType :: PatternType - filePathType = "FilePath" `baseNameFrom` "GHC.IO" |:: [] + filePathType = +#if __GLASGOW_HASKELL__ < 910 + "FilePath" `_nameFrom` "GHC.IO" +#else + "FilePath" `_nameFrom` "GHC.Internal.IO" +#endif + |:: [] ||| stringPattern ||| primTypeMeta "[]" |:: [ charPattern ] @@ -345,14 +353,23 @@ stan0212 = mkAntiPatternInspection (Id "STAN-0212") "unsafe functions" (FindAst where pat :: PatternAst pat = anyNamesToPatternAst - $ "undefined" `baseNameFrom` "GHC.Err" :| - [ "unsafeCoerce" `baseNameFrom` "Unsafe.Coerce" - , "unsafePerformIO" `baseNameFrom` "GHC.IO.Unsafe" - , "unsafeInterleaveIO" `baseNameFrom` "GHC.IO.Unsafe" - , "unsafeDupablePerformIO" `baseNameFrom` "GHC.IO.Unsafe" +#if __GLASGOW_HASKELL__ < 910 + $ "undefined" `_nameFrom` "GHC.Err" :| + [ "unsafeCoerce" `_nameFrom` "Unsafe.Coerce" + , "unsafePerformIO" `_nameFrom` "GHC.IO.Unsafe" + , "unsafeInterleaveIO" `_nameFrom` "GHC.IO.Unsafe" + , "unsafeDupablePerformIO" `_nameFrom` "GHC.IO.Unsafe" +#else + $ "undefined" `_nameFrom` "GHC.Internal.Err" :| + [ "unsafeCoerce" `_nameFrom` "GHC.Internal.Unsafe.Coerce" + , "unsafePerformIO" `_nameFrom` "GHC.Internal.IO.Unsafe" + , "unsafeInterleaveIO" `_nameFrom` "GHC.Internal.IO.Unsafe" + , "unsafeDupablePerformIO" `_nameFrom` "GHC.Internal.IO.Unsafe" +#endif , "unsafeFixIO" `baseNameFrom` "System.IO.Unsafe" ] + -- | 'Inspection' — Pattent matching on @_@ for sum types — @STAN-0213@. stan0213 :: Inspection stan0213 = mkAntiPatternInspection (Id "STAN-0213") "Pattern matching on '_'" PatternMatchOn_ diff --git a/src/Stan/Inspection/Partial.hs b/src/Stan/Inspection/Partial.hs index c5490b33..6d5c9376 100644 --- a/src/Stan/Inspection/Partial.hs +++ b/src/Stan/Inspection/Partial.hs @@ -69,7 +69,7 @@ import Stan.Core.Id (Id (..)) import Stan.Inspection (Inspection (..), InspectionAnalysis (..), InspectionsMap, analysisL, categoryL, descriptionL, solutionL) import Stan.NameMeta (NameMeta (..), baseNameFrom, mkBaseFoldableMeta, mkBaseListMeta, - mkBaseOldListMeta) + mkBaseOldListMeta, _nameFrom) import Stan.Pattern.Ast (PatternAst (PatternAstName), namesToPatternAst) import Stan.Pattern.Edsl (PatternBool (..)) import Stan.Pattern.Type (PatternType (..), integerPattern, listFunPattern, listPattern, @@ -156,7 +156,12 @@ mkPartialInspectionEnum insId funName pat solution = & solutionL .~ solution where enumMeta :: NameMeta - enumMeta = funName `baseNameFrom` "GHC.Enum" + enumMeta = +#if __GLASGOW_HASKELL__ < 910 + funName `_nameFrom` "GHC.Enum" +#else + funName `_nameFrom` "GHC.Internal.Enum" +#endif -- | 'Inspection' — partial 'GHC.List.head' @STAN-0001@. stan0001 :: Inspection @@ -197,7 +202,12 @@ stan0008 = mkPartialInspection (Id "STAN-0008") fromJustNameMeta "'Maybe'" ] where fromJustNameMeta :: NameMeta - fromJustNameMeta = "fromJust" `baseNameFrom` "Data.Maybe" + fromJustNameMeta = +#if __GLASGOW_HASKELL__ < 910 + "fromJust" `_nameFrom` "Data.Maybe" +#else + "fromJust" `_nameFrom` "GHC.Internal.Data.Maybe" +#endif -- | 'Inspection' — partial 'Text.Read.read' @STAN-0009@. stan0009 :: Inspection @@ -208,7 +218,12 @@ stan0009 = mkPartialInspection (Id "STAN-0009") readNameMeta "" ] where readNameMeta :: NameMeta - readNameMeta = "read" `baseNameFrom` "Text.Read" + readNameMeta = +#if __GLASGOW_HASKELL__ < 910 + "read" `_nameFrom` "Text.Read" +#else + "read" `_nameFrom` "GHC.Internal.Text.Read" +#endif -- | 'Inspection' — partial 'GHC.Enum.succ' @STAN-0010@. stan0010 :: Inspection @@ -281,8 +296,10 @@ stan0020 = mkPartialInspectionPattern (Id "STAN-0020") exts pat "" pat = listPattern |-> nonEmptyPattern #if __GLASGOW_HASKELL__ < 904 exts = "fromList" `baseNameFrom` "GHC.Exts" -#else +#elif __GLASGOW_HASKELL__ < 910 exts = "fromList" `baseNameFrom` "GHC.IsList" +#else + exts = "fromList" `_nameFrom` "GHC.Internal.IsList" #endif ne = "fromList" `baseNameFrom` "Data.List.NonEmpty" @@ -290,6 +307,10 @@ stan0020 = mkPartialInspectionPattern (Id "STAN-0020") exts pat "" stan0021 :: Inspection stan0021 = mkPartialInspectionPattern (Id "STAN-0021") - ("fromInteger" `baseNameFrom` "GHC.Num") +#if __GLASGOW_HASKELL__ < 910 + ("fromInteger" `_nameFrom` "GHC.Num") +#else + ("fromInteger" `_nameFrom` "GHC.Internal.Num") +#endif (integerPattern |-> naturalPattern) "" diff --git a/src/Stan/NameMeta.hs b/src/Stan/NameMeta.hs index 34ff63c6..a8a8b0b9 100644 --- a/src/Stan/NameMeta.hs +++ b/src/Stan/NameMeta.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {- | Copyright: (c) 2020 Kowainik SPDX-License-Identifier: MPL-2.0 @@ -19,6 +21,8 @@ module Stan.NameMeta -- * Smart constructors , baseNameFrom + , ghcInternalNameFrom + , _nameFrom , mkBaseListMeta , mkBaseOldListMeta , mkBaseFoldableMeta @@ -126,23 +130,53 @@ baseNameFrom funName moduleName = NameMeta , nameMetaPackage = "base" } +infix 8 `ghcInternalNameFrom` +ghcInternalNameFrom :: Text -> ModuleName -> NameMeta +ghcInternalNameFrom funName moduleName = NameMeta + { nameMetaName = funName + , nameMetaModuleName = moduleName + , nameMetaPackage = "ghc-internal" + } + +_nameFrom :: Text -> ModuleName -> NameMeta +#if __GLASGOW_HASKELL__ < 910 +_nameFrom = baseNameFrom +#else +_nameFrom = ghcInternalNameFrom +#endif + {- | Create 'NameMeta' for a function from the @base@ package and the "GHC.List" module. -} mkBaseListMeta :: Text -> NameMeta -mkBaseListMeta = (`baseNameFrom` "GHC.List") +mkBaseListMeta = +#if __GLASGOW_HASKELL__ < 910 + (`_nameFrom` "GHC.List") +#else + (`_nameFrom` "GHC.Internal.List") +#endif {- | Create 'NameMeta' for a function from the @base@ package and the "Data.OldList" module. -} mkBaseOldListMeta :: Text -> NameMeta -mkBaseOldListMeta = (`baseNameFrom` "Data.OldList") +mkBaseOldListMeta = +#if __GLASGOW_HASKELL__ < 910 + (`_nameFrom` "Data.OldList") +#else + (`_nameFrom` "GHC.Internal.Data.OldList") +#endif {- | Create 'NameMeta' for a function from the @base@ package and the "Data.Foldable" module. -} mkBaseFoldableMeta :: Text -> NameMeta -mkBaseFoldableMeta = (`baseNameFrom` "Data.Foldable") +mkBaseFoldableMeta = +#if __GLASGOW_HASKELL__ < 910 + (`_nameFrom` "Data.Foldable") +#else + (`_nameFrom` "GHC.Internal.Data.Foldable") +#endif {- | Create 'NameMeta' for a function from the @unordered-containers@ package and a given 'ModuleName' module. diff --git a/src/Stan/Pattern/Ast.hs b/src/Stan/Pattern/Ast.hs index 1968ada3..7cbf28b4 100644 --- a/src/Stan/Pattern/Ast.hs +++ b/src/Stan/Pattern/Ast.hs @@ -135,7 +135,13 @@ range from to = PatternAstNodeExact (one (mkNodeAnnotation "ArithSeq" "HsExpr")) -- | 'lambdaCase' is a pattern for @\case@ expression (not considering branches). lambdaCase :: PatternAst -lambdaCase = PatternAstNode (one (mkNodeAnnotation "HsLamCase" "HsExpr")) +lambdaCase = PatternAstNode (one (mkNodeAnnotation +#if __GLASGOW_HASKELL__ < 910 + "HsLamCase" +#else + "HsLam" +#endif + "HsExpr")) -- | 'case'' is a pattern for @case EXP of@ expression (not considering branches). case' :: PatternAst diff --git a/src/Stan/Pattern/Type.hs b/src/Stan/Pattern/Type.hs index c46bafce..7ebd539b 100644 --- a/src/Stan/Pattern/Type.hs +++ b/src/Stan/Pattern/Type.hs @@ -35,7 +35,7 @@ module Stan.Pattern.Type , foldableMethodsPatterns ) where -import Stan.NameMeta (NameMeta (..), baseNameFrom, ghcPrimNameFrom, primTypeMeta, textNameFrom) +import Stan.NameMeta (NameMeta (..), baseNameFrom, ghcPrimNameFrom, primTypeMeta, textNameFrom, _nameFrom) import Stan.Pattern.Edsl (PatternBool (..)) @@ -94,7 +94,12 @@ listPattern :: PatternType listPattern = listNameMeta |:: [ (?) ] ||| - "String" `baseNameFrom` "GHC.Base" |:: [] +#if __GLASGOW_HASKELL__ >= 910 + "String" `_nameFrom` "GHC.Internal.Base" +#else + "String" `_nameFrom` "GHC.Base" +#endif + |:: [] where listNameMeta :: NameMeta #if __GLASGOW_HASKELL__ < 906 @@ -105,7 +110,13 @@ listPattern = -- | 'PatternType' for 'NonEmpty'. nonEmptyPattern :: PatternType -nonEmptyPattern = "NonEmpty" `baseNameFrom` "GHC.Base" |:: [ (?) ] +nonEmptyPattern = +#if __GLASGOW_HASKELL__ >= 910 + "NonEmpty" `_nameFrom` "GHC.Internal.Base" +#else + "NonEmpty" `_nameFrom` "GHC.Base" +#endif + |:: [ (?) ] -- | 'PatternType' for @[a] -> _@ or @String -> _@. listFunPattern :: PatternType @@ -152,7 +163,13 @@ charPattern = primTypeMeta "Char" |:: [] -- | 'PatternType' for 'String'. stringPattern :: PatternType -stringPattern = "String" `baseNameFrom` "GHC.Base" |:: [] +stringPattern = +#if __GLASGOW_HASKELL__ >= 910 + "String" `_nameFrom` "GHC.Internal.Base" +#else + "String" `_nameFrom` "GHC.Base" +#endif + |:: [] -- | 'PatternType' for 'Text'. textPattern :: PatternType @@ -168,11 +185,23 @@ foldableTypesPatterns = maybePattern :| [eitherPattern, pairPattern] -- | 'PatternType' for 'Maybe' maybePattern :: PatternType -maybePattern = "Maybe" `baseNameFrom` "GHC.Maybe" |:: [ (?) ] +maybePattern = +#if __GLASGOW_HASKELL__ >= 910 + "Maybe" `_nameFrom` "GHC.Internal.Maybe" +#else + "Maybe" `_nameFrom` "GHC.Maybe" +#endif + |:: [ (?) ] -- | 'PatternType' for 'Either' eitherPattern :: PatternType -eitherPattern = "Either" `baseNameFrom` "Data.Either" |:: [ (?), (?) ] +eitherPattern = +#if __GLASGOW_HASKELL__ >= 910 + "Either" `_nameFrom` "GHC.Internal.Data.Either" +#else + "Either" `_nameFrom` "Data.Either" +#endif + |:: [ (?), (?) ] -- | 'PatternType' for pair @(,)@. pairPattern :: PatternType @@ -184,8 +213,10 @@ pairPattern = "Tuple2" `ghcPrimNameFrom` ghcTuple |:: [ (?), (?) ] where #if __GLASGOW_HASKELL__ < 906 ghcTuple = "GHC.Tuple" -#elif __GLASGOW_HASKELL__ >= 906 +#elif __GLASGOW_HASKELL__ < 910 ghcTuple = "GHC.Tuple.Prim" +#else + ghcTuple = "GHC.Tuple" #endif {- | Type patterns for the 'Foldable' typeclass methods. Represented @@ -220,4 +251,9 @@ foldableMethodsPatterns = ofType = (,) method :: Text -> NameMeta - method name = name `baseNameFrom` "Data.Foldable" + method name = +#if __GLASGOW_HASKELL__ >= 910 + name `_nameFrom` "GHC.Internal.Data.Foldable" +#else + name `_nameFrom` "Data.Foldable" +#endif diff --git a/stan.cabal b/stan.cabal index 68921b04..8b3debbe 100644 --- a/stan.cabal +++ b/stan.cabal @@ -30,7 +30,7 @@ source-repository head location: https://github.com/kowainik/stan.git common common-options - build-depends: base >= 4.13 && < 4.20 && (< 4.16.3.0 || >= 4.17) + build-depends: base >= 4.13 && < 4.21 && (< 4.16.3.0 || >= 4.17) -- ^^ .hie files don't contain enough type -- information on ghc-9.2.[4-8] (base >= -- 4.16.3.0 && < 4.17) @@ -143,14 +143,14 @@ library , bytestring >= 0.10 && < 0.13 , clay >= 0.14 && < 0.16 , colourista >= 0.1 && < 0.3 - , containers >= 0.5 && < 0.7 + , containers >= 0.5 && < 0.8 , cryptohash-sha1 ^>= 0.11 , dir-traverse ^>= 0.2.2.2 , directory ^>= 1.3 , extensions ^>= 0.0.0.1 || ^>= 0.1.0.0 - , filepath ^>= 1.4 - , ghc >= 8.8 && < 9.9 - , ghc-boot-th >= 8.8 && < 9.9 + , filepath >= 1.4 && < 1.6 + , ghc >= 8.8 && < 9.11 + , ghc-boot-th >= 8.8 && < 9.11 , gitrev ^>= 1.3.1 , microaeson ^>= 0.1.0.0 , optparse-applicative >= 0.15 && < 0.19