Bump used GHC Version (#44)

* Upgrade GHC Version

* Runner: Guess Targets after setting dynflags

package.yaml

@@ -39,8 +39,8 @@ library:
   source-dirs: src
   dependencies:
   - directory
-  - ghc-lib
-  - ghc-lib-parser
+  - ghc
+  - ghc-boot
   - exceptions
   - time
   - ghc-paths
@@ -77,7 +77,7 @@ tests:
     - -rtsopts
     - -with-rtsopts=-N
     dependencies:
-    - ghc-lib
+    - ghc
     - directory
     - filepath
     - text

seminal-haskell.cabal

@@ -53,8 +53,8 @@ library
     , bytestring
     , directory
     , exceptions
-    , ghc-lib
-    , ghc-lib-parser
+    , ghc
+    , ghc-boot
     , ghc-paths
     , text
     , time
@@ -96,7 +96,7 @@ test-suite seminal-haskell-test
     , base >=4.7 && <5
     , directory
     , filepath
-    , ghc-lib
+    , ghc
     , seminal-haskell
     , test-framework
     , test-framework-hunit

src/Seminal/Compiler/Runner.hs

@@ -26,8 +26,6 @@ runCompiler filePaths action = do
         Right r -> Right r
     where
         session = runGhc (Just libdir) $ do
-            targets <- guessTargets filePaths
-            setTargets targets
             flags <- getSessionDynFlags
             setSessionDynFlags (flags {
                 mainFunIs = Just "undefined",
@@ -37,11 +35,13 @@ runCompiler filePaths action = do
                 maxErrors = Just 0,
                 extensionFlags = insert PartialTypeSignatures (extensionFlags flags)
                 })
+            targets <- guessTargets filePaths
+            setTargets targets
             _ <- load LoadAllTargets
             modGraph <- depanal [] True
             parseResults <- mapM (\f -> (f,) <$> getModule modGraph f) filePaths
             action parseResults
-        guessTargets = mapM (`guessTarget` Nothing) -- AKA (\filePath -> guessTarget filePath Nothing)
+        guessTargets = mapM (\t -> guessTarget t Nothing Nothing)
         -- 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

@@ -27,7 +27,6 @@ enumerateChangesInBinding (PatBind a (L loc pat) c d) _ = enumerateChangesInPatt
     <&&> (L loc)
     <&&> (\b -> PatBind a b c d)
 enumerateChangesInBinding (VarBind {}) _ = []
-enumerateChangesInBinding (AbsBinds {}) _ = []
 enumerateChangesInBinding (PatSynBind {}) _ = []
 
 -- | Enumerates changes to apply on function binding, e.g. `a True = True`.

src/Seminal/Enumerator/Bindings.hs-boot

@@ -1,13 +1,10 @@
 module Seminal.Enumerator.Bindings (
     enumerateChangesInBinding,
-    enumerateChangesInLocalBinds,
     enumerateChangesInFuncBinding
 ) where
 
 import Seminal.Enumerator.Enumerator (Enumerator)
 import GHC (HsBind, GhcPs)
-import GHC.Hs (HsLocalBinds)
 
 enumerateChangesInBinding :: Enumerator (HsBind GhcPs)
-enumerateChangesInFuncBinding :: Enumerator (HsBind GhcPs)
-enumerateChangesInLocalBinds :: Enumerator (HsLocalBinds GhcPs)
+enumerateChangesInFuncBinding :: Enumerator (HsBind GhcPs)

src/Seminal/Enumerator/Expressions.hs

@@ -19,6 +19,7 @@ import GHC
       MatchGroup(MG),
       GenLocated(L),
       LHsExpr,
+      HsToken(..), TokenLocation(..),
       noSrcSpan, noLoc, reLocA, StmtLR (..))
 import Seminal.Change
     ( Change(..), node,
@@ -69,7 +70,7 @@ enumerateChangesInExpression expr loc = [change]
         locMe = L noSrcSpanA
 
 enumerateChangesInExpression' :: Enumerator (HsExpr GhcPs)
-enumerateChangesInExpression' (HsPar _ (L lexpr expr)) _ = enumerateChangesInExpression' expr (locA lexpr)
+enumerateChangesInExpression' (HsPar _ _ (L lexpr expr) _) _ = 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
@@ -165,13 +166,13 @@ enumerateChangesInExpression' expr loc = case expr of
                 )
             paramList = hsAppToList expr
     -- `let _ = xx in ...` expressions
-    (HsLet x bind e) -> enumExpr ++ enumBind
+    (HsLet x letToken bind inToken e) -> enumExpr ++ enumBind
         where
             enumBind = enumerateChangesInLocalBinds bind loc
-                <&&> (\newbind -> HsLet x newbind e)
+                <&&> (\newbind -> HsLet x letToken newbind inToken e)
             enumExpr = let (L lexpr letExpr) = e in enumerateChangesInExpression letExpr (locA lexpr)
                 <&&> (L lexpr)
-                <&&> (HsLet x bind)
+                <&&> (HsLet x letToken bind inToken)
     (HsIf ext lifExpr lthenExpr lelseExpr) -> enumIf ++ enumElse ++ enumThen
         where
             enumIf = let (L lif ifExpr) = lifExpr in enumerateChangesInExpression ifExpr (locA lif)
@@ -243,7 +244,7 @@ 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
-wrapExprInPar = HsPar EpAnnNotUsed
+wrapExprInPar e = HsPar EpAnnNotUsed (L NoTokenLoc HsTok) e (L NoTokenLoc HsTok)
 
 -- | Turns an HsApp into a list of expression.
 -- `const 1 2` -> [cons, 1, 2]

src/Seminal/Enumerator/Literals.hs

@@ -56,6 +56,6 @@ 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)
-            overLitValToLit o = OverLit undefined o undefined
+            overLitValToLit = OverLit NoExtField
             nbToOverLitVal = HsFractional . mkTHFractionalLit . toRational
     _ -> []

src/Seminal/Enumerator/Patterns.hs

@@ -10,9 +10,9 @@ enumerateChangesInPattern :: Enumerator (Pat GhcPs)
 enumerateChangesInPattern (WildPat _) _ = []
 enumerateChangesInPattern pat loc = wildpatChange : case pat of
     (LitPat xlit litExpr) -> enumerateChangeInLiteral litExpr loc <&&> (LitPat xlit)
-    (ParPat xpar (L lpat subpat)) -> enumerateChangesInPattern subpat (locA lpat)
+    (ParPat xpar openParTok (L lpat subpat) closeParTok) -> enumerateChangesInPattern subpat (locA lpat)
         <&&> (L lpat)
-        <&&> (ParPat xpar)
+        <&&> (\newPat -> ParPat xpar openParTok newPat closeParTok)
     _ -> []
     where
         wildpatChange = Change (node pat) [node $ WildPat noExtField] loc [] "The pattern is invalid." Wildcard

src/Seminal/Enumerator/Types.hs

@@ -1,12 +1,14 @@
 module Seminal.Enumerator.Types (enumerateChangeInType) where
-import GHC (GhcPs, GenLocated (L), HsType (HsWildCardTy, HsTyVar, HsTupleTy, HsAppTy, HsListTy, HsParTy, HsFunTy), NoExtField (NoExtField), RdrName, EpAnn (EpAnnNotUsed), HsTupleSort (HsBoxedOrConstraintTuple), noLocA, SrcSpanAnn' (locA), noLoc, reLocA, HsArrow (HsUnrestrictedArrow), IsUnicodeSyntax (UnicodeSyntax))
+import GHC (GhcPs, GenLocated (L), HsType (HsWildCardTy, HsTyVar, HsTupleTy, HsAppTy, HsListTy, HsParTy, HsFunTy), NoExtField (NoExtField), RdrName, EpAnn (EpAnnNotUsed), HsTupleSort (HsBoxedOrConstraintTuple), noLocA, SrcSpanAnn' (locA), noLoc, reLocA, HsArrow (HsUnrestrictedArrow))
 import Seminal.Enumerator.Enumerator (Enumerator)
 import Seminal.Change (ChangeType(..), node, Change (Change, src, message), (<&&>), forceRewrite)
 import GHC.Plugins (mkRdrUnqual, showPprUnsafe, mkTcOcc, Outputable (ppr), PromotionFlag (NotPromoted))
 import Data.Functor ((<&>))
 import Text.Printf (printf)
 import Data.List.HT (splitEverywhere)
 import Data.List (permutations)
+import Language.Haskell.Syntax.Extension (HsUniToken(HsUnicodeTok))
+import GHC.Parser.Annotation (TokenLocation(NoTokenLoc))
 
 enumerateChangeInType :: Enumerator (HsType GhcPs)
 enumerateChangeInType typ loc = (case typ of
@@ -180,5 +182,5 @@ typeListToHsFunTy :: [HsType GhcPs] -> (HsType GhcPs)
 typeListToHsFunTy [] = undefined
 typeListToHsFunTy [e] = e
 typeListToHsFunTy (left:right) = HsFunTy EpAnnNotUsed
-    (HsUnrestrictedArrow UnicodeSyntax)
+    (HsUnrestrictedArrow $ L NoTokenLoc HsUnicodeTok)
     (noLocA left) (noLocA (typeListToHsFunTy right))

stack.yaml

@@ -10,7 +10,7 @@
 #
 # resolver: lts-3.5
 # resolver: nightly-2015-09-21
-resolver: lts-20.21
+resolver: lts-21.3
 #
 # The location of a snapshot can be provided as a file or url. Stack assumes
 # a snapshot provided as a file might change, whereas a url resource does not.
@@ -50,7 +50,7 @@ packages:
 # extra-package-dbs: []
 
 # Control whether we use the GHC we find on the path
-system-ghc: true
+system-ghc: false
 #
 # Require a specific version of Stack, using version ranges
 # require-stack-version: -any # Default

stack.yaml.lock

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    sha256: 401a0e813162ba62f04517f60c7d25e93a0f867f94a902421ebf07d1fb5a8c46
-    size: 650044
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/21.yaml
-  original: lts-20.21
+    sha256: 97710f56bf093fca0ee5d8dbe19d96b654c752e405b66795b4baedd84a794c60
+    size: 640010
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/3.yaml
+  original: lts-21.3

test/TestCompiler/Parser.hs

@@ -7,6 +7,7 @@ import Test.Framework.Providers.HUnit (testCase)
 import GHC (moduleNameString, moduleName, ms_mod, pm_mod_summary, ParsedModule)
 import System.Directory (getPermissions, setOwnerReadable, setPermissions)
 import Data.List (isPrefixOf, isSuffixOf, isInfixOf)
+import GHC.SysTools.Tasks(isContainedIn)
 
 runParser :: [FilePath] -> IO (Either String [(FilePath, ParsedModule)])
 runParser files = runCompiler files return
@@ -26,7 +27,7 @@ testSuite = testGroup "Compiler's Parser" [
     buildTest $ do
         res <- runParser ["test/assets/invalid/syntax-error.hs"]
         return $ testCase "Invalid Parsing (Syntax Error)" $ case res of
-            Left errMsg -> assertBool "" $ "parse error" `isPrefixOf` errMsg
+            Left errMsg -> assertBool errMsg $ "parse error" `isContainedIn` errMsg
             _ -> assertFailure "Parsing should have failed",
     buildTest $ do
         res <- runParser ["idonotexist"]