GHC 9.10

CHANGELOG.md

@@ -3,6 +3,12 @@
 `stan` uses [PVP Versioning][1].
 The change log is available [on GitHub][2].
 
+## 0.1.3.0
+
+* Add prospective support for GHC 9.10
+
+  * thanks to @philderbeast
+
 ## 0.1.2.1
 
 * Support `clay-0.15` series.

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

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

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

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 (..)

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

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
 

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_

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,15 +296,21 @@ 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"
 
 -- | 'Inspection' — partial 'GHC.Num.fromInteger' @STAN-0021@.
 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)
     ""

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.

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

src/Stan/Pattern/Type.hs

@@ -1,4 +1,4 @@
-{-# LANGuAGE CPP #-}
+{-# LANGUAGE CPP #-}
 
 {- HLINT ignore "Avoid lambda using `infix`" -}
 
@@ -35,7 +35,7 @@
     , 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 =
     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 @@
 
 -- | '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 @@
 
 -- | '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 @@
 
 -- | '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 @@
   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 @@
     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