ghc-lib-parser-ex 0.20210701 → 0.20210801

raw patch · 4 files changed

+42/−18 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• ghc-lib-parser-ex.cabal +1/−1
• src/Language/Haskell/GhclibParserEx/GHC/Hs/Expr.hs +10/−1
• test/Test.hs +25/−16

@@ -1,5 +1,11 @@ # Changelog for ghc-lib-parser-ex +## 0.20210801 released 2021-08-01+- Added to `GhclibParserEx.GHC.Hs.Expr`:+  - `isMonadComp`+  - `isListComp`+- Update to `ghc-lib-0.20210801`+ ## 0.20210701 released 2021-07-01 - Update to `ghc-lib-0.20210701` 

@@ -1,6 +1,6 @@ cabal-version:  1.18 name:           ghc-lib-parser-ex-version:        0.20210701+version:        0.20210801 description:    Please see the README on GitHub at <https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme> homepage:       https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme bug-reports:    https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues

@@ -9,7 +9,7 @@   isTag, isDol, isDot, isReturn, isSection, isRecConstr, isRecUpdate,   isVar, isPar, isApp, isOpApp, isAnyApp, isLexeme, isLambda, isQuasiQuote,   isDotApp, isTypeApp, isWHNF, isLCase,-  isFieldPun, isFieldPunUpdate, isRecStmt, isParComp, isMDo, isTupleSection, isString, isPrimLiteral,+  isFieldPun, isFieldPunUpdate, isRecStmt, isParComp, isMDo, isListComp, isMonadComp, isTupleSection, isString, isPrimLiteral,   isSpliceDecl, isFieldWildcard, isUnboxed, isWholeFrac, isStrictMatch, isMultiIf, isProc, isTransStmt,   hasFieldsDotDot,   varToStr, strToVar,@@ -117,12 +117,21 @@ isParComp :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool isParComp = \case ParStmt{} -> True; _ -> False +-- TODO: Seems `HsStmtContext (HsDoRn p)` on master right now. #if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900) isMDo :: HsStmtContext GhcRn -> Bool isMDo = \case MDoExpr _ -> True; _ -> False+isMonadComp :: HsStmtContext GhcRn -> Bool+isMonadComp = \case MonadComp -> True; _ -> False+isListComp :: HsStmtContext GhcRn -> Bool+isListComp = \case ListComp -> True; _ -> False #else isMDo :: HsStmtContext Name -> Bool isMDo = \case MDoExpr -> True; _ -> False+isMonadComp :: HsStmtContext Name -> Bool+isMonadComp = \case MonadComp -> True; _ -> False+isListComp :: HsStmtContext Name -> Bool+isListComp = \case ListComp -> True; _ -> False #endif  isTupleSection :: HsTupArg GhcPs -> Bool

@@ -20,8 +20,7 @@ #if defined (GHCLIB_API_HEAD) import GHC.Data.Bag import GHC.Driver.Errors.Types-import GHC.Types.Error hiding (getMessages)-import qualified GHC.Types.Error (getMessages)+import GHC.Types.Error #endif  import Language.Haskell.GhclibParserEx.Dump@@ -110,7 +109,9 @@ #endif chkParseResult report flags = \case     POk s _ -> do-#if defined (GHCLIB_API_HEAD) || defined (GHCLIB_API_902)+#if defined (GHCLIB_API_HEAD)+      let (wrns, errs) = getPsMessages s+#elif defined (GHCLIB_API_902)       let (wrns, errs) = getMessages s #else       let (wrns, errs) = getMessages s flags@@ -118,8 +119,8 @@       when (not (null errs) || not (null wrns)) $ #if defined (GHCLIB_API_HEAD)         assertFailure (-          report flags (GHC.Types.Error.getMessages (GhcPsMessage <$> wrns)) ++-          report flags (GHC.Types.Error.getMessages (GhcPsMessage <$> errs))+          report flags (getMessages (GhcPsMessage <$> wrns)) +++          report flags (getMessages (GhcPsMessage <$> errs))         )  #elif defined (GHCLIB_API_902)@@ -128,7 +129,7 @@         assertFailure (report flags wrns ++ report flags errs) #endif #if defined (GHCLIB_API_HEAD)-    PFailed s -> assertFailure (report flags $ GHC.Types.Error.getMessages (GhcPsMessage <$> snd (getMessages s)))+    PFailed s -> assertFailure (report flags $ getMessages (GhcPsMessage <$> snd (getPsMessages s))) #elif defined (GHCLIB_API_902)     PFailed s -> assertFailure (report flags $ fmap pprError (snd (getMessages s))) #elif defined (GHCLIB_API_900) || defined (GHCLIB_API_810)@@ -353,7 +354,13 @@   , testCase "isQuasiQuote" $ test "[expr(1 + 2)]" $ assert' . not . isQuasiQuote   , testCase "isWholeFrac" $ test "3.2e1" $ assert' . isWholeFrac . unLoc   , testCase "isWholeFrac" $ test "3.22e1" $ assert' . not . isWholeFrac . unLoc-  , testCase "isMDo" $ test "mdo { pure () }" $ assert' . any isMDo . universeBi+  , testCase "isMDo" $ test_with_exts [ RecursiveDo ] "mdo { pure () }" $ assert' . any isMDo . universeBi+  , testCase "isListComp (1)" $ test "[ x + y | x <- xs, y <- ys ]" $ assert' . any isListComp . universeBi+  , testCase "isListComp (2)" $ test_with_exts [ MonadComprehensions ] "[ x + y | x <- xs, y <- ys ]" $ assert' . any isMonadComp . universeBi+  , testCase "isMonadComp (0)" $ test_with_exts [ MonadComprehensions ] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . not . any isListComp . universeBi+  , testCase "isMonadComp (1)" $ test_with_exts [ MonadComprehensions ] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . any isMonadComp . universeBi+  , testCase "isMonadComp (2)" $ test_with_exts [] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . not . any isMonadComp . universeBi+  , testCase "isMonadComp (3)" $ test_with_exts [] "[ x + y | x <- Just 1, y <- Just 2 ]" $ assert' . any isListComp . universeBi   , testCase "strToVar" $ assert' . isVar . strToVar $ "foo"   , testCase "varToStr" $ test "[]" $ assert' . (== "[]") . varToStr   , testCase "varToStr" $ test "foo" $ assert' . (== "foo") . varToStr@@ -361,15 +368,17 @@   ]   where     assert' = assertBool ""-    test s = exprTest s flags-    flags = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)-              [ TemplateHaskell-              , TemplateHaskellQuotes-              , QuasiQuotes-              , TypeApplications-              , LambdaCase-              , RecursiveDo-              ]+    test s = exprTest s (flags [])+    test_with_exts exts s = exprTest s (flags exts)+    flags exts = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)+              (exts +++                 [ TemplateHaskell+                 , TemplateHaskellQuotes+                 , QuasiQuotes+                 , TypeApplications+                 , LambdaCase+                 ]+              )  patternPredicateTests :: TestTree patternPredicateTests = testGroup "Pattern predicate tests"