ghc-check 0.5.0.3 → 0.5.0.4
raw patch · 4 files changed
+106/−26 lines, 4 filesdep +th-compatdep ~basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: th-compat
Dependency ranges changed: base
API changes (from Hackage documentation)
- GHC.Check: makeGhcVersionChecker :: IO FilePath -> TExpQ GhcVersionChecker
+ GHC.Check: makeGhcVersionChecker :: IO FilePath -> SpliceQ GhcVersionChecker
Files
- ghc-check.cabal +3/−1
- src/GHC/Check.hs +34/−12
- src/GHC/Check/PackageDb.hs +49/−6
- src/GHC/Check/Util.hs +20/−7
ghc-check.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.20 build-type: Simple name: ghc-check-version: 0.5.0.3+version: 0.5.0.4 synopsis: detect mismatches between compile-time and run-time versions of the ghc api description: detect mismatches between compile-time and run-time versions of the ghc api bug-reports: https://github.com/pepeiborra/ghc-check/issues@@ -32,8 +32,10 @@ process, safe-exceptions, template-haskell,+ th-compat >= 0.1.2, transformers hs-source-dirs: src+ ghc-options: -Wall default-language: Haskell2010 if flag(ghc-check-use-package-abis) cpp-options: -DUSE_PACKAGE_ABIS
src/GHC/Check.hs view
@@ -32,12 +32,13 @@ import Data.List.NonEmpty (NonEmpty, nonEmpty) import qualified Data.Map.Strict as Map import Data.Maybe-import Data.Version (Version)+import Data.Version (versionBranch, Version) import GHC (Ghc) import GHC.Check.Executable (getGhcVersion, guessExecutablePathFromLibdir) import GHC.Check.PackageDb (PackageVersion (..), getPackageVersion, version) import GHC.Check.Util (gcatchSafe, liftTyped)-import Language.Haskell.TH (TExpQ, runIO)+import qualified Language.Haskell.TH as TH+import Language.Haskell.TH.Syntax.Compat (examineSplice, liftSplice, SpliceQ) import System.Directory (doesDirectoryExist, doesFileExist) #if USE_PACKAGE_ABIS@@ -82,6 +83,7 @@ -- ^ Same version and abi deriving (Eq, Show) +isPackageCheckFailure :: PackageCheck -> Bool isPackageCheckFailure VersionMatch {} = False isPackageCheckFailure _ = True @@ -101,6 +103,14 @@ fmap catMaybes . mapM (\p -> fmap (p,) <$> getPackageVersion p) -- | Checks if the run-time version of the @ghc@ package matches the given version.+--+-- If the package database contains an unstable ghc library version,+-- we omit the package version check.+-- This leads to a more convenient usage for working on GHC.+-- When developing for or on GHC, you can compile GHC HEAD with a bootstrap compiler and+-- use the freshly compiled ghc library to load programs that use the latest GHC API.+-- We consider the ghc version to be unstable according to the+-- <https://downloads.haskell.org/~ghc/8.10.1/docs/html/users_guide/intro.html#ghc-version-numbering-policy GHC User Guide> checkGhcVersion :: [(String, PackageVersion)] -> GhcVersionChecker@@ -123,15 +133,26 @@ $ do runTimeVersions <- collectPackageVersions (map fst compileTimeVersions) let compares =- Map.intersectionWith- comparePackageVersions- compileTimeVersionsMap- (Map.fromList runTimeVersions)+ if isUnstableGhcVersion (lookup "ghc" runTimeVersions)+ then Map.empty+ else Map.intersectionWith+ comparePackageVersions+ compileTimeVersionsMap+ (Map.fromList runTimeVersions) failure = PackageCheckFailure <$> nonEmpty (Map.toList $ Map.filter isPackageCheckFailure compares) success = PackageCheckSuccess <$> nonEmpty (Map.toList compares) inconclusive = PackageCheckInconclusive (map fst compileTimeVersions) return $ fromMaybe inconclusive (failure <|> success)+ where+ -- | The ghc library version is unstable, if it has+ -- at least the form <x.y> and 'y' is odd.+ isUnstableGhcVersion :: Maybe PackageVersion -> Bool+ isUnstableGhcVersion Nothing = False+ isUnstableGhcVersion (Just ver) =+ case versionBranch (version ver) of+ (_: major: _minors) -> odd major+ _ -> False -- | @makeGhcVersionChecker libdir@ returns a function to check the run-time -- version of GHC against the compile-time version. It performs two checks:@@ -152,13 +173,14 @@ -- > setupGhcApi -- > result <- packageCheck -- > case guessCompatibility result of ...-makeGhcVersionChecker :: IO FilePath -> TExpQ GhcVersionChecker-makeGhcVersionChecker getLibdir = do- compileTimeVersions <- runIO $ compileTimeVersions getLibdir- [||checkGhcVersion $$(liftTyped compileTimeVersions)||]+makeGhcVersionChecker :: IO FilePath -> SpliceQ GhcVersionChecker+makeGhcVersionChecker getLibdir = liftSplice $ do+ compileTimeVersions <- TH.runIO $ getCompileTimeVersions getLibdir+ examineSplice [||checkGhcVersion $$(liftTyped compileTimeVersions)||] -compileTimeVersions :: IO FilePath -> IO [(String, PackageVersion)]-compileTimeVersions getLibdir = do++getCompileTimeVersions :: IO FilePath -> IO [(String, PackageVersion)]+getCompileTimeVersions getLibdir = do #if USE_PACKAGE_ABIS libdir <- getLibdir libdirExists <- doesDirectoryExist libdir
src/GHC/Check/PackageDb.hs view
@@ -1,4 +1,6 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveLift #-}+{-# OPTIONS_GHC -Wall #-} -- | Discover the GHC version via the package database. Requirements: -- -- * the package database must be compatible, which is usually not the case@@ -15,11 +17,26 @@ import Control.Monad.Trans.Class as Monad (MonadTrans (lift)) import Data.String (IsString (fromString)) import Data.Version (Version)+import Language.Haskell.TH.Syntax (Lift)+import Data.Foldable (find)+import Control.Applicative (Alternative((<|>)))+#if MIN_VERSION_ghc(9,0,1) import GHC+ (unitState, Ghc,+ getSessionDynFlags,+ )+import GHC.Data.Maybe (MaybeT (MaybeT), runMaybeT)+import GHC.Unit.Info (PackageName (PackageName))+import GHC.Unit.State+ (lookupUnit, explicitUnits, lookupUnitId,+ lookupPackageName, GenericUnitInfo (..), + UnitInfo, unitPackageNameString)+import GHC.Unit.Types (indefUnit)+#else+import GHC (pkgState, Ghc, getSessionDynFlags, )-import GHC.Check.Util import Maybes (MaybeT (MaybeT), runMaybeT) import Module (componentIdToInstalledUnitId) import PackageConfig (PackageName (PackageName))@@ -27,14 +44,14 @@ (lookupPackage, explicitPackages, lookupInstalledPackage, lookupPackageName )-import Packages (InstalledPackageInfo (..))+import Packages (InstalledPackageInfo (packageVersion, abiHash)) import Packages (PackageConfig)-import Language.Haskell.TH.Syntax (Lift)-import Data.Foldable (find) import Packages (packageNameString)-import Control.Applicative (Alternative((<|>)))+#endif import GHC.Stack (HasCallStack) +import GHC.Check.Util+ data PackageVersion = PackageVersion { myVersion :: !MyVersion,@@ -45,10 +62,35 @@ version :: PackageVersion -> Version version PackageVersion{ myVersion = MyVersion v} = v +#if MIN_VERSION_ghc(9,0,1) -- | @getPackageVersion p@ returns the version of package @p@ that will be used in the Ghc session. getPackageVersion :: String -> Ghc (Maybe PackageVersion) getPackageVersion pName = runMaybeT $ do dflags <- Monad.lift getSessionDynFlags+ let pkgst = unitState dflags+ depends = explicitUnits pkgst++ let explicit = do+ pkgs <- traverse (MaybeT . return . lookupUnit pkgst) depends+ MaybeT $ return $ find (\p -> unitPackageNameString p == pName ) pkgs++ notExplicit = do+ component <- MaybeT $ return $ lookupPackageName pkgst $ PackageName $ fromString pName+ MaybeT $ return $ lookupUnitId pkgst (indefUnit component)++ p <- explicit <|> notExplicit++ return $ fromPackageConfig p++fromPackageConfig :: UnitInfo -> PackageVersion+fromPackageConfig p = PackageVersion (MyVersion $ unitPackageVersion p) (Just $ unitAbiHash p)++#else++-- | @getPackageVersion p@ returns the version of package @p@ that will be used in the Ghc session.+getPackageVersion :: String -> Ghc (Maybe PackageVersion)+getPackageVersion pName = runMaybeT $ do+ dflags <- Monad.lift getSessionDynFlags let pkgst = pkgState dflags depends = explicitPackages pkgst @@ -66,6 +108,7 @@ fromPackageConfig :: PackageConfig -> PackageVersion fromPackageConfig p = PackageVersion (MyVersion $ packageVersion p) (Just $ abiHash p)+#endif fromVersionString :: HasCallStack => String -> PackageVersion-fromVersionString v = PackageVersion (read v) Nothing+fromVersionString v = PackageVersion (MyVersion $ read v) Nothing
src/GHC/Check/Util.hs view
@@ -4,13 +4,15 @@ {-# LANGUAGE CPP, TemplateHaskell #-} module GHC.Check.Util (MyVersion(..), liftTyped, gcatchSafe) where -import Control.Exception.Safe+import Control.Exception.Safe as Safe import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Version ( Version, parseVersion )-import GHC (Ghc, gcatch)+import GHC (Ghc)+import qualified GHC import GHC.Exts (IsList (fromList), toList) import Language.Haskell.TH ( TExpQ ) import Language.Haskell.TH.Syntax as TH+import Language.Haskell.TH.Syntax.Compat import qualified Text.Read as Read -- | A wrapper around 'Version' with TH lifting@@ -20,26 +22,37 @@ instance Lift MyVersion where #if MIN_VERSION_template_haskell(2,16,0) liftTyped = liftMyVersion-#endif+#else lift = unTypeQ . liftMyVersion+#endif+ -- lift = unTypeCode . liftMyVersion instance Read MyVersion where readPrec = Read.lift $ MyVersion <$> parseVersion +#if MIN_VERSION_template_haskell(2,17,0)+liftMyVersion :: (Quote m) => MyVersion -> Splice m MyVersion+#else liftMyVersion :: MyVersion -> TExpQ MyVersion-liftMyVersion ver = do- verLifted <- TH.lift (toList ver)- [|| fromList $$(pure $ TExp verLifted) ||]+#endif+liftMyVersion ver = liftSplice $ do+ verLifted <- liftQuote (toList ver)+ examineSplice [|| fromList $$( liftSplice . pure $ TExp verLifted)||] + #if !MIN_VERSION_template_haskell(2,16,0) liftTyped :: Lift a => a -> TExpQ a liftTyped = unsafeTExpCoerce . lift #endif gcatchSafe :: forall e a . Exception e => Ghc a -> (e -> Ghc a) -> Ghc a-gcatchSafe act h = act `gcatch` rethrowAsyncExceptions+#if MIN_VERSION_ghc(9,0,1)+gcatchSafe = Safe.catch+#else+gcatchSafe act h = act `GHC.gcatch` rethrowAsyncExceptions where rethrowAsyncExceptions :: e -> Ghc a rethrowAsyncExceptions e | isAsyncException e = liftIO . throwIO $ e | otherwise = h e+#endif