ghc-boot 8.8.3 → 9.0.1

raw patch · 10 files changed

+1346/−589 lines, 10 filesdep +containersdep ~basedep ~ghc-boot-thnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependency ranges changed: base, ghc-boot-th

API changes (from Hackage documentation)

Files

• GHC/BaseDir.hs +77/−0
• GHC/PackageDb.hs +0/−577
• GHC/Platform.hs +362/−0
• GHC/Platform/Host.hs +15/−0
• GHC/Settings/Platform.hs +99/−0
• GHC/Settings/Utils.hs +15/−0
• GHC/UniqueSubdir.hs +26/−0
• GHC/Unit/Database.hs +703/−0
• GHC/Version.hs +21/−0
• ghc-boot.cabal +28/−12

@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}++-- | Note [Base Dir]+-- ~~~~~~~~~~~~~~~~~+--+-- GHC's base directory or top directory containers miscellaneous settings and+-- the package database.  The main compiler of course needs this directory to+-- read those settings and read and write packages. ghc-pkg uses it to find the+-- global package database too.+--+-- In the interest of making GHC builds more relocatable, many settings also+-- will expand `${top_dir}` inside strings so GHC doesn't need to know it's on+-- installation location at build time. ghc-pkg also can expand those variables+-- and so needs the top dir location to do that too.+module GHC.BaseDir where++import Prelude -- See Note [Why do we import Prelude here?]++import Data.List+import System.FilePath++-- Windows+#if defined(mingw32_HOST_OS)+import System.Environment (getExecutablePath)+-- POSIX+#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)+import System.Environment (getExecutablePath)+#endif++-- | Expand occurrences of the @$topdir@ interpolation in a string.+expandTopDir :: FilePath -> String -> String+expandTopDir = expandPathVar "topdir"++-- | @expandPathVar var value str@+--+--   replaces occurrences of variable @$var@ with @value@ in str.+expandPathVar :: String -> FilePath -> String -> String+expandPathVar var value str+  | Just str' <- stripPrefix ('$':var) str+  , null str' || isPathSeparator (head str')+  = value ++ expandPathVar var value str'+expandPathVar var value (x:xs) = x : expandPathVar var value xs+expandPathVar _ _ [] = []++-- | Calculate the location of the base dir+getBaseDir :: IO (Maybe String)+#if defined(mingw32_HOST_OS)+getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath+  where+    -- locate the "base dir" when given the path+    -- to the real ghc executable (as opposed to symlink)+    -- that is running this function.+    rootDir :: FilePath -> FilePath+    rootDir = takeDirectory . takeDirectory . normalise+#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)+-- on unix, this is a bit more confusing.+-- The layout right now is something like+--+--   /bin/ghc-X.Y.Z <- wrapper script (1)+--   /bin/ghc       <- symlink to wrapper script (2)+--   /lib/ghc-X.Y.Z/bin/ghc <- ghc executable (3)+--   /lib/ghc-X.Y.Z <- $topdir (4)+--+-- As such, we first need to find the absolute location to the+-- binary.+--+-- getExecutablePath will return (3). One takeDirectory will+-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).+--+-- This of course only works due to the current layout. If+-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}+-- this would need to be changed accordingly.+--+getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath+#else+getBaseDir = return Nothing+#endif

@@ -1,577 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}--------------------------------------------------------------------------------- |--- Module      :  GHC.PackageDb--- Copyright   :  (c) The University of Glasgow 2009, Duncan Coutts 2014------ Maintainer  :  ghc-devs@haskell.org--- Portability :  portable------ This module provides the view of GHC's database of registered packages that--- is shared between GHC the compiler\/library, and the ghc-pkg program. It--- defines the database format that is shared between GHC and ghc-pkg.------ The database format, and this library are constructed so that GHC does not--- have to depend on the Cabal library. The ghc-pkg program acts as the--- gateway between the external package format (which is defined by Cabal) and--- the internal package format which is specialised just for GHC.------ GHC the compiler only needs some of the information which is kept about--- registerd packages, such as module names, various paths etc. On the other--- hand ghc-pkg has to keep all the information from Cabal packages and be able--- to regurgitate it for users and other tools.------ The first trick is that we duplicate some of the information in the package--- database. We essentially keep two versions of the datbase in one file, one--- version used only by ghc-pkg which keeps the full information (using the--- serialised form of the 'InstalledPackageInfo' type defined by the Cabal--- library); and a second version written by ghc-pkg and read by GHC which has--- just the subset of information that GHC needs.------ The second trick is that this module only defines in detail the format of--- the second version -- the bit GHC uses -- and the part managed by ghc-pkg--- is kept in the file but here we treat it as an opaque blob of data. That way--- this library avoids depending on Cabal.----module GHC.PackageDb (-       InstalledPackageInfo(..),-       DbModule(..),-       DbUnitId(..),-       BinaryStringRep(..),-       DbUnitIdModuleRep(..),-       emptyInstalledPackageInfo,-       PackageDbLock,-       lockPackageDb,-       unlockPackageDb,-       DbMode(..),-       DbOpenMode(..),-       isDbOpenReadMode,-       readPackageDbForGhc,-       readPackageDbForGhcPkg,-       writePackageDb-  ) where--import Prelude -- See note [Why do we import Prelude here?]-import Data.Version (Version(..))-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BS.Char8-import qualified Data.ByteString.Lazy as BS.Lazy-import qualified Data.ByteString.Lazy.Internal as BS.Lazy (defaultChunkSize)-import qualified Data.Foldable as F-import qualified Data.Traversable as F-import Data.Binary as Bin-import Data.Binary.Put as Bin-import Data.Binary.Get as Bin-import Control.Exception as Exception-import Control.Monad (when)-import System.FilePath-import System.IO-import System.IO.Error-import GHC.IO.Exception (IOErrorType(InappropriateType))-import GHC.IO.Handle.Lock-import System.Directory----- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits--- that GHC is interested in.  See Cabal's documentation for a more detailed--- description of all of the fields.----data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod-   = InstalledPackageInfo {-       unitId             :: instunitid,-       componentId        :: compid,-       instantiatedWith   :: [(modulename, mod)],-       sourcePackageId    :: srcpkgid,-       packageName        :: srcpkgname,-       packageVersion     :: Version,-       sourceLibName      :: Maybe srcpkgname,-       abiHash            :: String,-       depends            :: [instunitid],-       -- | Like 'depends', but each dependency is annotated with the-       -- ABI hash we expect the dependency to respect.-       abiDepends         :: [(instunitid, String)],-       importDirs         :: [FilePath],-       hsLibraries        :: [String],-       extraLibraries     :: [String],-       extraGHCiLibraries :: [String],-       libraryDirs        :: [FilePath],-       libraryDynDirs     :: [FilePath],-       frameworks         :: [String],-       frameworkDirs      :: [FilePath],-       ldOptions          :: [String],-       ccOptions          :: [String],-       includes           :: [String],-       includeDirs        :: [FilePath],-       haddockInterfaces  :: [FilePath],-       haddockHTMLs       :: [FilePath],-       exposedModules     :: [(modulename, Maybe mod)],-       hiddenModules      :: [modulename],-       indefinite         :: Bool,-       exposed            :: Bool,-       trusted            :: Bool-     }-  deriving (Eq, Show)---- | A convenience constraint synonym for common constraints over parameters--- to 'InstalledPackageInfo'.-type RepInstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =-    (BinaryStringRep srcpkgid, BinaryStringRep srcpkgname,-     BinaryStringRep modulename, BinaryStringRep compid,-     BinaryStringRep instunitid,-     DbUnitIdModuleRep instunitid compid unitid modulename mod)---- | A type-class for the types which can be converted into 'DbModule'/'DbUnitId'.--- There is only one type class because these types are mutually recursive.--- NB: The functional dependency helps out type inference in cases--- where types would be ambiguous.-class DbUnitIdModuleRep instunitid compid unitid modulename mod-    | mod -> unitid, unitid -> mod, mod -> modulename, unitid -> compid, unitid -> instunitid-    where-  fromDbModule :: DbModule instunitid compid unitid modulename mod -> mod-  toDbModule :: mod -> DbModule instunitid compid unitid modulename mod-  fromDbUnitId :: DbUnitId instunitid compid unitid modulename mod -> unitid-  toDbUnitId :: unitid -> DbUnitId instunitid compid unitid modulename mod---- | @ghc-boot@'s copy of 'Module', i.e. what is serialized to the database.--- Use 'DbUnitIdModuleRep' to convert it into an actual 'Module'.--- It has phantom type parameters as this is the most convenient way--- to avoid undecidable instances.-data DbModule instunitid compid unitid modulename mod-   = DbModule {-       dbModuleUnitId :: unitid,-       dbModuleName :: modulename-     }-   | DbModuleVar {-       dbModuleVarName :: modulename-     }-  deriving (Eq, Show)---- | @ghc-boot@'s copy of 'UnitId', i.e. what is serialized to the database.--- Use 'DbUnitIdModuleRep' to convert it into an actual 'UnitId'.--- It has phantom type parameters as this is the most convenient way--- to avoid undecidable instances.-data DbUnitId instunitid compid unitid modulename mod-   = DbUnitId compid [(modulename, mod)]-   | DbInstalledUnitId instunitid-  deriving (Eq, Show)--class BinaryStringRep a where-  fromStringRep :: BS.ByteString -> a-  toStringRep   :: a -> BS.ByteString--emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d e f g-                          => InstalledPackageInfo a b c d e f g-emptyInstalledPackageInfo =-  InstalledPackageInfo {-       unitId             = fromStringRep BS.empty,-       componentId        = fromStringRep BS.empty,-       instantiatedWith   = [],-       sourcePackageId    = fromStringRep BS.empty,-       packageName        = fromStringRep BS.empty,-       packageVersion     = Version [] [],-       sourceLibName      = Nothing,-       abiHash            = "",-       depends            = [],-       abiDepends         = [],-       importDirs         = [],-       hsLibraries        = [],-       extraLibraries     = [],-       extraGHCiLibraries = [],-       libraryDirs        = [],-       libraryDynDirs     = [],-       frameworks         = [],-       frameworkDirs      = [],-       ldOptions          = [],-       ccOptions          = [],-       includes           = [],-       includeDirs        = [],-       haddockInterfaces  = [],-       haddockHTMLs       = [],-       exposedModules     = [],-       hiddenModules      = [],-       indefinite         = False,-       exposed            = False,-       trusted            = False-  }---- | Represents a lock of a package db.-newtype PackageDbLock = PackageDbLock Handle---- | Acquire an exclusive lock related to package DB under given location.-lockPackageDb :: FilePath -> IO PackageDbLock---- | Release the lock related to package DB.-unlockPackageDb :: PackageDbLock -> IO ()---- | Acquire a lock of given type related to package DB under given location.-lockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock-lockPackageDbWith mode file = do-  -- We are trying to open the lock file and then lock it. Thus the lock file-  -- needs to either exist or we need to be able to create it. Ideally we-  -- would not assume that the lock file always exists in advance. When we are-  -- dealing with a package DB where we have write access then if the lock-  -- file does not exist then we can create it by opening the file in-  -- read/write mode. On the other hand if we are dealing with a package DB-  -- where we do not have write access (e.g. a global DB) then we can only-  -- open in read mode, and the lock file had better exist already or we're in-  -- trouble. So for global read-only DBs on platforms where we must lock the-  -- DB for reading then we will require that the installer/packaging has-  -- included the lock file.-  ---  -- Thus the logic here is to first try opening in read-write mode-  -- and if that fails we try read-only (to handle global read-only DBs).-  -- If either succeed then lock the file. IO exceptions (other than the first-  -- open attempt failing due to the file not existing) simply propagate.-  ---  -- Note that there is a complexity here which was discovered in #13945: some-  -- filesystems (e.g. NFS) will only allow exclusive locking if the fd was-  -- opened for write access. We would previously try opening the lockfile for-  -- read-only access first, however this failed when run on such filesystems.-  -- Consequently, we now try read-write access first, falling back to read-only-  -- if we are denied permission (e.g. in the case of a global database).-  catchJust-    (\e -> if isPermissionError e then Just () else Nothing)-    (lockFileOpenIn ReadWriteMode)-    (const $ lockFileOpenIn ReadMode)-  where-    lock = file <.> "lock"--    lockFileOpenIn io_mode = bracketOnError-      (openBinaryFile lock io_mode)-      hClose-      -- If file locking support is not available, ignore the error and proceed-      -- normally. Without it the only thing we lose on non-Windows platforms is-      -- the ability to safely issue concurrent updates to the same package db.-      $ \hnd -> do hLock hnd mode `catch` \FileLockingNotSupported -> return ()-                   return $ PackageDbLock hnd--lockPackageDb = lockPackageDbWith ExclusiveLock-unlockPackageDb (PackageDbLock hnd) = do-    hUnlock hnd-    hClose hnd---- | Mode to open a package db in.-data DbMode = DbReadOnly | DbReadWrite---- | 'DbOpenMode' holds a value of type @t@ but only in 'DbReadWrite' mode.  So--- it is like 'Maybe' but with a type argument for the mode to enforce that the--- mode is used consistently.-data DbOpenMode (mode :: DbMode) t where-  DbOpenReadOnly  ::      DbOpenMode 'DbReadOnly t-  DbOpenReadWrite :: t -> DbOpenMode 'DbReadWrite t--deriving instance Functor (DbOpenMode mode)-deriving instance F.Foldable (DbOpenMode mode)-deriving instance F.Traversable (DbOpenMode mode)--isDbOpenReadMode :: DbOpenMode mode t -> Bool-isDbOpenReadMode = \case-  DbOpenReadOnly    -> True-  DbOpenReadWrite{} -> False---- | Read the part of the package DB that GHC is interested in.----readPackageDbForGhc :: RepInstalledPackageInfo a b c d e f g =>-                       FilePath -> IO [InstalledPackageInfo a b c d e f g]-readPackageDbForGhc file =-  decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case-    (pkgs, DbOpenReadOnly) -> return pkgs-  where-    getDbForGhc = do-      _version    <- getHeader-      _ghcPartLen <- get :: Get Word32-      ghcPart     <- get-      -- the next part is for ghc-pkg, but we stop here.-      return ghcPart---- | Read the part of the package DB that ghc-pkg is interested in------ Note that the Binary instance for ghc-pkg's representation of packages--- is not defined in this package. This is because ghc-pkg uses Cabal types--- (and Binary instances for these) which this package does not depend on.------ If we open the package db in read only mode, we get its contents. Otherwise--- we additionally receive a PackageDbLock that represents a lock on the--- database, so that we can safely update it later.----readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t ->-                          IO (pkgs, DbOpenMode mode PackageDbLock)-readPackageDbForGhcPkg file mode =-    decodeFromFile file mode getDbForGhcPkg-  where-    getDbForGhcPkg = do-      _version    <- getHeader-      -- skip over the ghc part-      ghcPartLen  <- get :: Get Word32-      _ghcPart    <- skip (fromIntegral ghcPartLen)-      -- the next part is for ghc-pkg-      ghcPkgPart  <- get-      return ghcPkgPart---- | Write the whole of the package DB, both parts.----writePackageDb :: (Binary pkgs, RepInstalledPackageInfo a b c d e f g) =>-                  FilePath -> [InstalledPackageInfo a b c d e f g] ->-                  pkgs -> IO ()-writePackageDb file ghcPkgs ghcPkgPart =-  writeFileAtomic file (runPut putDbForGhcPkg)-  where-    putDbForGhcPkg = do-        putHeader-        put               ghcPartLen-        putLazyByteString ghcPart-        put               ghcPkgPart-      where-        ghcPartLen :: Word32-        ghcPartLen = fromIntegral (BS.Lazy.length ghcPart)-        ghcPart    = encode ghcPkgs--getHeader :: Get (Word32, Word32)-getHeader = do-    magic <- getByteString (BS.length headerMagic)-    when (magic /= headerMagic) $-      fail "not a ghc-pkg db file, wrong file magic number"--    majorVersion <- get :: Get Word32-    -- The major version is for incompatible changes--    minorVersion <- get :: Get Word32-    -- The minor version is for compatible extensions--    when (majorVersion /= 1) $-      fail "unsupported ghc-pkg db format version"-    -- If we ever support multiple major versions then we'll have to change-    -- this code--    -- The header can be extended without incrementing the major version,-    -- we ignore fields we don't know about (currently all).-    headerExtraLen <- get :: Get Word32-    skip (fromIntegral headerExtraLen)--    return (majorVersion, minorVersion)--putHeader :: Put-putHeader = do-    putByteString headerMagic-    put majorVersion-    put minorVersion-    put headerExtraLen-  where-    majorVersion   = 1 :: Word32-    minorVersion   = 0 :: Word32-    headerExtraLen = 0 :: Word32--headerMagic :: BS.ByteString-headerMagic = BS.Char8.pack "\0ghcpkg\0"----- TODO: we may be able to replace the following with utils from the binary--- package in future.---- | Feed a 'Get' decoder with data chunks from a file.----decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs ->-                  IO (pkgs, DbOpenMode mode PackageDbLock)-decodeFromFile file mode decoder = case mode of-  DbOpenReadOnly -> do-  -- When we open the package db in read only mode, there is no need to acquire-  -- shared lock on non-Windows platform because we update the database with an-  -- atomic rename, so readers will always see the database in a consistent-  -- state.-#if defined(mingw32_HOST_OS)-    bracket (lockPackageDbWith SharedLock file) unlockPackageDb $ \_ -> do-#endif-      (, DbOpenReadOnly) <$> decodeFileContents-  DbOpenReadWrite{} -> do-    -- When we open the package db in read/write mode, acquire an exclusive lock-    -- on the database and return it so we can keep it for the duration of the-    -- update.-    bracketOnError (lockPackageDb file) unlockPackageDb $ \lock -> do-      (, DbOpenReadWrite lock) <$> decodeFileContents-  where-    decodeFileContents = withBinaryFile file ReadMode $ \hnd ->-      feed hnd (runGetIncremental decoder)--    feed hnd (Partial k)  = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize-                               if BS.null chunk-                                 then feed hnd (k Nothing)-                                 else feed hnd (k (Just chunk))-    feed _ (Done _ _ res) = return res-    feed _ (Fail _ _ msg) = ioError err-      where-        err = mkIOError InappropriateType loc Nothing (Just file)-              `ioeSetErrorString` msg-        loc = "GHC.PackageDb.readPackageDb"---- Copied from Cabal's Distribution.Simple.Utils.-writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()-writeFileAtomic targetPath content = do-  let (targetDir, targetFile) = splitFileName targetPath-  Exception.bracketOnError-    (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp")-    (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)-    (\(tmpPath, handle) -> do-        BS.Lazy.hPut handle content-        hClose handle-        renameFile tmpPath targetPath)--instance (RepInstalledPackageInfo a b c d e f g) =>-         Binary (InstalledPackageInfo a b c d e f g) where-  put (InstalledPackageInfo-         unitId componentId instantiatedWith sourcePackageId-         packageName packageVersion-         sourceLibName-         abiHash depends abiDepends importDirs-         hsLibraries extraLibraries extraGHCiLibraries-         libraryDirs libraryDynDirs-         frameworks frameworkDirs-         ldOptions ccOptions-         includes includeDirs-         haddockInterfaces haddockHTMLs-         exposedModules hiddenModules-         indefinite exposed trusted) = do-    put (toStringRep sourcePackageId)-    put (toStringRep packageName)-    put packageVersion-    put (fmap toStringRep sourceLibName)-    put (toStringRep unitId)-    put (toStringRep componentId)-    put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod))-             instantiatedWith)-    put abiHash-    put (map toStringRep depends)-    put (map (\(k,v) -> (toStringRep k, v)) abiDepends)-    put importDirs-    put hsLibraries-    put extraLibraries-    put extraGHCiLibraries-    put libraryDirs-    put libraryDynDirs-    put frameworks-    put frameworkDirs-    put ldOptions-    put ccOptions-    put includes-    put includeDirs-    put haddockInterfaces-    put haddockHTMLs-    put (map (\(mod_name, mb_mod) -> (toStringRep mod_name, fmap toDbModule mb_mod))-             exposedModules)-    put (map toStringRep hiddenModules)-    put indefinite-    put exposed-    put trusted--  get = do-    sourcePackageId    <- get-    packageName        <- get-    packageVersion     <- get-    sourceLibName      <- get-    unitId             <- get-    componentId        <- get-    instantiatedWith   <- get-    abiHash            <- get-    depends            <- get-    abiDepends         <- get-    importDirs         <- get-    hsLibraries        <- get-    extraLibraries     <- get-    extraGHCiLibraries <- get-    libraryDirs        <- get-    libraryDynDirs     <- get-    frameworks         <- get-    frameworkDirs      <- get-    ldOptions          <- get-    ccOptions          <- get-    includes           <- get-    includeDirs        <- get-    haddockInterfaces  <- get-    haddockHTMLs       <- get-    exposedModules     <- get-    hiddenModules      <- get-    indefinite         <- get-    exposed            <- get-    trusted            <- get-    return (InstalledPackageInfo-              (fromStringRep unitId)-              (fromStringRep componentId)-              (map (\(mod_name, mod) -> (fromStringRep mod_name, fromDbModule mod))-                instantiatedWith)-              (fromStringRep sourcePackageId)-              (fromStringRep packageName) packageVersion-              (fmap fromStringRep sourceLibName)-              abiHash-              (map fromStringRep depends)-              (map (\(k,v) -> (fromStringRep k, v)) abiDepends)-              importDirs-              hsLibraries extraLibraries extraGHCiLibraries-              libraryDirs libraryDynDirs-              frameworks frameworkDirs-              ldOptions ccOptions-              includes includeDirs-              haddockInterfaces haddockHTMLs-              (map (\(mod_name, mb_mod) ->-                        (fromStringRep mod_name, fmap fromDbModule mb_mod))-                   exposedModules)-              (map fromStringRep hiddenModules)-              indefinite exposed trusted)--instance (BinaryStringRep modulename, BinaryStringRep compid,-          BinaryStringRep instunitid,-          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>-         Binary (DbModule instunitid compid unitid modulename mod) where-  put (DbModule dbModuleUnitId dbModuleName) = do-    putWord8 0-    put (toDbUnitId dbModuleUnitId)-    put (toStringRep dbModuleName)-  put (DbModuleVar dbModuleVarName) = do-    putWord8 1-    put (toStringRep dbModuleVarName)-  get = do-    b <- getWord8-    case b of-      0 -> do dbModuleUnitId <- get-              dbModuleName <- get-              return (DbModule (fromDbUnitId dbModuleUnitId)-                               (fromStringRep dbModuleName))-      _ -> do dbModuleVarName <- get-              return (DbModuleVar (fromStringRep dbModuleVarName))--instance (BinaryStringRep modulename, BinaryStringRep compid,-          BinaryStringRep instunitid,-          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>-         Binary (DbUnitId instunitid compid unitid modulename mod) where-  put (DbInstalledUnitId instunitid) = do-    putWord8 0-    put (toStringRep instunitid)-  put (DbUnitId dbUnitIdComponentId dbUnitIdInsts) = do-    putWord8 1-    put (toStringRep dbUnitIdComponentId)-    put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod)) dbUnitIdInsts)-  get = do-    b <- getWord8-    case b of-      0 -> do-        instunitid <- get-        return (DbInstalledUnitId (fromStringRep instunitid))-      _ -> do-        dbUnitIdComponentId <- get-        dbUnitIdInsts <- get-        return (DbUnitId-            (fromStringRep dbUnitIdComponentId)-            (map (\(mod_name, mod) -> ( fromStringRep mod_name-                                      , fromDbModule mod))-                 dbUnitIdInsts))

@@ -0,0 +1,362 @@+{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}++-- | A description of the platform we're compiling for.+--+module GHC.Platform+   ( PlatformMini(..)+   , PlatformWordSize(..)+   , Platform(..)+   , platformArch+   , platformOS+   , Arch(..)+   , OS(..)+   , ArmISA(..)+   , ArmISAExt(..)+   , ArmABI(..)+   , PPC_64ABI(..)+   , ByteOrder(..)+   , target32Bit+   , isARM+   , osElfTarget+   , osMachOTarget+   , osSubsectionsViaSymbols+   , platformUsesFrameworks+   , platformWordSizeInBytes+   , platformWordSizeInBits+   , platformMinInt+   , platformMaxInt+   , platformMaxWord+   , platformInIntRange+   , platformInWordRange+   , platformCConvNeedsExtension+   , PlatformMisc(..)+   , stringEncodeArch+   , stringEncodeOS+   , SseVersion (..)+   , BmiVersion (..)+   )+where++import Prelude -- See Note [Why do we import Prelude here?]+import GHC.Read+import GHC.ByteOrder (ByteOrder(..))+import Data.Word+import Data.Int++-- | Contains the bare-bones arch and os information. This isn't enough for+-- code gen, but useful for tasks where we can fall back upon the host+-- platform, as this is all we know about the host platform.+data PlatformMini+  = PlatformMini+    { platformMini_arch :: Arch+    , platformMini_os :: OS+    }+    deriving (Read, Show, Eq)++-- | Contains enough information for the native code generator to emit+-- code for this platform.+data Platform = Platform+   { platformMini                     :: !PlatformMini+   , platformWordSize                 :: !PlatformWordSize -- ^ Word size+   , platformByteOrder                :: !ByteOrder        -- ^ Byte order (endianness)+   , platformUnregisterised           :: !Bool+   , platformHasGnuNonexecStack       :: !Bool+   , platformHasIdentDirective        :: !Bool+   , platformHasSubsectionsViaSymbols :: !Bool+   , platformIsCrossCompiling         :: !Bool+   , platformLeadingUnderscore        :: !Bool             -- ^ Symbols need underscore prefix+   , platformTablesNextToCode         :: !Bool+      -- ^ Determines whether we will be compiling info tables that reside just+      --   before the entry code, or with an indirection to the entry code. See+      --   TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.+   }+   deriving (Read, Show, Eq)++data PlatformWordSize+  = PW4 -- ^ A 32-bit platform+  | PW8 -- ^ A 64-bit platform+  deriving (Eq)++instance Show PlatformWordSize where+  show PW4 = "4"+  show PW8 = "8"++instance Read PlatformWordSize where+  readPrec = do+    i :: Int <- readPrec+    case i of+      4 -> return PW4+      8 -> return PW8+      other -> fail ("Invalid PlatformWordSize: " ++ show other)++platformWordSizeInBytes :: Platform -> Int+platformWordSizeInBytes p =+    case platformWordSize p of+      PW4 -> 4+      PW8 -> 8++platformWordSizeInBits :: Platform -> Int+platformWordSizeInBits p = platformWordSizeInBytes p * 8++-- | Legacy accessor+platformArch :: Platform -> Arch+platformArch = platformMini_arch . platformMini++-- | Legacy accessor+platformOS :: Platform -> OS+platformOS = platformMini_os . platformMini++-- | Architectures that the native code generator knows about.+--      TODO: It might be nice to extend these constructors with information+--      about what instruction set extensions an architecture might support.+--+data Arch+        = ArchUnknown+        | ArchX86+        | ArchX86_64+        | ArchPPC+        | ArchPPC_64+          { ppc_64ABI :: PPC_64ABI+          }+        | ArchS390X+        | ArchSPARC+        | ArchSPARC64+        | ArchARM+          { armISA    :: ArmISA+          , armISAExt :: [ArmISAExt]+          , armABI    :: ArmABI+          }+        | ArchAArch64+        | ArchAlpha+        | ArchMipseb+        | ArchMipsel+        | ArchJavaScript+        deriving (Read, Show, Eq)++-- Note [Platform Syntax]+-- ~~~~~~~~~~~~~~~~~~~~~~+-- There is a very loose encoding of platforms shared by many tools we are+-- encoding to here. GNU Config (http://git.savannah.gnu.org/cgit/config.git),+-- and LLVM's http://llvm.org/doxygen/classllvm_1_1Triple.html are perhaps the+-- most definitional parsers. The basic syntax is a list of '-'-separated+-- components. The Unix 'uname' command syntax is related but briefer.+--+-- Those two parsers are quite forgiving, and even the 'config.sub'+-- normalization is forgiving too. The "best" way to encode a platform is+-- therefore somewhat a matter of taste.+--+-- The 'stringEncode*' functions here convert each part of GHC's structured+-- notion of a platform into one dash-separated component.++-- | See Note [Platform Syntax].+stringEncodeArch :: Arch -> String+stringEncodeArch = \case+  ArchUnknown -> "unknown"+  ArchX86 -> "i386"+  ArchX86_64 -> "x86_64"+  ArchPPC -> "powerpc"+  ArchPPC_64 { ppc_64ABI = abi } -> case abi of+    ELF_V1 -> "powerpc64"+    ELF_V2 -> "powerpc64le"+  ArchS390X -> "s390x"+  ArchSPARC -> "sparc"+  ArchSPARC64 -> "sparc64"+  ArchARM { armISA = isa, armISAExt = _, armABI = _ } -> "arm" ++ vsuf+    where+      vsuf = case isa of+        ARMv5 -> "v5"+        ARMv6 -> "v6"+        ARMv7 -> "v7"+  ArchAArch64 -> "aarch64"+  ArchAlpha -> "alpha"+  ArchMipseb -> "mipseb"+  ArchMipsel -> "mipsel"+  ArchJavaScript -> "js"++isARM :: Arch -> Bool+isARM (ArchARM {}) = True+isARM ArchAArch64  = True+isARM _ = False++-- | Operating systems that the native code generator knows about.+--      Having OSUnknown should produce a sensible default, but no promises.+data OS+        = OSUnknown+        | OSLinux+        | OSDarwin+        | OSSolaris2+        | OSMinGW32+        | OSFreeBSD+        | OSDragonFly+        | OSOpenBSD+        | OSNetBSD+        | OSKFreeBSD+        | OSHaiku+        | OSQNXNTO+        | OSAIX+        | OSHurd+        deriving (Read, Show, Eq)++-- | See Note [Platform Syntax].+stringEncodeOS :: OS -> String+stringEncodeOS = \case+  OSUnknown -> "unknown"+  OSLinux -> "linux"+  OSDarwin -> "darwin"+  OSSolaris2 -> "solaris2"+  OSMinGW32 -> "mingw32"+  OSFreeBSD -> "freebsd"+  OSDragonFly -> "dragonfly"+  OSOpenBSD -> "openbsd"+  OSNetBSD -> "netbsd"+  OSKFreeBSD -> "kfreebsdgnu"+  OSHaiku -> "haiku"+  OSQNXNTO -> "nto-qnx"+  OSAIX -> "aix"+  OSHurd -> "hurd"++-- | ARM Instruction Set Architecture, Extensions and ABI+--+data ArmISA+    = ARMv5+    | ARMv6+    | ARMv7+    deriving (Read, Show, Eq)++data ArmISAExt+    = VFPv2+    | VFPv3+    | VFPv3D16+    | NEON+    | IWMMX2+    deriving (Read, Show, Eq)++data ArmABI+    = SOFT+    | SOFTFP+    | HARD+    deriving (Read, Show, Eq)++-- | PowerPC 64-bit ABI+--+data PPC_64ABI+    = ELF_V1+    | ELF_V2+    deriving (Read, Show, Eq)++-- | This predicate tells us whether the platform is 32-bit.+target32Bit :: Platform -> Bool+target32Bit p =+    case platformWordSize p of+      PW4 -> True+      PW8 -> False++-- | This predicate tells us whether the OS supports ELF-like shared libraries.+osElfTarget :: OS -> Bool+osElfTarget OSLinux     = True+osElfTarget OSFreeBSD   = True+osElfTarget OSDragonFly = True+osElfTarget OSOpenBSD   = True+osElfTarget OSNetBSD    = True+osElfTarget OSSolaris2  = True+osElfTarget OSDarwin    = False+osElfTarget OSMinGW32   = False+osElfTarget OSKFreeBSD  = True+osElfTarget OSHaiku     = True+osElfTarget OSQNXNTO    = False+osElfTarget OSAIX       = False+osElfTarget OSHurd      = True+osElfTarget OSUnknown   = False+ -- Defaulting to False is safe; it means don't rely on any+ -- ELF-specific functionality.  It is important to have a default for+ -- portability, otherwise we have to answer this question for every+ -- new platform we compile on (even unreg).++-- | This predicate tells us whether the OS support Mach-O shared libraries.+osMachOTarget :: OS -> Bool+osMachOTarget OSDarwin = True+osMachOTarget _ = False++osUsesFrameworks :: OS -> Bool+osUsesFrameworks OSDarwin = True+osUsesFrameworks _        = False++platformUsesFrameworks :: Platform -> Bool+platformUsesFrameworks = osUsesFrameworks . platformOS++osSubsectionsViaSymbols :: OS -> Bool+osSubsectionsViaSymbols OSDarwin = True+osSubsectionsViaSymbols _        = False++-- | Platform-specific settings formerly hard-coded in Config.hs.+--+-- These should probably be all be triaged whether they can be computed from+-- other settings or belong in another another place (like 'Platform' above).+data PlatformMisc = PlatformMisc+  { -- TODO Recalculate string from richer info?+    platformMisc_targetPlatformString :: String+  , platformMisc_ghcWithInterpreter   :: Bool+  , platformMisc_ghcWithSMP           :: Bool+  , platformMisc_ghcRTSWays           :: String+  , platformMisc_libFFI               :: Bool+  , platformMisc_ghcThreaded          :: Bool+  , platformMisc_ghcDebugged          :: Bool+  , platformMisc_ghcRtsWithLibdw      :: Bool+  , platformMisc_llvmTarget           :: String+  }++-- | Minimum representable Int value for the given platform+platformMinInt :: Platform -> Integer+platformMinInt p = case platformWordSize p of+   PW4 -> toInteger (minBound :: Int32)+   PW8 -> toInteger (minBound :: Int64)++-- | Maximum representable Int value for the given platform+platformMaxInt :: Platform -> Integer+platformMaxInt p = case platformWordSize p of+   PW4 -> toInteger (maxBound :: Int32)+   PW8 -> toInteger (maxBound :: Int64)++-- | Maximum representable Word value for the given platform+platformMaxWord :: Platform -> Integer+platformMaxWord p = case platformWordSize p of+   PW4 -> toInteger (maxBound :: Word32)+   PW8 -> toInteger (maxBound :: Word64)++-- | Test if the given Integer is representable with a platform Int+platformInIntRange :: Platform -> Integer -> Bool+platformInIntRange platform x = x >= platformMinInt platform && x <= platformMaxInt platform++-- | Test if the given Integer is representable with a platform Word+platformInWordRange :: Platform -> Integer -> Bool+platformInWordRange platform x = x >= 0 && x <= platformMaxWord platform++-- | For some architectures the C calling convention is that any+-- integer shorter than 64 bits is replaced by its 64 bits+-- representation using sign or zero extension.+platformCConvNeedsExtension :: Platform -> Bool+platformCConvNeedsExtension platform = case platformArch platform of+  ArchPPC_64 _ -> True+  ArchS390X    -> True+  _            -> False+++--------------------------------------------------+-- Instruction sets+--------------------------------------------------++-- | x86 SSE instructions+data SseVersion+   = SSE1+   | SSE2+   | SSE3+   | SSE4+   | SSE42+   deriving (Eq, Ord)++-- | x86 BMI (bit manipulation) instructions+data BmiVersion+   = BMI1+   | BMI2+   deriving (Eq, Ord)+

@@ -0,0 +1,15 @@+module GHC.Platform.Host where++import GHC.Platform++cHostPlatformArch :: Arch+cHostPlatformArch = ArchX86_64++cHostPlatformOS   :: OS+cHostPlatformOS   = OSLinux++cHostPlatformMini :: PlatformMini+cHostPlatformMini = PlatformMini+  { platformMini_arch = cHostPlatformArch+  , platformMini_os = cHostPlatformOS+  }

@@ -0,0 +1,99 @@+-- Note [Settings file]+-- ~~~~~~~~~~~~~~~~~~~~+--+-- GHC has a file, `${top_dir}/settings`, which is the main source of run-time+-- configuration. ghc-pkg needs just a little bit of it: the target platform CPU+-- arch and OS. It uses that to figure out what subdirectory of `~/.ghc` is+-- associated with the current version/target.+--+-- This module has just enough code to read key value pairs from the settings+-- file, and read the target platform from those pairs.+--+-- The  "0" suffix is because the caller will partially apply it, and that will+-- in turn be used a few more times.+module GHC.Settings.Platform where++import Prelude -- See Note [Why do we import Prelude here?]++import GHC.BaseDir+import GHC.Platform+import GHC.Settings.Utils++import Data.Map (Map)+import qualified Data.Map as Map++-----------------------------------------------------------------------------+-- parts of settings file++getTargetPlatform+  :: FilePath -> RawSettings -> Either String Platform+getTargetPlatform settingsFile mySettings = do+  let+    getBooleanSetting = getBooleanSetting0 settingsFile mySettings+    readSetting :: (Show a, Read a) => String -> Either String a+    readSetting = readSetting0 settingsFile mySettings++  targetArch <- readSetting "target arch"+  targetOS <- readSetting "target os"+  targetWordSize <- readSetting "target word size"+  targetWordBigEndian <- getBooleanSetting "target word big endian"+  targetLeadingUnderscore <- getBooleanSetting "Leading underscore"+  targetUnregisterised <- getBooleanSetting "Unregisterised"+  targetHasGnuNonexecStack <- getBooleanSetting "target has GNU nonexec stack"+  targetHasIdentDirective <- getBooleanSetting "target has .ident directive"+  targetHasSubsectionsViaSymbols <- getBooleanSetting "target has subsections via symbols"+  crossCompiling <- getBooleanSetting "cross compiling"+  tablesNextToCode <- getBooleanSetting "Tables next to code"++  pure $ Platform+    { platformMini = PlatformMini+      { platformMini_arch = targetArch+      , platformMini_os = targetOS+      }+    , platformWordSize = targetWordSize+    , platformByteOrder = if targetWordBigEndian then BigEndian else LittleEndian+    , platformUnregisterised = targetUnregisterised+    , platformHasGnuNonexecStack = targetHasGnuNonexecStack+    , platformHasIdentDirective = targetHasIdentDirective+    , platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols+    , platformIsCrossCompiling = crossCompiling+    , platformLeadingUnderscore = targetLeadingUnderscore+    , platformTablesNextToCode  = tablesNextToCode+    }++-----------------------------------------------------------------------------+-- settings file helpers++type RawSettings = Map String String++-- | See Note [Settings file] for "0" suffix+getSetting0+  :: FilePath -> RawSettings -> String -> Either String String+getSetting0 settingsFile mySettings key = case Map.lookup key mySettings of+  Just xs -> Right xs+  Nothing -> Left $ "No entry for " ++ show key ++ " in " ++ show settingsFile++-- | See Note [Settings file] for "0" suffix+getFilePathSetting0+  :: FilePath -> FilePath -> RawSettings -> String -> Either String String+getFilePathSetting0 top_dir settingsFile mySettings key =+  expandTopDir top_dir <$> getSetting0 settingsFile mySettings key++-- | See Note [Settings file] for "0" suffix+getBooleanSetting0+  :: FilePath -> RawSettings -> String -> Either String Bool+getBooleanSetting0 settingsFile mySettings key = do+  rawValue <- getSetting0 settingsFile mySettings key+  case rawValue of+    "YES" -> Right True+    "NO" -> Right False+    xs -> Left $ "Bad value for " ++ show key ++ ": " ++ show xs++-- | See Note [Settings file] for "0" suffix+readSetting0+  :: (Show a, Read a) => FilePath -> RawSettings -> String -> Either String a+readSetting0 settingsFile mySettings key = case Map.lookup key mySettings of+  Just xs -> case maybeRead xs of+    Just v -> Right v+    Nothing -> Left $ "Failed to read " ++ show key ++ " value " ++ show xs+  Nothing -> Left $ "No entry for " ++ show key ++ " in " ++ show settingsFile

@@ -0,0 +1,15 @@+module GHC.Settings.Utils where++import Prelude -- See Note [Why do we import Prelude here?]++import Data.Char (isSpace)++maybeRead :: Read a => String -> Maybe a+maybeRead str = case reads str of+  [(x, "")] -> Just x+  _ -> Nothing++maybeReadFuzzy :: Read a => String -> Maybe a+maybeReadFuzzy str = case reads str of+  [(x, s)] | all isSpace s -> Just x+  _ -> Nothing

@@ -0,0 +1,26 @@+module GHC.UniqueSubdir+  ( uniqueSubdir+  ) where++import Prelude -- See Note [Why do we import Prelude here?]++import Data.List (intercalate)++import GHC.Platform+import GHC.Version (cProjectVersion)++-- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when+-- constructing platform-version-dependent files that need to co-exist.+--+-- 'ghc-pkg' falls back on the host platform if the settings file is missing,+-- and so needs this since we don't have information about the host platform in+-- as much detail as 'Platform', so we use 'PlatformMini' instead.+uniqueSubdir :: PlatformMini -> FilePath+uniqueSubdir archOs = intercalate "-"+  [ stringEncodeArch $ platformMini_arch archOs+  , stringEncodeOS $ platformMini_os archOs+  , cProjectVersion+  ]+  -- NB: This functionality is reimplemented in Cabal, so if you+  -- change it, be sure to update Cabal.+  -- TODO make Cabal use this now that it is in ghc-boot.

@@ -0,0 +1,703 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE RecordWildCards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Unit.Database+-- Copyright   :  (c) The University of Glasgow 2009, Duncan Coutts 2014+--+-- Maintainer  :  ghc-devs@haskell.org+-- Portability :  portable+--+-- This module provides the view of GHC's database of registered packages that+-- is shared between GHC the compiler\/library, and the ghc-pkg program. It+-- defines the database format that is shared between GHC and ghc-pkg.+--+-- The database format, and this library are constructed so that GHC does not+-- have to depend on the Cabal library. The ghc-pkg program acts as the+-- gateway between the external package format (which is defined by Cabal) and+-- the internal package format which is specialised just for GHC.+--+-- GHC the compiler only needs some of the information which is kept about+-- registered packages, such as module names, various paths etc. On the other+-- hand ghc-pkg has to keep all the information from Cabal packages and be able+-- to regurgitate it for users and other tools.+--+-- The first trick is that we duplicate some of the information in the package+-- database. We essentially keep two versions of the database in one file, one+-- version used only by ghc-pkg which keeps the full information (using the+-- serialised form of the 'InstalledPackageInfo' type defined by the Cabal+-- library); and a second version written by ghc-pkg and read by GHC which has+-- just the subset of information that GHC needs.+--+-- The second trick is that this module only defines in detail the format of+-- the second version -- the bit GHC uses -- and the part managed by ghc-pkg+-- is kept in the file but here we treat it as an opaque blob of data. That way+-- this library avoids depending on Cabal.+--+module GHC.Unit.Database+   ( GenericUnitInfo(..)+   , type DbUnitInfo+   , DbModule (..)+   , DbInstUnitId (..)+   , mapGenericUnitInfo+   -- * Read and write+   , DbMode(..)+   , DbOpenMode(..)+   , isDbOpenReadMode+   , readPackageDbForGhc+   , readPackageDbForGhcPkg+   , writePackageDb+   -- * Locking+   , PackageDbLock+   , lockPackageDb+   , unlockPackageDb+   -- * Misc+   , mkMungePathUrl+   , mungeUnitInfoPaths+   )+where++import Prelude -- See note [Why do we import Prelude here?]+import Data.Version (Version(..))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS.Char8+import qualified Data.ByteString.Lazy as BS.Lazy+import qualified Data.ByteString.Lazy.Internal as BS.Lazy (defaultChunkSize)+import qualified Data.Foldable as F+import qualified Data.Traversable as F+import Data.Bifunctor+import Data.Binary as Bin+import Data.Binary.Put as Bin+import Data.Binary.Get as Bin+import Control.Exception as Exception+import Control.Monad (when)+import System.FilePath as FilePath+import qualified System.FilePath.Posix as FilePath.Posix+import System.IO+import System.IO.Error+import GHC.IO.Exception (IOErrorType(InappropriateType))+import GHC.IO.Handle.Lock+import System.Directory+import Data.List (stripPrefix)++-- | @ghc-boot@'s UnitInfo, serialized to the database.+type DbUnitInfo      = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule++-- | Information about an unit (a unit is an installed module library).+--+-- This is a subset of Cabal's 'InstalledPackageInfo', with just the bits+-- that GHC is interested in.+--+-- Some types are left as parameters to be instantiated differently in ghc-pkg+-- and in ghc itself.+--+data GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod = GenericUnitInfo+   { unitId             :: uid+      -- ^ Unique unit identifier that is used during compilation (e.g. to+      -- generate symbols).++   , unitInstanceOf     :: compid+      -- ^ Identifier of an indefinite unit (i.e. with module holes) that this+      -- unit is an instance of.++   , unitInstantiations :: [(modulename, mod)]+      -- ^ How this unit instantiates some of its module holes. Map hole module+      -- names to actual module++   , unitPackageId      :: srcpkgid+      -- ^ Source package identifier.+      --+      -- Cabal instantiates this with Distribution.Types.PackageId.PackageId+      -- type which only contains the source package name and version. Notice+      -- that it doesn't contain the Hackage revision, nor any kind of hash.++   , unitPackageName    :: srcpkgname+      -- ^ Source package name++   , unitPackageVersion :: Version+      -- ^ Source package version++   , unitComponentName  :: Maybe srcpkgname+      -- ^ Name of the component.+      --+      -- Cabal supports more than one components (libraries, executables,+      -- testsuites) in the same package. Each component has a name except the+      -- default one (that can only be a library component) for which we use+      -- "Nothing".+      --+      -- GHC only deals with "library" components as they are the only kind of+      -- components that can be registered in a database and used by other+      -- modules.++   , unitAbiHash        :: String+      -- ^ ABI hash used to avoid mixing up units compiled with different+      -- dependencies, compiler, options, etc.++   , unitDepends        :: [uid]+      -- ^ Identifiers of the units this one depends on++   , unitAbiDepends     :: [(uid, String)]+     -- ^ Like 'unitDepends', but each dependency is annotated with the ABI hash+     -- we expect the dependency to respect.++   , unitImportDirs     :: [FilePath]+      -- ^ Directories containing module interfaces++   , unitLibraries      :: [String]+      -- ^ Names of the Haskell libraries provided by this unit++   , unitExtDepLibsSys  :: [String]+      -- ^ Names of the external system libraries that this unit depends on. See+      -- also `unitExtDepLibsGhc` field.++   , unitExtDepLibsGhc  :: [String]+      -- ^ Because of slight differences between the GHC dynamic linker (in+      -- GHC.Runtime.Linker) and the+      -- native system linker, some packages have to link with a different list+      -- of libraries when using GHC's. Examples include: libs that are actually+      -- gnu ld scripts, and the possibility that the .a libs do not exactly+      -- match the .so/.dll equivalents.+      --+      -- If this field is set, then we use that instead of the+      -- `unitExtDepLibsSys` field.++   , unitLibraryDirs    :: [FilePath]+      -- ^ Directories containing libraries provided by this unit. See also+      -- `unitLibraryDynDirs`.+      --+      -- It seems to be used to store paths to external library dependencies+      -- too.++   , unitLibraryDynDirs :: [FilePath]+      -- ^ Directories containing the dynamic libraries provided by this unit.+      -- See also `unitLibraryDirs`.+      --+      -- It seems to be used to store paths to external dynamic library+      -- dependencies too.++   , unitExtDepFrameworks :: [String]+      -- ^ Names of the external MacOS frameworks that this unit depends on.++   , unitExtDepFrameworkDirs :: [FilePath]+      -- ^ Directories containing MacOS frameworks that this unit depends+      -- on.++   , unitLinkerOptions  :: [String]+      -- ^ Linker (e.g. ld) command line options++   , unitCcOptions      :: [String]+      -- ^ C compiler options that needs to be passed to the C compiler when we+      -- compile some C code against this unit.++   , unitIncludes       :: [String]+      -- ^ C header files that are required by this unit (provided by this unit+      -- or external)++   , unitIncludeDirs    :: [FilePath]+      -- ^ Directories containing C header files that this unit depends+      -- on.++   , unitHaddockInterfaces :: [FilePath]+      -- ^ Paths to Haddock interface files for this unit++   , unitHaddockHTMLs   :: [FilePath]+      -- ^ Paths to Haddock directories containing HTML files++   , unitExposedModules :: [(modulename, Maybe mod)]+      -- ^ Modules exposed by the unit.+      --+      -- A module can be re-exported from another package. In this case, we+      -- indicate the module origin in the second parameter.++   , unitHiddenModules  :: [modulename]+      -- ^ Hidden modules.+      --+      -- These are useful for error reporting (e.g. if a hidden module is+      -- imported)++   , unitIsIndefinite   :: Bool+      -- ^ True if this unit has some module holes that need to be instantiated+      -- with real modules to make the unit usable (a.k.a. Backpack).++   , unitIsExposed      :: Bool+      -- ^ True if the unit is exposed. A unit could be installed in a database+      -- by "disabled" by not being exposed.++   , unitIsTrusted      :: Bool+      -- ^ True if the unit is trusted (cf Safe Haskell)++   }+   deriving (Eq, Show)++-- | Convert between GenericUnitInfo instances+mapGenericUnitInfo+   :: (uid1 -> uid2)+   -> (cid1 -> cid2)+   -> (srcpkg1 -> srcpkg2)+   -> (srcpkgname1 -> srcpkgname2)+   -> (modname1 -> modname2)+   -> (mod1 -> mod2)+   -> (GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1+       -> GenericUnitInfo cid2 srcpkg2 srcpkgname2 uid2 modname2 mod2)+mapGenericUnitInfo fuid fcid fsrcpkg fsrcpkgname fmodname fmod g@(GenericUnitInfo {..}) =+   g { unitId              = fuid unitId+     , unitInstanceOf      = fcid unitInstanceOf+     , unitInstantiations  = fmap (bimap fmodname fmod) unitInstantiations+     , unitPackageId       = fsrcpkg unitPackageId+     , unitPackageName     = fsrcpkgname unitPackageName+     , unitComponentName   = fmap fsrcpkgname unitComponentName+     , unitDepends         = fmap fuid unitDepends+     , unitAbiDepends      = fmap (first fuid) unitAbiDepends+     , unitExposedModules  = fmap (bimap fmodname (fmap fmod)) unitExposedModules+     , unitHiddenModules   = fmap fmodname unitHiddenModules+     }++-- | @ghc-boot@'s 'Module', serialized to the database.+data DbModule+   = DbModule+      { dbModuleUnitId  :: DbInstUnitId+      , dbModuleName    :: BS.ByteString+      }+   | DbModuleVar+      { dbModuleVarName :: BS.ByteString+      }+   deriving (Eq, Show)++-- | @ghc-boot@'s instantiated unit id, serialized to the database.+data DbInstUnitId++   -- | Instantiated unit+   = DbInstUnitId+      BS.ByteString               -- component id+      [(BS.ByteString, DbModule)] -- instantiations: [(modulename,module)]++   -- | Uninstantiated unit+   | DbUnitId+      BS.ByteString               -- unit id+  deriving (Eq, Show)++-- | Represents a lock of a package db.+newtype PackageDbLock = PackageDbLock Handle++-- | Acquire an exclusive lock related to package DB under given location.+lockPackageDb :: FilePath -> IO PackageDbLock++-- | Release the lock related to package DB.+unlockPackageDb :: PackageDbLock -> IO ()++-- | Acquire a lock of given type related to package DB under given location.+lockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock+lockPackageDbWith mode file = do+  -- We are trying to open the lock file and then lock it. Thus the lock file+  -- needs to either exist or we need to be able to create it. Ideally we+  -- would not assume that the lock file always exists in advance. When we are+  -- dealing with a package DB where we have write access then if the lock+  -- file does not exist then we can create it by opening the file in+  -- read/write mode. On the other hand if we are dealing with a package DB+  -- where we do not have write access (e.g. a global DB) then we can only+  -- open in read mode, and the lock file had better exist already or we're in+  -- trouble. So for global read-only DBs on platforms where we must lock the+  -- DB for reading then we will require that the installer/packaging has+  -- included the lock file.+  --+  -- Thus the logic here is to first try opening in read-write mode+  -- and if that fails we try read-only (to handle global read-only DBs).+  -- If either succeed then lock the file. IO exceptions (other than the first+  -- open attempt failing due to the file not existing) simply propagate.+  --+  -- Note that there is a complexity here which was discovered in #13945: some+  -- filesystems (e.g. NFS) will only allow exclusive locking if the fd was+  -- opened for write access. We would previously try opening the lockfile for+  -- read-only access first, however this failed when run on such filesystems.+  -- Consequently, we now try read-write access first, falling back to read-only+  -- if we are denied permission (e.g. in the case of a global database).+  catchJust+    (\e -> if isPermissionError e then Just () else Nothing)+    (lockFileOpenIn ReadWriteMode)+    (const $ lockFileOpenIn ReadMode)+  where+    lock = file <.> "lock"++    lockFileOpenIn io_mode = bracketOnError+      (openBinaryFile lock io_mode)+      hClose+      -- If file locking support is not available, ignore the error and proceed+      -- normally. Without it the only thing we lose on non-Windows platforms is+      -- the ability to safely issue concurrent updates to the same package db.+      $ \hnd -> do hLock hnd mode `catch` \FileLockingNotSupported -> return ()+                   return $ PackageDbLock hnd++lockPackageDb = lockPackageDbWith ExclusiveLock+unlockPackageDb (PackageDbLock hnd) = do+    hUnlock hnd+    hClose hnd++-- | Mode to open a package db in.+data DbMode = DbReadOnly | DbReadWrite++-- | 'DbOpenMode' holds a value of type @t@ but only in 'DbReadWrite' mode.  So+-- it is like 'Maybe' but with a type argument for the mode to enforce that the+-- mode is used consistently.+data DbOpenMode (mode :: DbMode) t where+  DbOpenReadOnly  ::      DbOpenMode 'DbReadOnly t+  DbOpenReadWrite :: t -> DbOpenMode 'DbReadWrite t++deriving instance Functor (DbOpenMode mode)+deriving instance F.Foldable (DbOpenMode mode)+deriving instance F.Traversable (DbOpenMode mode)++isDbOpenReadMode :: DbOpenMode mode t -> Bool+isDbOpenReadMode = \case+  DbOpenReadOnly    -> True+  DbOpenReadWrite{} -> False++-- | Read the part of the package DB that GHC is interested in.+--+readPackageDbForGhc :: FilePath -> IO [DbUnitInfo]+readPackageDbForGhc file =+  decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case+    (pkgs, DbOpenReadOnly) -> return pkgs+  where+    getDbForGhc = do+      _version    <- getHeader+      _ghcPartLen <- get :: Get Word32+      ghcPart     <- get+      -- the next part is for ghc-pkg, but we stop here.+      return ghcPart++-- | Read the part of the package DB that ghc-pkg is interested in+--+-- Note that the Binary instance for ghc-pkg's representation of packages+-- is not defined in this package. This is because ghc-pkg uses Cabal types+-- (and Binary instances for these) which this package does not depend on.+--+-- If we open the package db in read only mode, we get its contents. Otherwise+-- we additionally receive a PackageDbLock that represents a lock on the+-- database, so that we can safely update it later.+--+readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t ->+                          IO (pkgs, DbOpenMode mode PackageDbLock)+readPackageDbForGhcPkg file mode =+    decodeFromFile file mode getDbForGhcPkg+  where+    getDbForGhcPkg = do+      _version    <- getHeader+      -- skip over the ghc part+      ghcPartLen  <- get :: Get Word32+      _ghcPart    <- skip (fromIntegral ghcPartLen)+      -- the next part is for ghc-pkg+      ghcPkgPart  <- get+      return ghcPkgPart++-- | Write the whole of the package DB, both parts.+--+writePackageDb :: Binary pkgs => FilePath -> [DbUnitInfo] -> pkgs -> IO ()+writePackageDb file ghcPkgs ghcPkgPart =+  writeFileAtomic file (runPut putDbForGhcPkg)+  where+    putDbForGhcPkg = do+        putHeader+        put               ghcPartLen+        putLazyByteString ghcPart+        put               ghcPkgPart+      where+        ghcPartLen :: Word32+        ghcPartLen = fromIntegral (BS.Lazy.length ghcPart)+        ghcPart    = encode ghcPkgs++getHeader :: Get (Word32, Word32)+getHeader = do+    magic <- getByteString (BS.length headerMagic)+    when (magic /= headerMagic) $+      fail "not a ghc-pkg db file, wrong file magic number"++    majorVersion <- get :: Get Word32+    -- The major version is for incompatible changes++    minorVersion <- get :: Get Word32+    -- The minor version is for compatible extensions++    when (majorVersion /= 1) $+      fail "unsupported ghc-pkg db format version"+    -- If we ever support multiple major versions then we'll have to change+    -- this code++    -- The header can be extended without incrementing the major version,+    -- we ignore fields we don't know about (currently all).+    headerExtraLen <- get :: Get Word32+    skip (fromIntegral headerExtraLen)++    return (majorVersion, minorVersion)++putHeader :: Put+putHeader = do+    putByteString headerMagic+    put majorVersion+    put minorVersion+    put headerExtraLen+  where+    majorVersion   = 1 :: Word32+    minorVersion   = 0 :: Word32+    headerExtraLen = 0 :: Word32++headerMagic :: BS.ByteString+headerMagic = BS.Char8.pack "\0ghcpkg\0"+++-- TODO: we may be able to replace the following with utils from the binary+-- package in future.++-- | Feed a 'Get' decoder with data chunks from a file.+--+decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs ->+                  IO (pkgs, DbOpenMode mode PackageDbLock)+decodeFromFile file mode decoder = case mode of+  DbOpenReadOnly -> do+  -- Note [Locking package database on Windows]+  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+  -- When we open the package db in read only mode, there is no need to acquire+  -- shared lock on non-Windows platform because we update the database with an+  -- atomic rename, so readers will always see the database in a consistent+  -- state.+#if defined(mingw32_HOST_OS)+    bracket (lockPackageDbWith SharedLock file) unlockPackageDb $ \_ -> do+#endif+      (, DbOpenReadOnly) <$> decodeFileContents+  DbOpenReadWrite{} -> do+    -- When we open the package db in read/write mode, acquire an exclusive lock+    -- on the database and return it so we can keep it for the duration of the+    -- update.+    bracketOnError (lockPackageDb file) unlockPackageDb $ \lock -> do+      (, DbOpenReadWrite lock) <$> decodeFileContents+  where+    decodeFileContents = withBinaryFile file ReadMode $ \hnd ->+      feed hnd (runGetIncremental decoder)++    feed hnd (Partial k)  = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize+                               if BS.null chunk+                                 then feed hnd (k Nothing)+                                 else feed hnd (k (Just chunk))+    feed _ (Done _ _ res) = return res+    feed _ (Fail _ _ msg) = ioError err+      where+        err = mkIOError InappropriateType loc Nothing (Just file)+              `ioeSetErrorString` msg+        loc = "GHC.Unit.Database.readPackageDb"++-- Copied from Cabal's Distribution.Simple.Utils.+writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()+writeFileAtomic targetPath content = do+  let (targetDir, targetFile) = splitFileName targetPath+  Exception.bracketOnError+    (openBinaryTempFileWithDefaultPermissions targetDir $ targetFile <.> "tmp")+    (\(tmpPath, handle) -> hClose handle >> removeFile tmpPath)+    (\(tmpPath, handle) -> do+        BS.Lazy.hPut handle content+        hClose handle+        renameFile tmpPath targetPath)++instance Binary DbUnitInfo where+  put (GenericUnitInfo+         unitId unitInstanceOf unitInstantiations+         unitPackageId+         unitPackageName unitPackageVersion+         unitComponentName+         unitAbiHash unitDepends unitAbiDepends unitImportDirs+         unitLibraries unitExtDepLibsSys unitExtDepLibsGhc+         unitLibraryDirs unitLibraryDynDirs+         unitExtDepFrameworks unitExtDepFrameworkDirs+         unitLinkerOptions unitCcOptions+         unitIncludes unitIncludeDirs+         unitHaddockInterfaces unitHaddockHTMLs+         unitExposedModules unitHiddenModules+         unitIsIndefinite unitIsExposed unitIsTrusted) = do+    put unitPackageId+    put unitPackageName+    put unitPackageVersion+    put unitComponentName+    put unitId+    put unitInstanceOf+    put unitInstantiations+    put unitAbiHash+    put unitDepends+    put unitAbiDepends+    put unitImportDirs+    put unitLibraries+    put unitExtDepLibsSys+    put unitExtDepLibsGhc+    put unitLibraryDirs+    put unitLibraryDynDirs+    put unitExtDepFrameworks+    put unitExtDepFrameworkDirs+    put unitLinkerOptions+    put unitCcOptions+    put unitIncludes+    put unitIncludeDirs+    put unitHaddockInterfaces+    put unitHaddockHTMLs+    put unitExposedModules+    put unitHiddenModules+    put unitIsIndefinite+    put unitIsExposed+    put unitIsTrusted++  get = do+    unitPackageId      <- get+    unitPackageName    <- get+    unitPackageVersion <- get+    unitComponentName  <- get+    unitId             <- get+    unitInstanceOf     <- get+    unitInstantiations <- get+    unitAbiHash        <- get+    unitDepends        <- get+    unitAbiDepends     <- get+    unitImportDirs     <- get+    unitLibraries      <- get+    unitExtDepLibsSys  <- get+    unitExtDepLibsGhc  <- get+    libraryDirs        <- get+    libraryDynDirs     <- get+    frameworks         <- get+    frameworkDirs      <- get+    unitLinkerOptions  <- get+    unitCcOptions      <- get+    unitIncludes       <- get+    unitIncludeDirs    <- get+    unitHaddockInterfaces <- get+    unitHaddockHTMLs   <- get+    unitExposedModules <- get+    unitHiddenModules  <- get+    unitIsIndefinite   <- get+    unitIsExposed      <- get+    unitIsTrusted      <- get+    return (GenericUnitInfo+              unitId+              unitInstanceOf+              unitInstantiations+              unitPackageId+              unitPackageName+              unitPackageVersion+              unitComponentName+              unitAbiHash+              unitDepends+              unitAbiDepends+              unitImportDirs+              unitLibraries unitExtDepLibsSys unitExtDepLibsGhc+              libraryDirs libraryDynDirs+              frameworks frameworkDirs+              unitLinkerOptions unitCcOptions+              unitIncludes unitIncludeDirs+              unitHaddockInterfaces unitHaddockHTMLs+              unitExposedModules+              unitHiddenModules+              unitIsIndefinite unitIsExposed unitIsTrusted)++instance Binary DbModule where+  put (DbModule dbModuleUnitId dbModuleName) = do+    putWord8 0+    put dbModuleUnitId+    put dbModuleName+  put (DbModuleVar dbModuleVarName) = do+    putWord8 1+    put dbModuleVarName+  get = do+    b <- getWord8+    case b of+      0 -> DbModule <$> get <*> get+      _ -> DbModuleVar <$> get++instance Binary DbInstUnitId where+  put (DbUnitId uid) = do+    putWord8 0+    put uid+  put (DbInstUnitId dbUnitIdComponentId dbUnitIdInsts) = do+    putWord8 1+    put dbUnitIdComponentId+    put dbUnitIdInsts++  get = do+    b <- getWord8+    case b of+      0 -> DbUnitId <$> get+      _ -> DbInstUnitId <$> get <*> get+++-- | Return functions to perform path/URL variable substitution as per the Cabal+-- ${pkgroot} spec+-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)+--+-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.+-- The "pkgroot" is the directory containing the package database.+--+-- Also perform a similar substitution for the older GHC-specific+-- "$topdir" variable. The "topdir" is the location of the ghc+-- installation (obtained from the -B option).+mkMungePathUrl :: FilePath -> FilePath -> (FilePath -> FilePath, FilePath -> FilePath)+mkMungePathUrl top_dir pkgroot = (munge_path, munge_url)+   where+    munge_path p+      | Just p' <- stripVarPrefix "${pkgroot}" p = pkgroot ++ p'+      | Just p' <- stripVarPrefix "$topdir"    p = top_dir ++ p'+      | otherwise                                = p++    munge_url p+      | Just p' <- stripVarPrefix "${pkgrooturl}" p = toUrlPath pkgroot p'+      | Just p' <- stripVarPrefix "$httptopdir"   p = toUrlPath top_dir p'+      | otherwise                                   = p++    toUrlPath r p = "file:///"+                 -- URLs always use posix style '/' separators:+                 ++ FilePath.Posix.joinPath+                        (r : -- We need to drop a leading "/" or "\\"+                             -- if there is one:+                             dropWhile (all isPathSeparator)+                                       (FilePath.splitDirectories p))++    -- We could drop the separator here, and then use </> above. However,+    -- by leaving it in and using ++ we keep the same path separator+    -- rather than letting FilePath change it to use \ as the separator+    stripVarPrefix var path = case stripPrefix var path of+                              Just [] -> Just []+                              Just cs@(c : _) | isPathSeparator c -> Just cs+                              _ -> Nothing+++-- | Perform path/URL variable substitution as per the Cabal ${pkgroot} spec+-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)+-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.+-- The "pkgroot" is the directory containing the package database.+--+-- Also perform a similar substitution for the older GHC-specific+-- "$topdir" variable. The "topdir" is the location of the ghc+-- installation (obtained from the -B option).+mungeUnitInfoPaths :: FilePath -> FilePath -> GenericUnitInfo a b c d e f -> GenericUnitInfo a b c d e f+mungeUnitInfoPaths top_dir pkgroot pkg =+   -- TODO: similar code is duplicated in utils/ghc-pkg/Main.hs+    pkg+      { unitImportDirs          = munge_paths (unitImportDirs pkg)+      , unitIncludeDirs         = munge_paths (unitIncludeDirs pkg)+      , unitLibraryDirs         = munge_paths (unitLibraryDirs pkg)+      , unitLibraryDynDirs      = munge_paths (unitLibraryDynDirs pkg)+      , unitExtDepFrameworkDirs = munge_paths (unitExtDepFrameworkDirs pkg)+      , unitHaddockInterfaces   = munge_paths (unitHaddockInterfaces pkg)+        -- haddock-html is allowed to be either a URL or a file+      , unitHaddockHTMLs        = munge_paths (munge_urls (unitHaddockHTMLs pkg))+      }+   where+      munge_paths = map munge_path+      munge_urls  = map munge_url+      (munge_path,munge_url) = mkMungePathUrl top_dir pkgroot

@@ -0,0 +1,21 @@+module GHC.Version where++import Prelude -- See Note [Why do we import Prelude here?]++cProjectGitCommitId   :: String+cProjectGitCommitId   = "b085d34b3dd036ebcb85e5dc1b07d2b5bdbedbb7"++cProjectVersion       :: String+cProjectVersion       = "9.0.1"++cProjectVersionInt    :: String+cProjectVersionInt    = "900"++cProjectPatchLevel    :: String+cProjectPatchLevel    = "1"++cProjectPatchLevel1   :: String+cProjectPatchLevel1   = "1"++cProjectPatchLevel2   :: String+cProjectPatchLevel2   = ""

@@ -1,25 +1,28 @@-cabal-version:  1.22-name:           ghc-boot-version:        8.8.3+-- WARNING: ghc-boot.cabal is automatically generated from ghc-boot.cabal.in by+-- ../../configure.  Make sure you are editing ghc-boot.cabal.in, not+-- ghc-boot.cabal. +name:           ghc-boot+version:        9.0.1 license:        BSD3 license-file:   LICENSE category:       GHC maintainer:     ghc-devs@haskell.org-bug-reports:    https://gitlab.haskell.org/ghc/ghc/issues+bug-reports:    https://gitlab.haskell.org/ghc/ghc/issues/new synopsis:       Shared functionality between GHC and its boot libraries-description:    This library is shared between GHC, @ghc-pkg@, and other boot+description:    This library is shared between GHC, ghc-pkg, and other boot                 libraries.                 .-                A note about "GHC.PackageDb": it only deals with the subset of+                A note about "GHC.Unit.Database": it only deals with the subset of                 the package database that the compiler cares about: modules                 paths etc and not package metadata like description, authors-                etc. It is thus not a library interface to @ghc-pkg@ and is __not__+                etc. It is thus not a library interface to ghc-pkg and is *not*                 suitable for modifying GHC package databases.                 .                 The package database format and this library are constructed in-                such a way that while @ghc-pkg@ depends on @Cabal@, the GHC library-                and program do not have to depend on @Cabal@.+                such a way that while ghc-pkg depends on Cabal, the GHC library+                and program do not have to depend on Cabal.+cabal-version:  >=1.22 build-type:     Simple extra-source-files: changelog.md @@ -34,15 +37,28 @@     default-extensions: NoImplicitPrelude      exposed-modules:+            GHC.BaseDir             GHC.LanguageExtensions-            GHC.PackageDb+            GHC.Unit.Database             GHC.Serialized             GHC.ForeignSrcLang             GHC.HandleEncoding+            GHC.Platform+            GHC.Platform.Host+            GHC.Settings.Platform+            GHC.Settings.Utils+            GHC.UniqueSubdir+            GHC.Version -    build-depends: base       >= 4.7 && < 4.14,+    -- but done by Hadrian+    -- autogen-modules:+    --         GHC.Version+    --         GHC.Platform.Host++    build-depends: base       >= 4.7 && < 4.16,                    binary     == 0.8.*,                    bytestring == 0.10.*,+                   containers >= 0.5 && < 0.7,                    directory  >= 1.2 && < 1.4,                    filepath   >= 1.3 && < 1.5,-                   ghc-boot-th == 8.8.3+                   ghc-boot-th == 9.0.1