ghc-lib-parser-ex 0.20200205.0.0 → 0.20200301

raw patch · 10 files changed

+488/−56 lines, 10 filesdep +containersdep +ghc-bootdep ~extraPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, ghc-boot

Dependency ranges changed: extra

API changes (from Hackage documentation)

Files

• ChangeLog.md +17/−0
• ghc-lib-parser-ex.cabal +9/−3
• src/Language/Haskell/GhclibParserEx/Config.hs +4/−0
• src/Language/Haskell/GhclibParserEx/DynFlags.hs +125/−2
• src/Language/Haskell/GhclibParserEx/GHC/Hs/Decls.hs +26/−0
• src/Language/Haskell/GhclibParserEx/GHC/Hs/Expr.hs +4/−5
• src/Language/Haskell/GhclibParserEx/GHC/Hs/Pat.hs +100/−0
• src/Language/Haskell/GhclibParserEx/GHC/Hs/Types.hs +28/−0
• src/Language/Haskell/GhclibParserEx/Parse.hs +8/−0
• test/Test.hs +167/−46

@@ -2,6 +2,23 @@  ## Unreleased changes +## 0.20200301 released 2020-03-01++## 8.8.5.3 released 2020-02-25+- New modules:+  - `Language.Haskell.GhclibParserEx.Pat`+  - `Language.Haskell.GhclibParserEx.Types`+  - `Language.Haskell.GhclibParserEx.Decls`++## 8.8.5.2 released 2020-02-16+- New `DynFlags` functions `readExtension`, `extensionImplications`.++## 8.8.5.1 released 2020-02-09+- Expression predicate tests.++## 8.8.5.0 released 2020-02-07+- Expose `impliedGFlags` and friends from `DynFlags` (https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues/19).+ ## 8.8.4.0 released 2020-02-01 - New modules:   - `Language.Haskell.GhclibparserEx.GHC.Hs.Expr`

@@ -1,6 +1,6 @@ cabal-version: >= 1.18 name:           ghc-lib-parser-ex-version:        0.20200205.0.0+version:        0.20200301 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@@ -34,6 +34,9 @@       Language.Haskell.GhclibParserEx.DynFlags       Language.Haskell.GhclibParserEx.Fixity       Language.Haskell.GhclibParserEx.GHC.Hs.Expr+      Language.Haskell.GhclibParserEx.GHC.Hs.Pat+      Language.Haskell.GhclibParserEx.GHC.Hs.Types+      Language.Haskell.GhclibParserEx.GHC.Hs.Decls       Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances       Language.Haskell.GhclibParserEx.Parse       Language.Haskell.GhclibParserEx.Outputable@@ -44,11 +47,14 @@   build-depends:       base >=4.7 && <5,       uniplate >= 1.5,-      bytestring >= 0.10.8.2+      bytestring >= 0.10.8.2,+      containers >= 0.5.8.1,+      extra >= 1.6.19   if !flag(ghc-lib) && impl(ghc >= 8.8.0) && impl(ghc < 8.9.0)       build-depends:         ghc == 8.8.*,-        ghc-boot-th+        ghc-boot-th,+        ghc-boot   else       build-depends:         ghc-lib-parser

@@ -12,7 +12,11 @@   where  import Config+#if defined (GHCLIB_API_811)+import GHC.Driver.Session+#else import DynFlags+#endif import Fingerprint  #if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)

@@ -1,17 +1,140 @@ -- Copyright (c) 2020, Shayne Fletcher. All rights reserved. -- SPDX-License-Identifier: BSD-3-Clause. +{-# LANGUAGE CPP #-}+#include "ghclib_api.h"+ module Language.Haskell.GhclibParserEx.DynFlags(-    parsePragmasIntoDynFlags+      readExtension+    , extensionImplications+    -- Copied from DynFlags (see+    -- https://gitlab.haskell.org/ghc/ghc/merge_requests/2654).+    , TurnOnFlag, turnOn, turnOff, impliedGFlags, impliedOffGFlags, impliedXFlags+    --+    , parsePragmasIntoDynFlags   ) where -import DynFlags+import qualified GHC.LanguageExtensions as LangExt import Panic import HeaderInfo import StringBuffer+#if defined(GHCLIB_API_811)+import GHC.Driver.Session+import GHC.Driver.Types+#else+import DynFlags import HscTypes+#endif import GHC.LanguageExtensions.Type import Data.List+import Data.List.Extra+import Data.Maybe+import qualified Data.Map as Map++-- | Parse a GHC extension.+readExtension :: String -> Maybe Extension+readExtension = (`Map.lookup` exts)+  where exts = Map.fromList [(show x, x) | x <- enumerate]++-- | Implicitly enabled/disabled extensions.+extensionImplications :: [(Extension, ([Extension], [Extension]))]+extensionImplications = map f $ Map.toList implicationsMap+  where+    f (e, ps) = (fromJust (readExtension e), ps)+    implicationsMap :: Map.Map String ([Extension], [Extension])+    implicationsMap = Map.fromListWith (<>)+      [(show a, ([c | b], [c | not b]))+        | (a, flag, c) <- impliedXFlags, let b = flag == turnOn]++-- Copied from 'ghc/compiler/main/DynFlags.hs'.++type TurnOnFlag = Bool   -- True  <=> we are turning the flag on+                         -- False <=> we are turning the flag off+turnOn  :: TurnOnFlag; turnOn  = True+turnOff :: TurnOnFlag; turnOff = False++-- General flags that are switched on/off when other general flags are switched+-- on+impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]+impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles)+                ,(Opt_DeferTypeErrors, turnOn, Opt_DeferOutOfScopeVariables)+                ,(Opt_Strictness, turnOn, Opt_WorkerWrapper)+                ,(Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)+                ,(Opt_UnclutterValidHoleFits, turnOff, Opt_ShowTypeAppVarsOfHoleFits)+                ,(Opt_UnclutterValidHoleFits, turnOff, Opt_ShowDocsOfHoleFits)+                ,(Opt_ShowTypeAppVarsOfHoleFits, turnOff, Opt_ShowTypeAppOfHoleFits)+                ,(Opt_UnclutterValidHoleFits, turnOff, Opt_ShowProvOfHoleFits)]++-- General flags that are switched on/off when other general flags are switched+-- off+impliedOffGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)]+impliedOffGFlags = [(Opt_Strictness, turnOff, Opt_WorkerWrapper)]++impliedXFlags :: [(LangExt.Extension, TurnOnFlag, LangExt.Extension)]+impliedXFlags+-- See Note [Updating flag description in the User's Guide]+  = [ (LangExt.RankNTypes,                turnOn, LangExt.ExplicitForAll)+    , (LangExt.QuantifiedConstraints,     turnOn, LangExt.ExplicitForAll)+    , (LangExt.ScopedTypeVariables,       turnOn, LangExt.ExplicitForAll)+    , (LangExt.LiberalTypeSynonyms,       turnOn, LangExt.ExplicitForAll)+    , (LangExt.ExistentialQuantification, turnOn, LangExt.ExplicitForAll)+    , (LangExt.FlexibleInstances,         turnOn, LangExt.TypeSynonymInstances)+    , (LangExt.FunctionalDependencies,    turnOn, LangExt.MultiParamTypeClasses)+    , (LangExt.MultiParamTypeClasses,     turnOn, LangExt.ConstrainedClassMethods)  -- c.f. #7854+    , (LangExt.TypeFamilyDependencies,    turnOn, LangExt.TypeFamilies)++    , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude)      -- NB: turn off!++    , (LangExt.DerivingVia, turnOn, LangExt.DerivingStrategies)++    , (LangExt.GADTs,            turnOn, LangExt.GADTSyntax)+    , (LangExt.GADTs,            turnOn, LangExt.MonoLocalBinds)+    , (LangExt.TypeFamilies,     turnOn, LangExt.MonoLocalBinds)++    , (LangExt.TypeFamilies,     turnOn, LangExt.KindSignatures)  -- Type families use kind signatures+    , (LangExt.PolyKinds,        turnOn, LangExt.KindSignatures)  -- Ditto polymorphic kinds++    -- TypeInType is now just a synonym for a couple of other extensions.+    , (LangExt.TypeInType,       turnOn, LangExt.DataKinds)+    , (LangExt.TypeInType,       turnOn, LangExt.PolyKinds)+    , (LangExt.TypeInType,       turnOn, LangExt.KindSignatures)++#if defined(GHCLIB_API_811) || defined(GHCLIB_API_810)+    -- Standalone kind signatures are a replacement for CUSKs.+    , (LangExt.StandaloneKindSignatures, turnOff, LangExt.CUSKs)+#endif++    -- AutoDeriveTypeable is not very useful without DeriveDataTypeable+    , (LangExt.AutoDeriveTypeable, turnOn, LangExt.DeriveDataTypeable)++    -- We turn this on so that we can export associated type+    -- type synonyms in subordinates (e.g. MyClass(type AssocType))+    , (LangExt.TypeFamilies,     turnOn, LangExt.ExplicitNamespaces)+    , (LangExt.TypeOperators, turnOn, LangExt.ExplicitNamespaces)++    , (LangExt.ImpredicativeTypes,  turnOn, LangExt.RankNTypes)++        -- Record wild-cards implies field disambiguation+        -- Otherwise if you write (C {..}) you may well get+        -- stuff like " 'a' not in scope ", which is a bit silly+        -- if the compiler has just filled in field 'a' of constructor 'C'+    , (LangExt.RecordWildCards,     turnOn, LangExt.DisambiguateRecordFields)++    , (LangExt.ParallelArrays, turnOn, LangExt.ParallelListComp)++    , (LangExt.JavaScriptFFI, turnOn, LangExt.InterruptibleFFI)++    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFunctor)+    , (LangExt.DeriveTraversable, turnOn, LangExt.DeriveFoldable)++    -- Duplicate record fields require field disambiguation+    , (LangExt.DuplicateRecordFields, turnOn, LangExt.DisambiguateRecordFields)++    , (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes)+    , (LangExt.Strict, turnOn, LangExt.StrictData)+  ]++--  parsePragmasIntoDynFlags :: DynFlags                          -> ([Extension], [Extension])

@@ -0,0 +1,26 @@+-- Copyright (c) 2020, Shayne Fletcher. All rights reserved.+-- SPDX-License-Identifier: BSD-3-Clause.++{-# LANGUAGE CPP #-}+#include "ghclib_api.h"+module Language.Haskell.GhclibParserEx.GHC.Hs.Decls(+    isNewType, isForD, isDerivD, isClsDefSig+  ) where++#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+import GHC.Hs+#else+import HsSyn+#endif+import SrcLoc++isNewType :: NewOrData -> Bool+isNewType NewType = True+isNewType DataType = False++isForD, isDerivD :: LHsDecl GhcPs -> Bool+isForD (L _ ForD{}) = True; isForD _ = False+isDerivD (L _ DerivD{}) = True; isDerivD _ = False++isClsDefSig :: Sig GhcPs -> Bool+isClsDefSig (ClassOpSig _ True _ _) = True; isClsDefSig _ = False

@@ -29,11 +29,6 @@ import BasicTypes import TysWiredIn -#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)-noExt :: NoExtField-noExt = noExtField-#endif- -- 'True' if the provided expression is a variable with name 'tag'. isTag :: String -> LHsExpr GhcPs -> Bool isTag tag = \case (L _ (HsVar _ (L _ s))) -> occNameString (rdrNameOcc s) == tag; _ -> False@@ -133,7 +128,11 @@ varToStr _ = ""  strToVar :: String -> LHsExpr GhcPs+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+strToVar x = noLoc $ HsVar noExtField (noLoc $ mkRdrUnqual (mkVarOcc x))+#else strToVar x = noLoc $ HsVar noExt (noLoc $ mkRdrUnqual (mkVarOcc x))+#endif  fromChar :: LHsExpr GhcPs -> Maybe Char fromChar = \case (L _ (HsLit _ (HsChar _ x))) -> Just x; _ -> Nothing

@@ -0,0 +1,100 @@+-- Copyright (c) 2020, Shayne Fletcher. All rights reserved.+-- SPDX-License-Identifier: BSD-3-Clause.++{-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-}+#include "ghclib_api.h"+module Language.Haskell.GhclibParserEx.GHC.Hs.Pat(+    patToStr, strToPat+  , fromPChar+  , hasPFieldsDotDot+  , isPFieldWildcard, isPWildcard, isPFieldPun, isPatTypeSig, isPBangPat, isPViewPat+ ) where++#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+import GHC.Hs+#else+import HsSyn+#endif+import SrcLoc+import TysWiredIn+import RdrName+import OccName+import FastString++patToStr :: LPat GhcPs -> String+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"+patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"+patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]"+patToStr _ = ""+#else+patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"+patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"+patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]"+patToStr _ = ""+#endif++strToPat :: String -> Pat GhcPs+strToPat z+  | z == "True"  = ConPatIn (noLoc true_RDR) (PrefixCon [])+  | z == "False" = ConPatIn (noLoc false_RDR) (PrefixCon [])+  | z == "[]"    = ConPatIn (noLoc $ nameRdrName nilDataConName) (PrefixCon [])+  | otherwise =+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+      VarPat noExtField (noLoc $ mkVarUnqual (fsLit z))+#else+      VarPat noExt (noLoc $ mkVarUnqual (fsLit z))+#endif++fromPChar :: LPat GhcPs -> Maybe Char+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+fromPChar (L _ (LitPat _ (HsChar _ x))) = Just x+#else+fromPChar (dL -> L _ (LitPat _ (HsChar _ x))) = Just x+#endif+fromPChar _ = Nothing++-- Contains a '..' as in 'Foo{..}'+hasPFieldsDotDot :: HsRecFields GhcPs (Pat GhcPs) -> Bool+hasPFieldsDotDot HsRecFields {rec_dotdot=Just _} = True+hasPFieldsDotDot _ = False++-- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'.+isPFieldWildcard :: LHsRecField GhcPs (Pat GhcPs) -> Bool+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+isPFieldWildcard (L _ HsRecField {hsRecFieldArg=WildPat _}) = True+isPFieldWildcard (L _ HsRecField {hsRecPun=True}) = True+isPFieldWildcard (L _ HsRecField {}) = False+#else+isPFieldWildcard (dL -> L _ HsRecField {hsRecFieldArg=WildPat _}) = True+isPFieldWildcard (dL -> L _ HsRecField {hsRecPun=True}) = True+isPFieldWildcard (dL -> L _ HsRecField {}) = False+#endif++isPWildcard :: LPat GhcPs -> Bool+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+isPWildcard (L _ (WildPat _)) = True+#else+isPWildcard (dL -> L _ (WildPat _)) = True+#endif+isPWildcard _ = False++isPFieldPun :: LHsRecField GhcPs (Pat GhcPs) -> Bool+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+isPFieldPun (L _ HsRecField {hsRecPun=True}) = True+#else+isPFieldPun (dL -> L _ HsRecField {hsRecPun=True}) = True+#endif+isPFieldPun _ = False++isPatTypeSig, isPBangPat, isPViewPat :: LPat GhcPs -> Bool+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+isPatTypeSig (L _ SigPat{}) = True; isPatTypeSig _ = False+isPBangPat (L _ BangPat{}) = True; isPBangPat _ = False+isPViewPat (L _ ViewPat{}) = True; isPViewPat _ = False+#else+isPatTypeSig (dL -> L _ SigPat{}) = True; isPatTypeSig _ = False+isPBangPat (dL -> L _ BangPat{}) = True; isPBangPat _ = False+isPViewPat (dL -> L _ ViewPat{}) = True; isPViewPat _ = False+#endif

@@ -0,0 +1,28 @@+-- Copyright (c) 2020, Shayne Fletcher. All rights reserved.+-- SPDX-License-Identifier: BSD-3-Clause.++{-# LANGUAGE CPP #-}+#include "ghclib_api.h"+module Language.Haskell.GhclibParserEx.GHC.Hs.Types(+    fromTyParen+  , isTyQuasiQuote, isUnboxedTuple+  ) where++#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+import GHC.Hs+#else+import HsSyn+#endif+import SrcLoc++fromTyParen :: LHsType GhcPs -> LHsType GhcPs+fromTyParen (L _ (HsParTy _ x)) = x+fromTyParen x = x++isTyQuasiQuote :: LHsType GhcPs -> Bool+isTyQuasiQuote (L _ (HsSpliceTy _ HsQuasiQuote{})) = True+isTyQuasiQuote _ = False++isUnboxedTuple :: HsTupleSort -> Bool+isUnboxedTuple HsUnboxedTuple = True+isUnboxedTuple _ = False

@@ -30,13 +30,21 @@ #else import HsSyn #endif+#if defined (GHCLIB_API_811)+import GHC.Driver.Session+#else import DynFlags+#endif import StringBuffer import Lexer import qualified Parser import FastString import SrcLoc+#if defined (GHCLIB_API_811)+import GHC.Driver.Backpack.Syntax+#else import BkpSyn+#endif #if defined (GHCLIB_API_811) import UnitInfo #else

@@ -7,11 +7,14 @@  import Test.Tasty import Test.Tasty.HUnit+import System.FilePath import System.Directory as Directory import System.Environment import qualified System.FilePath as FilePath import System.IO.Extra import Control.Monad+import Data.List+import Data.Maybe  import Language.Haskell.GhclibParserEx.Config import Language.Haskell.GhclibParserEx.DynFlags@@ -19,15 +22,25 @@ import Language.Haskell.GhclibParserEx.Dump import Language.Haskell.GhclibParserEx.Fixity import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances+import Language.Haskell.GhclibParserEx.GHC.Hs.Expr+import Language.Haskell.GhclibParserEx.GHC.Hs.Pat  #if defined (GHCLIB_API_811) || defined (GHCLIB_API_810) import GHC.Hs import RdrHsSyn+#else+import HsSyn #endif+import SrcLoc+#if defined (GHCLIB_API_811)+import GHC.Driver.Session+#else import DynFlags+#endif import Lexer import Outputable import ErrUtils+import GHC.LanguageExtensions.Type #if defined (GHCLIB_API_808) import Bag #endif@@ -39,8 +52,21 @@   defaultMain tests  tests :: TestTree-tests = testGroup " All tests" [parseTests, fixityTests, extendInstancesTests]+tests = testGroup " All tests"+  [ parseTests+  , fixityTests+  , extendInstancesTests+  , expressionPredicateTests+  , patternPredicateTests+  , dynFlagsTests+  ] +makeFile :: FilePath -> String -> IO FilePath+makeFile relPath contents = do+    Directory.createDirectoryIfMissing True $ FilePath.takeDirectory relPath+    writeFile relPath contents+    return relPath+ chkParseResult :: (DynFlags -> WarningMessages -> String) -> DynFlags -> ParseResult a -> IO () chkParseResult report flags = \case     POk s _ -> do@@ -55,8 +81,7 @@  parseTests :: TestTree parseTests = testGroup "Parse tests"-  [-    testCase "Module" $+  [ testCase "Module" $       chkParseResult report flags $         parseModule (unlines           [ "module Foo (readMany) where"@@ -94,8 +119,8 @@   , testCase "Declaration (2)" $ -- Example from https://github.com/ndmitchell/hlint/issues/842.       chkParseResult report flags $         parseDeclaration "infixr 4 <%@~" flags-  , testCase "File" $ do-      foo <- makeFile "Foo.hs" $ unlines+  , testCase "File" $ withTempDir $ \tmpDir -> do+      foo <- makeFile (tmpDir </> "Foo.hs") $ unlines         ["{-# LANGUAGE ScopedTypeVariables #-}"         , "module Foo (readMany) where"         , "import Data.List"@@ -111,12 +136,9 @@     flags = unsafeGlobalDynFlags     report flags msgs = concat [ showSDoc flags msg | msg <- pprErrMsgBagWithLoc msgs ] -fixityTests :: TestTree-fixityTests = testGroup "Fixity tests"-  [-    testCase "Expression" $ do-      let flags = defaultDynFlags fakeSettings fakeLlvmConfig-      case parseExpression "1 + 2 * 3" flags of+exprTest :: String -> DynFlags -> (LHsExpr GhcPs -> IO ()) -> IO ()+exprTest s flags test =+      case parseExpression s flags of #if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)         POk s e -> #else@@ -126,13 +148,33 @@           case unP (runECP_P e >>= \e -> return e) s :: ParseResult (LHsExpr GhcPs) of             POk _  e -> #endif-              assertBool "parse tree not affected" $-                showSDocUnsafe (showAstData BlankSrcSpan e) /=-                showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] e))+              test e #if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)-            PFailed{} -> assertFailure "ecp failure"+            _ -> assertFailure "parse error" #endif-        PFailed{} -> assertFailure "parse error"+        _ -> assertFailure "parse error"++patTest :: String -> DynFlags -> (LPat GhcPs -> IO ()) -> IO ()+patTest s flags test =+      case parsePattern s flags of+#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)+        POk _ e ->+#else+        POk _ e ->+#endif+              test e+        _ -> assertFailure "parse error"++fixityTests :: TestTree+fixityTests = testGroup "Fixity tests"+  [ testCase "Expression" $ do+      let flags = defaultDynFlags fakeSettings fakeLlvmConfig+      exprTest "1 + 2 * 3" flags+        (\e ->+            assertBool "parse tree not affected" $+              showSDocUnsafe (showAstData BlankSrcSpan e) /=+              showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] e))+        )   , testCase "Pattern" $ do       let flags = defaultDynFlags fakeSettings fakeLlvmConfig       case parseDeclaration "f (1 : 2 :[]) = 1" flags of@@ -143,39 +185,118 @@         PFailed{} -> assertFailure "parse error"   ] -makeFile :: FilePath -> String -> IO FilePath-makeFile relPath contents = do-    Directory.createDirectoryIfMissing True $ FilePath.takeDirectory relPath-    writeFile relPath contents-    return relPath- extendInstancesTests :: TestTree extendInstancesTests = testGroup "Extend instances tests"-  [-    testCase "Eq, Ord" $ do+  [ testCase "Eq, Ord" $ do       let flags = defaultDynFlags fakeSettings fakeLlvmConfig-      case parseExpression "1 + 2 * 3" flags of-#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)-        POk s e ->+      exprTest "1 + 2 * 3" flags+        (\e -> do+             e' <- return $ applyFixities [] e+             assertBool "astEq" $ astEq e e+             assertBool "astEq" $ not (astEq e e')+             e  <- return $ extendInstances e+             e' <- return $ extendInstances e'+             assertBool "==" $ e == e+             assertBool "/=" $ e /= e'+             assertBool "< " $ e' < e+             assertBool ">=" $ e  >= e'+          )+  ]++expressionPredicateTests :: TestTree+expressionPredicateTests = testGroup "Expression predicate tests"+  [ testCase "isTag" $ test "foo" $ assert' . isTag "foo"+  , testCase "isTag" $ test "bar" $ assert' . not . isTag "foo"+  , testCase "isDol" $ test "f $ x" $ \case L _ (OpApp _ _ op _) -> assert' $ isDol op; _ -> assertFailure "unexpected"+  , testCase "isDot" $ test "f . g" $ \case L _ (OpApp _ _ op _) -> assert' $ isDot op; _ -> assertFailure "unexpected"+  , testCase "isReturn" $ test "return x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected"+  , testCase "isReturn" $ test "pure x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected"+  , testCase "isSection" $ test "(1 +)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected"+  , testCase "isSection" $ test "(+ 1)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected"+  , testCase "isRecConstr" $ test "Foo {bar=1}" $ assert' . isRecConstr+  , testCase "isRecUpdate" $ test "foo {bar=1}" $ assert' . isRecUpdate+  , testCase "isVar" $ test "foo" $ assert' . isVar+  , testCase "isVar" $ test "3" $ assert' . not. isVar+  , testCase "isPar" $ test "(foo)" $ assert' . isPar+  , testCase "isPar" $ test "foo" $ assert' . not. isPar+  , testCase "isApp" $ test "f x" $ assert' . isApp+  , testCase "isApp" $ test "x" $ assert' . not . isApp+  , testCase "isOpApp" $ test "l `op` r" $ assert' . isOpApp+  , testCase "isOpApp" $ test "op l r" $ assert' . not . isOpApp+  , testCase "isAnyApp" $ test "l `op` r" $ assert' . isAnyApp+  , testCase "isAnyApp" $ test "f x" $ assert' . isAnyApp+  , testCase "isAnyApp" $ test "f x y" $ assert' . isAnyApp+  , testCase "isAnyApp" $ test "(f x y)" $ assert' . not . isAnyApp+  , testCase "isLexeme" $ test "foo" $ assert' . isLexeme+  , testCase "isLexeme" $ test "3" $ assert' . isLexeme+  , testCase "isLexeme" $ test "f x" $ assert' . not . isLexeme+  , testCase "isLambda" $ test "\\x -> 12" $ assert' . isLambda+  , testCase "isLambda" $ test "foo" $ assert' . not . isLambda+  , testCase "isDotApp" $ test "f . g" $ assert' . isDotApp+  , testCase "isDotApp" $ test "f $ g" $ assert' . not . isDotApp+  , testCase "isTypeApp" $ test "f @Int" $ assert' . isTypeApp+#if defined (GHCLIB_API_808)+  , testCase "isTypeApp" $ test "f @ Int" $ assert' . isTypeApp #else-        POk _ e ->-#endif-#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)-          case unP (runECP_P e >>= \e -> return e) s :: ParseResult (LHsExpr GhcPs) of-            POk _  e ->-#endif-              do-                e' <- return $ applyFixities [] e-                assertBool "astEq" $ astEq e e-                assertBool "astEq" $ not (astEq e e')-                e  <- return $ extendInstances e-                e' <- return $ extendInstances e'-                assertBool "==" $ e == e-                assertBool "/=" $ e /= e'-                assertBool "< " $ e' < e-                assertBool ">=" $ e  >= e'-#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)-            _ -> assertFailure "ecp failure"+  , testCase "isTypeApp" $ test "f @ Int" $ assert' . not . isTypeApp #endif-        _ -> assertFailure "parse error"+  , testCase "isTypeApp" $ test "f" $ assert' . not . isTypeApp+  , testCase "isWHNF" $ test "[]" $ assert' . isWHNF+  , testCase "isWHNF" $ test "[1, 2]" $ assert' . isWHNF+  , testCase "isWHNF" $ test "'f'" $ assert' . isWHNF+  , testCase "isWHNF" $ test "foo" $ assert' . not . isWHNF+  , testCase "isWHNF" $ test "42" $ assert' . not . isWHNF+  , testCase "isWHNF" $ test "\\foo -> []" $ assert' . isWHNF+  , testCase "isWHNF" $ test "(\\foo -> [])" $ assert' . isWHNF+  , testCase "isWHNF" $ test "(\\foo -> []) x" $ assert' . not . isWHNF+  , testCase "isWHNF" $ test "(42, \"foo\")" $ assert' . isWHNF+  , testCase "isWHNF" $ test "(42, \"foo\") :: (Int, String)" $ assert' . isWHNF+  , testCase "isWHNF" $ test "(\\x -> x * x) 3 :: Int" $ assert' . not . isWHNF+  , testCase "isWHNF" $ test "Just foo" $ assert' . isWHNF+  , testCase "isWHNF" $ test "Left foo" $ assert' . isWHNF+  , testCase "isWHNF" $ test "Right foo" $ assert' . isWHNF+  , testCase "isWHNF" $ test "POk s" $ assert' . not . isWHNF+  , testCase "isLCase" $ test "\\case _ -> False" $ assert' . isLCase+  , testCase "isLCase" $ test "case x of _ -> False" $ assert' . not . isLCase+  , testCase "isSpliceDecl" $ test "$x" $ assert' . isSpliceDecl . unLoc+  , testCase "isSpliceDecl" $ test "f$x" $ assert' . not . isSpliceDecl . unLoc+  , testCase "isSpliceDecl" $ test "$(a + b)" $ assert' . isSpliceDecl . unLoc+  , testCase "isQuasiQuote" $ test "[expr|1 + 2|]" $ assert' . isQuasiQuote+  , testCase "isQuasiQuote" $ test "[expr(1 + 2)]" $ assert' . not . isQuasiQuote+  , testCase "strToVar" $ assert' . isVar . strToVar $ "foo"+  , testCase "varToStr" $ test "[]" $ assert' . (== "[]") . varToStr+  , testCase "varToStr" $ test "foo" $ assert' . (== "foo") . varToStr+  , testCase "varToStr" $ test "3" $ assert' . null . varToStr+  ]+  where+    assert' = assertBool ""+    test s = exprTest s flags+    flags = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)+              [ TemplateHaskell, TemplateHaskellQuotes, QuasiQuotes, TypeApplications, LambdaCase ]++patternPredicateTests :: TestTree+patternPredicateTests = testGroup "Pattern predicate tests"+  [ testCase "patToStr" $ test "True" $ assert' . (== "True") . patToStr+  , testCase "patToStr" $ test "False" $ assert' . (== "False") . patToStr+  , testCase "patToStr" $ test "[]" $ assert' . (== "[]") . patToStr+  , testCase "strToPat" $ assert' . (== "True") . patToStr . noLoc . strToPat $ "True"+  , testCase "strToPat" $ assert' . (== "False") . patToStr . noLoc . strToPat $ "False"+  , testCase "strToPat" $ assert' . (== "[]") . patToStr . noLoc . strToPat $ "[]"+  , testCase "fromPChar" $ test "'a'" $ assert' . (== Just 'a') . fromPChar+  , testCase "fromPChar" $ test "\"a\"" $ assert' . isNothing . fromPChar+  ]+  where+    assert' = assertBool ""+    test s = patTest s flags+    flags = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)+              [ TemplateHaskell, QuasiQuotes, TypeApplications, LambdaCase ]++dynFlagsTests :: TestTree+dynFlagsTests = testGroup "DynFlags tests"+  [ testCase "readExtension" $ assertBool "parse DeriveTraversable" (readExtension "DeriveTraversable" == Just DeriveTraversable)+  , testCase "readExtension" $ assertBool "parse DeriveTravresable" (isNothing $ readExtension "DeriveTravresable")+  , testCase "extensionImplications" $ do+      Just (_, (es, ds)) <- return $ find (\(e, _) -> e == DeriveTraversable) extensionImplications+      assertBool "no extensions disabled" (null ds)+      assertBool "two extensions enabled" $ DeriveFunctor `elem` es && DeriveFoldable `elem` es   ]