Support GHC from 9.2.7 to 9.4.4

.github/workflows/build.yml

@@ -6,10 +6,27 @@ on:
 
 jobs:
   Build:
+    name: Build (GHC ${{ matrix.ghc-version }})
+    strategy:
+      fail-fast: false
+      matrix:
+        ghc-version: [
+          9.4.5,
+          9.4.4,
+          9.4.3,
+          9.4.2,
+          9.4.1,
+          9.2.8,
+          9.2.7
+        ]
     runs-on: ubuntu-20.04
     steps:
       - uses: actions/[email protected]
       - uses: ./.github/actions/install-stack
       - uses: ./.github/actions/cache
       - name: Compile Project
-        run: stack build
+        run: stack --compiler ghc-${{ matrix.ghc-version }} build
+      # This is to check if the project has been compiled with the correct version of ghc-lib.
+      # For example, if there is a mismatch, we would get something like "Unknown Constructor: Char" 
+      - name: Check Basic Suggestion
+        run: stack --compiler ghc-${{ matrix.ghc-version }} run test/assets/invalid/expect-char.hs

.github/workflows/documentation.yml

@@ -7,15 +7,16 @@ on:
 permissions:
   contents: write
 jobs:
-  DeployDocumentation:
+  run:
+    name: Build Documentation
     concurrency: ci-${{ github.ref }}
     runs-on: ubuntu-20.04
     steps:
       - name: Wait for tests to succeed
         uses: lewagon/[email protected]
         with:
           ref: ${{ github.ref }}
-          check-name: 'Build'
+          check-name: 'Build (GHC 9.4.5)'
           repo-token: ${{ secrets.GITHUB_TOKEN }}
           wait-interval: 30
       - uses: actions/[email protected]

.github/workflows/lint.yml

@@ -5,13 +5,14 @@ on:
       - '*'
 jobs:
   run:
+    name: Run Linter
     runs-on: ubuntu-20.04
     steps:
       - name: Wait for tests to succeed
         uses: lewagon/[email protected]
         with:
           ref: ${{ github.ref }}
-          check-name: 'Build'
+          check-name: 'Build (GHC 9.4.5)'
           repo-token: ${{ secrets.GITHUB_TOKEN }}
           wait-interval: 30
       - uses: actions/[email protected]

.github/workflows/unit-tests.yaml

@@ -5,13 +5,14 @@ on:
       - '*'
 jobs:
   run:
+    name: Run Unit Tests
     runs-on: ubuntu-20.04
     steps:
       - name: Wait for tests to succeed
         uses: lewagon/[email protected]
         with:
           ref: ${{ github.ref }}
-          check-name: 'Build'
+          check-name: 'Build (GHC 9.4.5)'
           repo-token: ${{ secrets.GITHUB_TOKEN }}
           wait-interval: 30
       - uses: actions/[email protected]

logbook.md

@@ -178,6 +178,7 @@
 
 - Bump GHC Version
 - Wrap GHC's API in custom module
+- Backward support for GHC 9.2.7-9.4.4
 
 ## Difficulties encountered
 

src/Seminal/Compiler/API.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 {-# HLINT ignore "Use fewer imports" #-}
 -- | We want to split imports as muc has possible to use CPP preprocessors more easily
@@ -47,15 +48,20 @@ module Seminal.Compiler.API (
     HsLit(..),
     HsOverLit(..),
     OverLitVal(..),
-    TokenLocation(..),
     HsType(..),
     HsArrow(..),
     noLoc,
     noLocA,
     reLocA,
     EpAnn(..),
     HsTupleSort(..),
+#if MIN_VERSION_ghc(9,4,1)
+    HsToken(..),
     HsUniToken(..),
+    TokenLocation(..),
+#else
+    IsUnicodeSyntax(..),
+#endif 
     RdrName,
     showPprUnsafe,
     ppr,
@@ -88,7 +94,6 @@ module Seminal.Compiler.API (
     noAnnSrcSpan,
     StmtLR(..),
     HsTupArg(..),
-    HsToken(..),
     handleSourceError,
     isContainedIn,
     Extension(..),
@@ -108,7 +113,9 @@ import GHC.Types.SrcLoc(noSrcSpan)
 -- | Annotations
 import GHC.Parser.Annotation(SrcSpanAnn'(..))
 import GHC.Parser.Annotation(realSrcSpan)
+#if MIN_VERSION_ghc(9,4,1)
 import GHC.Parser.Annotation(TokenLocation(NoTokenLoc))
+#endif
 import GHC.Parser.Annotation(noLocA)
 import GHC.Parser.Annotation(reLocA)
 import GHC.Parser.Annotation(noSrcSpanA)
@@ -146,7 +153,11 @@ import Language.Haskell.Syntax.Lit(OverLitVal(..))
 import Language.Haskell.Syntax.Type(HsType(..))
 import Language.Haskell.Syntax.Type(HsArrow(..))
 import Language.Haskell.Syntax.Type (HsTupleSort(..))
+#if MIN_VERSION_ghc(9,4,1)
 import Language.Haskell.Syntax.Extension (HsUniToken(HsUnicodeTok))
+#else
+import GHC.Parser.Annotation (IsUnicodeSyntax(..))
+#endif 
 import Language.Haskell.Syntax(Sig(..))
 import Language.Haskell.Syntax.Type(HsWildCardBndrs(..))
 import Language.Haskell.Syntax.Type(HsSigType(HsSig))
@@ -158,7 +169,9 @@ import Language.Haskell.Syntax.Extension (NoExtField (NoExtField))
 
 -- | Parsing Types
 import GHC(ParsedModule(..))
+#if MIN_VERSION_ghc(9,4,1)
 import GHC(HsToken(..))
+#endif
 
 -- | Runner Utils
 import GHC(runGhc)

src/Seminal/Compiler/Runner.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
 module Seminal.Compiler.Runner (runCompiler) where
 import Seminal.Compiler.API
 import GHC.Paths (libdir) --  We dont import is from wrapped API because it's not provided by GHC
@@ -35,7 +36,11 @@ runCompiler filePaths action = do
             modGraph <- depanal [] True
             parseResults <- mapM (\f -> (f,) <$> getModule modGraph f) filePaths
             action parseResults
+#if MIN_VERSION_ghc(9,4,1)
         guessTargets = mapM (\t -> guessTarget t Nothing Nothing)
+#else
+        guessTargets = mapM (`guessTarget` Nothing)
+#endif
         -- Retrieves the module of a file using its paths and the modgraph
         getModule modGraph filePath = case find ((== filePath) . msHsFilePath) (mgModSummaries modGraph) of
             -- Do not worry, this should never happen.

src/Seminal/Enumerator/Bindings.hs

@@ -17,8 +17,7 @@ enumerateChangesInBinding (FunBind a b c d) l = enumerateChangesInFuncBinding (F
 enumerateChangesInBinding (PatBind a (L loc pat) c d) _ = enumerateChangesInPattern pat (locA loc)
     <&&> (L loc)
     <&&> (\b -> PatBind a b c d)
-enumerateChangesInBinding (VarBind {}) _ = []
-enumerateChangesInBinding (PatSynBind {}) _ = []
+enumerateChangesInBinding _ _ = []
 
 -- | Enumerates changes to apply on function binding, e.g. `a True = True`.
 -- One function binding groups all the matches

src/Seminal/Enumerator/Expressions.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Seminal.Enumerator.Expressions (
     enumerateChangesInExpression
 ) where
@@ -46,7 +47,12 @@ enumerateChangesInExpression expr loc = [change]
         locMe = L noSrcSpanA
 
 enumerateChangesInExpression' :: Enumerator (HsExpr GhcPs)
-enumerateChangesInExpression' (HsPar _ _ (L lexpr expr) _) _ = enumerateChangesInExpression' expr (locA lexpr)
+#if MIN_VERSION_ghc(9,4,1)
+enumerateChangesInExpression' (HsPar _ _ (L lexpr expr) _) _ = 
+#else
+enumerateChangesInExpression' (HsPar _ (L lexpr expr)) _ =
+#endif
+    enumerateChangesInExpression' expr (locA lexpr)
 enumerateChangesInExpression' expr loc = case expr of
     (ExplicitList ext elems) -> reverse -- Reverse because we started here w/ most specific
         (if length elems == 1
@@ -142,13 +148,26 @@ enumerateChangesInExpression' expr loc = case expr of
                 )
             paramList = hsAppToList expr
     -- `let _ = xx in ...` expressions
+#if MIN_VERSION_ghc(9,4,1)
     (HsLet x letToken bind inToken e) -> enumExpr ++ enumBind
+#else
+    (HsLet x bind e) -> enumExpr ++ enumBind
+#endif
         where
             enumBind = enumerateChangesInLocalBinds bind loc
+#if MIN_VERSION_ghc(9,4,1)
                 <&&> (\newbind -> HsLet x letToken newbind inToken e)
+#else
+                <&&> (\newbind -> HsLet x newbind e)
+#endif
             enumExpr = let (L lexpr letExpr) = e in enumerateChangesInExpression letExpr (locA lexpr)
                 <&&> (L lexpr)
+#if MIN_VERSION_ghc(9,4,1)
                 <&&> (HsLet x letToken bind inToken)
+#else
+                <&&> (HsLet x bind)
+#endif
+
     (HsIf ext lifExpr lthenExpr lelseExpr) -> enumIf ++ enumElse ++ enumThen
         where
             enumIf = let (L lif ifExpr) = lifExpr in enumerateChangesInExpression ifExpr (locA lif)
@@ -220,7 +239,11 @@ buildFunctionName funcName = HsVar NoExtField $ L (noAnnSrcSpan noSrcSpan) (mkRd
 -- | Wraps an expression in parenthesis (AST-wise).
 -- Mainly used for pretty printing
 wrapExprInPar :: LHsExpr GhcPs -> HsExpr GhcPs
+#if MIN_VERSION_ghc(9,4,1)
 wrapExprInPar e = HsPar EpAnnNotUsed (L NoTokenLoc HsTok) e (L NoTokenLoc HsTok)
+#else
+wrapExprInPar = HsPar EpAnnNotUsed
+#endif
 
 -- | Turns an HsApp into a list of expression.
 -- `const 1 2` -> [cons, 1, 2]

src/Seminal/Enumerator/Literals.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Seminal.Enumerator.Literals (enumerateChangeInLiteral, enumerateRaiseInLiterals) where
 import Seminal.Enumerator.Enumerator (Enumerator)
 import Seminal.Compiler.API
@@ -53,6 +54,10 @@ enumerateRaiseInLiterals expr loc  = case expr of
             changeForString s = overLitValToLit <$> mapMaybe (\f -> f s) [stringToDouble]
                 <&> (\newLit -> Change (node expr) [node $ HsOverLit x newLit] loc [] "Remove the quotes" Terminal)
             stringToDouble str = nbToOverLitVal <$> (readMaybe str :: Maybe Double)
+#if MIN_VERSION_ghc(9,4,1)
             overLitValToLit = OverLit NoExtField
+#else
+            overLitValToLit ol = OverLit NoExtField ol expr
+#endif  
             nbToOverLitVal = HsFractional . mkTHFractionalLit . toRational
     _ -> []

src/Seminal/Enumerator/Patterns.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Seminal.Enumerator.Patterns (enumerateChangesInPattern) where
 import Seminal.Enumerator.Enumerator (Enumerator)
 import Seminal.Compiler.API
@@ -10,9 +11,18 @@ enumerateChangesInPattern :: Enumerator (Pat GhcPs)
 enumerateChangesInPattern (WildPat _) _ = []
 enumerateChangesInPattern pat loc = wildpatChange : case pat of
     (LitPat xlit litExpr) -> enumerateChangeInLiteral litExpr loc <&&> (LitPat xlit)
-    (ParPat xpar openParTok (L lpat subpat) closeParTok) -> enumerateChangesInPattern subpat (locA lpat)
-        <&&> (L lpat)
-        <&&> (\newPat -> ParPat xpar openParTok newPat closeParTok)
+#if MIN_VERSION_ghc(9,4,1)
+    (ParPat xpar openParTok (L lpat subpat) closeParTok) ->
+#else
+    (ParPat xpar (L lpat subpat)) ->
+#endif
+        enumerateChangesInPattern subpat (locA lpat)
+            <&&> (L lpat)
+#if MIN_VERSION_ghc(9,4,1)
+            <&&> (\newPat -> ParPat xpar openParTok newPat closeParTok)
+#else
+            <&&> (ParPat xpar)
+#endif
     _ -> []
     where
         wildpatChange = Change (node pat) [node $ WildPat NoExtField] loc [] "The pattern is invalid." Wildcard

src/Seminal/Enumerator/Types.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Seminal.Enumerator.Types (enumerateChangeInType) where
 import Seminal.Compiler.API
 import Seminal.Enumerator.Enumerator (Enumerator)
@@ -179,5 +180,9 @@ typeListToHsFunTy :: [HsType GhcPs] -> (HsType GhcPs)
 typeListToHsFunTy [] = undefined
 typeListToHsFunTy [e] = e
 typeListToHsFunTy (left:right) = HsFunTy EpAnnNotUsed
+#if MIN_VERSION_ghc(9,4,1)
     (HsUnrestrictedArrow $ L NoTokenLoc HsUnicodeTok)
+#else
+    (HsUnrestrictedArrow UnicodeSyntax)
+#endif
     (noLocA left) (noLocA (typeListToHsFunTy right))