Support up to and including GHC 9.4

kowainik · Sep 1, 2023 · 75a1dd6 · 75a1dd6
1 parent 72dda7c
commit 75a1dd6
Show file tree

Hide file tree

Showing 31 changed files with 1,122 additions and 273 deletions.
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
@@ -14,12 +14,22 @@ jobs:
     name: ${{ matrix.os }} / ghc ${{ matrix.ghc }}
     runs-on: ${{ matrix.os }}
     strategy:
+      fail-fast: false
       matrix:
         os: [ubuntu-latest, macOS-latest, windows-latest]
-        cabal: ["3.2"]
+        cabal: ["3.8"]
         ghc:
           - "8.8.4"
           - "8.10.4"
+          - "9.0.1"
+          - "9.0.2"
+          - "9.2.1"
+          - "9.4.1"
+          - "9.4.2"
+          - "9.4.4"
+          - "9.4.5"
+          - "9.4.6"
+          - "9.4.7"
         exclude:
           - os: macOS-latest
             ghc: 8.8.4
@@ -28,13 +38,17 @@ jobs:
     steps:
     - uses: actions/checkout@v3
 
-    - uses: haskell/actions/setup@v2.0.1
+    - uses: haskell/actions/setup@v2.4.6
       id: setup-haskell-cabal
       name: Setup Haskell
       with:
         ghc-version: ${{ matrix.ghc }}
         cabal-version: ${{ matrix.cabal }}
 
+    - name: Configure
+      run: |
+        cabal configure --enable-tests --enable-benchmarks --test-show-details=direct
+
     - name: Freeze
       run: |
         cabal freeze
@@ -47,7 +61,6 @@ jobs:
 
     - name: Build
       run: |
-        cabal configure --enable-tests --enable-benchmarks --test-show-details=direct
         cabal build all
 
     - name: Test
@@ -108,7 +121,7 @@ jobs:
 
     - name: Run HLint
       env:
-         HLINT_VERSION: "3.2.7"
+         HLINT_VERSION: "3.6.1"
       run: |
         curl https://raw.githubusercontent.com/kowainik/relude/v1.0.0.1/.hlint.yaml -o .hlint-relude.yaml
 

diff --git a/src/Stan/Analysis/Analyser.hs b/src/Stan/Analysis/Analyser.hs
@@ -22,7 +22,7 @@ import Stan.Core.List (nonRepeatingPairs)
 import Stan.FileInfo (isExtensionDisabled)
 import Stan.Ghc.Compat (RealSrcSpan, isSymOcc, nameOccName, occNameString)
 import Stan.Hie (eqAst)
-import Stan.Hie.Compat (HieAST (..), HieFile (..), Identifier, NodeInfo (..), TypeIndex)
+import Stan.Hie.Compat (HieAST (..), HieFile (..), Identifier, NodeInfo (..), TypeIndex, nodeInfo)
 import Stan.Hie.MatchAst (hieMatchPatternAst)
 import Stan.Inspection (Inspection (..), InspectionAnalysis (..))
 import Stan.NameMeta (NameMeta, ghcPrimNameFrom)
@@ -331,10 +331,10 @@ analyseInfix hie curNode = do
         Right name -> [toText $ occNameString $ nameOccName name]
 
     extractOperatorName :: HieAST TypeIndex -> [(Text, RealSrcSpan)]
-    extractOperatorName Node{..} =
+    extractOperatorName n@Node{..} =
         concatMap (topLevelOperatorName nodeSpan)
         $ Map.keys
-        $ nodeIdentifiers nodeInfo
+        $ nodeIdentifiers (Stan.Hie.Compat.nodeInfo n)
 
     topLevelOperatorName :: RealSrcSpan -> Identifier -> [(Text, RealSrcSpan)]
     topLevelOperatorName srcSpan = \case

diff --git a/src/Stan/Ghc/Compat.hs b/src/Stan/Ghc/Compat.hs
@@ -1,59 +1,13 @@
-{- |
-Copyright: (c) 2020 Kowainik
-SPDX-License-Identifier: MPL-2.0
-Maintainer: Kowainik <xrom.xkov@gmail.com>
-
-Compatibility module for GHC types and functions. Reexports all
-required API to work with the GHC API.
--}
-
-module Stan.Ghc.Compat
-    ( -- * Modules
-      Module
-    , ModuleName
-    , moduleNameString
-    , moduleName
-    , moduleStableString
-    , moduleUnitId
-
-      -- * Names
-    , Name
-    , isExternalName
-    , isSymOcc
-    , nameModule
-    , nameOccName
-    , nameStableString
-    , occNameString
-
-      -- * Source locations
-    , RealSrcSpan
-    , srcSpanEndCol
-    , srcSpanStartCol
-    , srcSpanStartLine
-    , srcSpanEndLine
-    , srcSpanFile
-
-      -- * Other common types (for debugging and not only)
-    , ArgFlag (..)
-    , AvailInfo (..)
-    , FastString
-    , FieldLbl (..)
-    , IfaceTyCon (..)
-    , IfaceTyConInfo (..)
-    , IfaceTyConSort (..)
-    , IfaceTyLit (..)
-    , PromotionFlag (..)
-    , TupleSort (..)
-    ) where
-
-import Avail (AvailInfo (..))
-import BasicTypes (PromotionFlag (..), TupleSort (..))
-import FastString (FastString)
-import FieldLabel (FieldLbl (..))
-import IfaceType (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..))
-import Module (Module, ModuleName, moduleName, moduleNameString, moduleStableString, moduleUnitId)
-import Name (Name, isExternalName, nameModule, nameOccName, nameStableString)
-import OccName (isSymOcc, occNameString)
-import SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,
-               srcSpanStartLine)
-import Var (ArgFlag (..))
+{-# LANGUAGE CPP #-}
+
+module Stan.Ghc.Compat (module Compat) where
+
+#if __GLASGOW_HASKELL__ <= 810
+import Stan.Ghc.Compat810 as Compat
+#elif __GLASGOW_HASKELL__ == 900
+import Stan.Ghc.Compat900 as Compat
+#elif __GLASGOW_HASKELL__ == 902
+import Stan.Ghc.Compat902 as Compat
+#elif __GLASGOW_HASKELL__ == 904
+import Stan.Ghc.Compat902 as Compat
+#endif
diff --git a/src/Stan/Ghc/Compat810.hs b/src/Stan/Ghc/Compat810.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE CPP #-}
+
+{- |
+Copyright: (c) 2020 Kowainik
+SPDX-License-Identifier: MPL-2.0
+Maintainer: Kowainik <xrom.xkov@gmail.com>
+
+Compatibility module for GHC types and functions. Reexports all
+required API to work with the GHC API.
+-}
+
+module Stan.Ghc.Compat810
+#if __GLASGOW_HASKELL__ <= 810
+    ( -- * Modules
+      Module
+    , ModuleName
+    , moduleNameString
+    , moduleName
+    , moduleStableString
+    , moduleUnitId
+
+      -- * Names
+    , Name
+    , isExternalName
+    , isSymOcc
+    , nameModule
+    , nameOccName
+    , nameStableString
+    , occNameString
+
+      -- * Source locations
+    , RealSrcSpan
+    , srcSpanEndCol
+    , srcSpanStartCol
+    , srcSpanStartLine
+    , srcSpanEndLine
+    , srcSpanFile
+    , mkRealSrcLoc
+    , mkRealSrcSpan
+
+      -- * Other common types (for debugging and not only)
+    , ArgFlag (..)
+    , AvailInfo (..)
+    , FastString
+    , mkFastString
+    , FieldLbl (..)
+    , IfaceTyCon (..)
+    , IfaceTyConInfo (..)
+    , IfaceTyConSort (..)
+    , IfaceTyLit (..)
+    , PromotionFlag (..)
+    , TupleSort (..)
+    , showTUnitId
+    ) where
+
+import Avail (AvailInfo (..))
+import BasicTypes (PromotionFlag (..), TupleSort (..))
+import FastString (FastString, mkFastString)
+import FieldLabel (FieldLbl (..))
+import IfaceType (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..))
+import Module (Module, ModuleName, moduleName, moduleNameString, moduleStableString, moduleUnitId,
+               UnitId, unitIdString)
+import Name (Name, isExternalName, nameModule, nameOccName, nameStableString)
+import OccName (isSymOcc, occNameString)
+import SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,
+               srcSpanStartLine, mkRealSrcLoc, mkRealSrcSpan)
+import Var (ArgFlag (..))
+
+import qualified Data.Text as T
+
+showTUnitId :: UnitId -> Text
+showTUnitId = T.pack . unitIdString
+#else
+  where
+#endif
diff --git a/src/Stan/Ghc/Compat900.hs b/src/Stan/Ghc/Compat900.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE CPP #-}
+
+{- |
+Copyright: (c) 2020 Kowainik
+SPDX-License-Identifier: MPL-2.0
+Maintainer: Kowainik <xrom.xkov@gmail.com>
+
+Compatibility module for GHC types and functions. Reexports all
+required API to work with the GHC API.
+-}
+
+module Stan.Ghc.Compat900
+#if __GLASGOW_HASKELL__ == 900
+    ( -- * Modules
+      Module
+    , ModuleName
+    , moduleNameString
+    , moduleName
+    , moduleStableString
+    , moduleUnitId
+
+      -- * Names
+    , Name
+    , isExternalName
+    , isSymOcc
+    , nameModule
+    , nameOccName
+    , nameStableString
+    , occNameString
+
+      -- * Source locations
+    , RealSrcSpan
+    , srcSpanEndCol
+    , srcSpanStartCol
+    , srcSpanStartLine
+    , srcSpanEndLine
+    , srcSpanFile
+    , mkRealSrcLoc
+    , mkRealSrcSpan
+
+      -- * Other common types (for debugging and not only)
+    , ArgFlag (..)
+    , AvailInfo (..)
+    , FastString
+    , mkFastString
+    , FieldLbl (..)
+    , IfaceTyCon (..)
+    , IfaceTyConInfo (..)
+    , IfaceTyConSort (..)
+    , IfaceTyLit (..)
+    , PromotionFlag (..)
+    , TupleSort (..)
+    , showTUnitId
+    ) where
+
+import GHC.Types.Avail (AvailInfo (..))
+import GHC.Types.Basic (PromotionFlag (..), TupleSort (..))
+import GHC.Data.FastString (FastString, mkFastString)
+import GHC.Types.FieldLabel (FieldLbl (..))
+import GHC.Iface.Type (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..))
+import GHC.Unit.Types (Module, moduleName)
+import GHC.Unit.Module (moduleStableString)
+import GHC.Unit (moduleUnit, toUnitId, UnitId, unitIdString)
+import GHC.Unit.Module.Name (ModuleName, moduleNameString)
+import GHC.Types.Name (Name, isExternalName, nameModule, nameOccName, nameStableString)
+import GHC.Types.Name.Occurrence (isSymOcc, occNameString)
+import GHC.Types.SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,
+                         srcSpanStartLine, mkRealSrcSpan, mkRealSrcLoc)
+import GHC.Types.Var (ArgFlag (..))
+
+import qualified Data.Text as T
+
+moduleUnitId :: Module -> UnitId
+moduleUnitId = toUnitId . moduleUnit
+
+showTUnitId :: UnitId -> Text
+showTUnitId = T.pack . unitIdString
+#else
+  () where
+#endif
diff --git a/src/Stan/Ghc/Compat902.hs b/src/Stan/Ghc/Compat902.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE CPP #-}
+
+module Stan.Ghc.Compat902
+#if __GLASGOW_HASKELL__ == 902 || __GLASGOW_HASKELL__ == 904
+    ( -- * Modules
+      Module
+    , ModuleName
+    , moduleNameString
+    , moduleName
+    , moduleStableString
+    , moduleUnitId
+
+      -- * Names
+    , Name
+    , isExternalName
+    , isSymOcc
+    , nameModule
+    , nameOccName
+    , nameStableString
+    , occNameString
+
+      -- * Source locations
+    , RealSrcSpan
+    , srcSpanEndCol
+    , srcSpanStartCol
+    , srcSpanStartLine
+    , srcSpanEndLine
+    , srcSpanFile
+    , mkRealSrcLoc
+    , mkRealSrcSpan
+
+      -- * Other common types (for debugging and not only)
+    , ArgFlag (..)
+    , AvailInfo (..)
+    , FastString
+    , mkFastString
+    , FieldLbl
+    , FieldLabel (..)
+    , IfaceTyCon (..)
+    , IfaceTyConInfo (..)
+    , IfaceTyConSort (..)
+    , IfaceTyLit (..)
+    , PromotionFlag (..)
+    , TupleSort (..)
+    , showTUnitId
+    ) where
+
+import GHC.Types.Avail (AvailInfo (..))
+import GHC.Types.Basic (PromotionFlag (..), TupleSort (..))
+import GHC.Data.FastString (FastString, mkFastString)
+import GHC.Types.FieldLabel (FieldLabel (..))
+import GHC.Iface.Type (IfaceTyCon (..), IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..))
+import GHC.Unit.Types (Module, moduleName)
+import GHC.Unit.Module (moduleStableString)
+import GHC.Unit (moduleUnit, toUnitId, UnitId, unitIdString)
+import GHC.Unit.Module.Name (ModuleName, moduleNameString)
+import GHC.Types.Name (Name, isExternalName, nameModule, nameOccName, nameStableString)
+import GHC.Types.Name.Occurrence (isSymOcc, occNameString)
+import GHC.Types.SrcLoc (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,
+                         srcSpanStartLine, mkRealSrcSpan, mkRealSrcLoc)
+import GHC.Types.Var (ArgFlag (..))
+
+import qualified Data.Text as T
+
+moduleUnitId :: Module -> UnitId
+moduleUnitId = toUnitId . moduleUnit
+
+showTUnitId :: UnitId -> Text
+showTUnitId = T.pack . unitIdString
+
+type FieldLbl = FieldLabel
+#else
+  () where
+#endif