Update ghc-lib-parser-ex

ndmitchell · Apr 4, 2020 · 540c3cf · 540c3cf
1 parent 3933429
commit 540c3cf
Show file tree

Hide file tree

Showing 9 changed files with 14 additions and 22 deletions.
diff --git a/hlint.cabal b/hlint.cabal
@@ -76,7 +76,7 @@ library
       build-depends:
           ghc-lib-parser == 8.10.*
     build-depends:
-        ghc-lib-parser-ex >= 8.10.0.2 && < 8.10.1
+        ghc-lib-parser-ex >= 8.10.0.3 && < 8.10.1
 
     if flag(gpl)
         build-depends: hscolour >= 1.21

diff --git a/src/CmdLine.hs b/src/CmdLine.hs
@@ -16,6 +16,7 @@ import Data.Maybe
 import Data.Functor
 import HSE.All(CppFlags(..))
 import GHC.LanguageExtensions.Type
+import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx
 import DynFlags hiding (verbosity)
 
 import Language.Preprocessor.Cpphs
@@ -321,9 +322,6 @@ getExtensions args = (lang, foldl f (if null langs then defaultExtensions else [
         ls = [(show x, x) | x <- [Haskell98, Haskell2010]]
 
         f a "Haskell98" = []
-        f a ('N':'o':x) | Just x <- readExtension x = delete x a
-        f a x | Just x <- readExtension x = x : delete x a
+        f a ('N':'o':x) | Just x <- GhclibParserEx.readExtension x = delete x a
+        f a x | Just x <- GhclibParserEx.readExtension x = x : delete x a
         f a x = a -- Ignore unknown extension.
-
-readExtension :: String -> Maybe Extension
-readExtension s = flagSpecFlag <$> find (\(FlagSpec n _ _ _) -> n == s) xFlags
diff --git a/src/GHC/Util.hs b/src/GHC/Util.hs
@@ -43,17 +43,12 @@ import Lexer
 import SrcLoc
 import DynFlags
 import FastString
-import RdrHsSyn
 
 import System.FilePath
 import Language.Preprocessor.Unlit
 
 parseExpGhcLib :: String -> DynFlags -> ParseResult (LHsExpr GhcPs)
-parseExpGhcLib s flags =
-  case GhclibParserEx.parseExpression s flags of
-    POk s e ->
-       unP (runECP_P e) s :: ParseResult (LHsExpr GhcPs)
-    PFailed ps -> PFailed ps
+parseExpGhcLib = GhclibParserEx.parseExpression
 
 parseImportGhcLib :: String -> DynFlags -> ParseResult (LImportDecl GhcPs)
 parseImportGhcLib = GhclibParserEx.parseImport

diff --git a/src/GHC/Util/HsExpr.hs b/src/GHC/Util/HsExpr.hs
@@ -234,7 +234,7 @@ niceLambdaR' [] e = (e, const [])
 niceLambdaR' ss e =
   let grhs = noLoc $ GRHS noExtField [] e :: LGRHS GhcPs (LHsExpr GhcPs)
       grhss = GRHSs {grhssExt = noExtField, grhssGRHSs=[grhs], grhssLocalBinds=noLoc $ EmptyLocalBinds noExtField}
-      match = noLoc $ Match {m_ext=noExtField, m_ctxt=LambdaExpr, m_pats=map (noLoc . strToPat) ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs)
+      match = noLoc $ Match {m_ext=noExtField, m_ctxt=LambdaExpr, m_pats=map strToPat ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs)
       matchGroup = MG {mg_ext=noExtField, mg_origin=Generated, mg_alts=noLoc [match]}
   in (noLoc $ HsLam noExtField matchGroup, const [])
 

diff --git a/src/GHC/Util/Unify.hs b/src/GHC/Util/Unify.hs
@@ -84,7 +84,7 @@ substitute' (Subst' bind) = transformBracketOld' exp . transformBi pat . transfo
     pat :: LPat GhcPs -> LPat GhcPs
     -- Pattern variables.
     pat (L _ (VarPat _ x))
-      | Just y@(L _ HsVar{}) <- lookup (rdrNameStr' x) bind = noLoc $ strToPat (varToStr y)
+      | Just y@(L _ HsVar{}) <- lookup (rdrNameStr' x) bind = strToPat $ varToStr y
     pat x = x :: LPat GhcPs
 
     typ :: LHsType GhcPs -> LHsType GhcPs

diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs
@@ -212,7 +212,6 @@ import Refact.Types
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 
-import DynFlags
 import SrcLoc
 import GHC.Hs
 import BasicTypes
@@ -228,6 +227,7 @@ import Language.Haskell.GhclibParserEx.GHC.Hs.Pat
 import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
 import Language.Haskell.GhclibParserEx.GHC.Hs.Types
 import Language.Haskell.GhclibParserEx.GHC.Hs.Decls
+import Language.Haskell.GhclibParserEx.GHC.Driver.Session
 
 extensionsHint :: ModuHint
 extensionsHint _ x =
@@ -254,9 +254,8 @@ extensionsHint _ x =
     filterEnabled  = filter (not . isPrefixOf "No")
 
     lookupExt :: String -> Extension
-    lookupExt s =
-      case find (\(FlagSpec n _ _ _) -> n == s) xFlags of
-        Just f -> flagSpecFlag f
+    lookupExt s = case readExtension s of
+        Just ext -> ext
         Nothing ->
           -- Validity checking of extensions happens when the parse
           -- tree is constructed (via 'getOptions' called from

diff --git a/src/Hint/ListRec.hs b/src/Hint/ListRec.hs
@@ -168,7 +168,7 @@ findCase x = do
   b2 <- transformAppsM' (delCons name1 p1 xs) b2
   (ps, b2) <- pure $ eliminateArgs ps1 b2
 
-  let ps12 = let (a, b) = splitAt p1 ps1 in map (noLoc . strToPat) (a ++ xs : b) -- Function arguments.
+  let ps12 = let (a, b) = splitAt p1 ps1 in map strToPat (a ++ xs : b) -- Function arguments.
       emptyLocalBinds = noLoc $ EmptyLocalBinds noExtField -- Empty where clause.
       gRHS e = noLoc $ GRHS noExtField [] e :: LGRHS GhcPs (LHsExpr GhcPs) -- Guarded rhs.
       gRHSSs e = GRHSs noExtField [gRHS e] emptyLocalBinds -- Guarded rhs set.

diff --git a/src/Hint/Pattern.hs b/src/Hint/Pattern.hs
@@ -139,7 +139,7 @@ hints gen (Pattern l rtype pat (GRHSs _ [L _ (GRHS _ [] bod)] bind))
     toString (Left e) = e
     toString (Right (v, _)) = strToVar v
     toString' (Left e) = e
-    toString' (Right (v, _)) = noLoc $ strToPat v
+    toString' (Right (v, _)) = strToPat v
 
     template = fromMaybe "" $ ideaTo (gen "" (Pattern l rtype (map toString' patSubts) (GRHSs noExtField templateGuards bind)) [])
 

diff --git a/stack.yaml b/stack.yaml
@@ -3,10 +3,10 @@ packages:
   - .
 extra-deps:
   - ghc-lib-parser-8.10.1.20200324
-  - ghc-lib-parser-ex-8.10.0.2
+  - ghc-lib-parser-ex-8.10.0.3
 # To test hlint against experimental builds of ghc-lib-parser-ex,
 # modify extra-deps like this:
-#  - archive: /users/shaynefletcher/project/ghc-lib-parser-ex.git/ghc-lib-parser-ex-8.10.0.2.tar.gz
+#  - archive: /users/shaynefletcher/project/ghc-lib-parser-ex.git/ghc-lib-parser-ex-8.10.0.4.tar.gz
   - extra-1.7.1
 ghc-options: {"$locals": -ddump-to-file -ddump-hi -Werror=unused-imports -Werror=unused-top-binds -Werror=orphans}
 # Enabling this stanza forces both hlint and ghc-lib-parser-ex to