1{-# LANGUAGE NoImplicitPrelude #-} 2{-# LANGUAGE ConstraintKinds #-} 3{-# LANGUAGE FlexibleContexts #-} 4{-# LANGUAGE OverloadedStrings #-} 5{-# LANGUAGE RankNTypes #-} 6{-# LANGUAGE DeriveDataTypeable #-} 7{-# LANGUAGE TypeFamilies #-} 8-- Create a source distribution tarball 9module Stack.SDist 10 ( getSDistTarball 11 , checkSDistTarball 12 , checkSDistTarball' 13 , SDistOpts (..) 14 ) where 15 16import qualified Codec.Archive.Tar as Tar 17import qualified Codec.Archive.Tar.Entry as Tar 18import qualified Codec.Compression.GZip as GZip 19import Control.Applicative 20import Control.Concurrent.Execute (ActionContext(..), Concurrency(..)) 21import Stack.Prelude hiding (Display (..)) 22import qualified Data.ByteString as S 23import qualified Data.ByteString.Char8 as S8 24import qualified Data.ByteString.Lazy as L 25import Data.Char (toLower) 26import Data.Data (cast) 27import Data.List 28import qualified Data.List.NonEmpty as NE 29import qualified Data.Map.Strict as Map 30import qualified Data.Set as Set 31import qualified Data.Text as T 32import qualified Data.Text.Encoding as T 33import qualified Data.Text.Encoding.Error as T 34import qualified Data.Text.Lazy as TL 35import qualified Data.Text.Lazy.Encoding as TLE 36import Data.Time.Clock.POSIX 37import Distribution.Package (Dependency (..)) 38import qualified Distribution.PackageDescription as Cabal 39import qualified Distribution.PackageDescription.Check as Check 40import qualified Distribution.PackageDescription.Parsec as Cabal 41import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) 42import qualified Distribution.Types.UnqualComponentName as Cabal 43import Distribution.Version (simplifyVersionRange, orLaterVersion, earlierVersion, hasUpperBound, hasLowerBound) 44import Path 45import Path.IO hiding (getModificationTime, getPermissions, withSystemTempDir) 46import RIO.PrettyPrint 47import Stack.Build (mkBaseConfigOpts, build, buildLocalTargets) 48import Stack.Build.Execute 49import Stack.Build.Installed 50import Stack.Build.Source (projectLocalPackages) 51import Stack.Types.GhcPkgId 52import Stack.Package 53import Stack.SourceMap 54import Stack.Types.Build 55import Stack.Types.Config 56import Stack.Types.Package 57import Stack.Types.SourceMap 58import Stack.Types.Version 59import System.Directory (getModificationTime, getPermissions) 60import qualified System.FilePath as FP 61 62-- | Special exception to throw when you want to fail because of bad results 63-- of package check. 64 65data SDistOpts = SDistOpts 66 { sdoptsDirsToWorkWith :: [String] 67 -- ^ Directories to package 68 , sdoptsPvpBounds :: Maybe PvpBounds 69 -- ^ PVP Bounds overrides 70 , sdoptsIgnoreCheck :: Bool 71 -- ^ Whether to ignore check of the package for common errors 72 , sdoptsBuildTarball :: Bool 73 -- ^ Whether to build the tarball 74 , sdoptsTarPath :: Maybe FilePath 75 -- ^ Where to copy the tarball 76 } 77 78newtype CheckException 79 = CheckException (NonEmpty Check.PackageCheck) 80 deriving (Typeable) 81 82instance Exception CheckException 83 84instance Show CheckException where 85 show (CheckException xs) = 86 "Package check reported the following errors:\n" ++ 87 (intercalate "\n" . fmap show . NE.toList $ xs) 88 89-- | Given the path to a local package, creates its source 90-- distribution tarball. 91-- 92-- While this yields a 'FilePath', the name of the tarball, this 93-- tarball is not written to the disk and instead yielded as a lazy 94-- bytestring. 95getSDistTarball 96 :: HasEnvConfig env 97 => Maybe PvpBounds -- ^ Override Config value 98 -> Path Abs Dir -- ^ Path to local package 99 -> RIO env (FilePath, L.ByteString, Maybe (PackageIdentifier, L.ByteString)) 100 -- ^ Filename, tarball contents, and option cabal file revision to upload 101getSDistTarball mpvpBounds pkgDir = do 102 config <- view configL 103 let PvpBounds pvpBounds asRevision = fromMaybe (configPvpBounds config) mpvpBounds 104 tweakCabal = pvpBounds /= PvpBoundsNone 105 pkgFp = toFilePath pkgDir 106 lp <- readLocalPackage pkgDir 107 forM_ (packageSetupDeps (lpPackage lp)) $ \customSetupDeps -> 108 case NE.nonEmpty (map (T.pack . packageNameString) (Map.keys customSetupDeps)) of 109 Just nonEmptyDepTargets -> do 110 eres <- buildLocalTargets nonEmptyDepTargets 111 case eres of 112 Left err -> 113 logError $ "Error building custom-setup dependencies: " <> displayShow err 114 Right _ -> 115 return () 116 Nothing -> 117 logWarn "unexpected empty custom-setup dependencies" 118 sourceMap <- view $ envConfigL.to envConfigSourceMap 119 120 installMap <- toInstallMap sourceMap 121 (installedMap, _globalDumpPkgs, _snapshotDumpPkgs, _localDumpPkgs) <- 122 getInstalled installMap 123 let deps = Map.fromList [ (pid, ghcPkgId) 124 | (_, Library pid ghcPkgId _) <- Map.elems installedMap] 125 126 logInfo $ "Getting file list for " <> fromString pkgFp 127 (fileList, cabalfp) <- getSDistFileList lp deps 128 logInfo $ "Building sdist tarball for " <> fromString pkgFp 129 files <- normalizeTarballPaths (map (T.unpack . stripCR . T.pack) (lines fileList)) 130 131 -- We're going to loop below and eventually find the cabal 132 -- file. When we do, we'll upload this reference, if the 133 -- mpvpBounds value indicates that we should be uploading a cabal 134 -- file revision. 135 cabalFileRevisionRef <- liftIO (newIORef Nothing) 136 137 -- NOTE: Could make this use lazy I/O to only read files as needed 138 -- for upload (both GZip.compress and Tar.write are lazy). 139 -- However, it seems less error prone and more predictable to read 140 -- everything in at once, so that's what we're doing for now: 141 let tarPath isDir fp = either throwString return 142 (Tar.toTarPath isDir (forceUtf8Enc (pkgId FP.</> fp))) 143 -- convert a String of proper characters to a String of bytes 144 -- in UTF8 encoding masquerading as characters. This is 145 -- necessary for tricking the tar package into proper 146 -- character encoding. 147 forceUtf8Enc = S8.unpack . T.encodeUtf8 . T.pack 148 packWith f isDir fp = liftIO $ f (pkgFp FP.</> fp) =<< tarPath isDir fp 149 packDir = packWith Tar.packDirectoryEntry True 150 packFile fp 151 -- This is a cabal file, we're going to tweak it, but only 152 -- tweak it as a revision. 153 | tweakCabal && isCabalFp fp && asRevision = do 154 lbsIdent <- getCabalLbs pvpBounds (Just 1) cabalfp sourceMap 155 liftIO (writeIORef cabalFileRevisionRef (Just lbsIdent)) 156 packWith packFileEntry False fp 157 -- Same, except we'll include the cabal file in the 158 -- original tarball upload. 159 | tweakCabal && isCabalFp fp = do 160 (_ident, lbs) <- getCabalLbs pvpBounds Nothing cabalfp sourceMap 161 currTime <- liftIO getPOSIXTime -- Seconds from UNIX epoch 162 tp <- liftIO $ tarPath False fp 163 return $ (Tar.fileEntry tp lbs) { Tar.entryTime = floor currTime } 164 | otherwise = packWith packFileEntry False fp 165 isCabalFp fp = toFilePath pkgDir FP.</> fp == toFilePath cabalfp 166 tarName = pkgId FP.<.> "tar.gz" 167 pkgId = packageIdentifierString (packageIdentifier (lpPackage lp)) 168 dirEntries <- mapM packDir (dirsFromFiles files) 169 fileEntries <- mapM packFile files 170 mcabalFileRevision <- liftIO (readIORef cabalFileRevisionRef) 171 return (tarName, GZip.compress (Tar.write (dirEntries ++ fileEntries)), mcabalFileRevision) 172 173-- | Get the PVP bounds-enabled version of the given cabal file 174getCabalLbs :: HasEnvConfig env 175 => PvpBoundsType 176 -> Maybe Int -- ^ optional revision 177 -> Path Abs File -- ^ cabal file 178 -> SourceMap 179 -> RIO env (PackageIdentifier, L.ByteString) 180getCabalLbs pvpBounds mrev cabalfp sourceMap = do 181 (gpdio, _name, cabalfp') <- loadCabalFilePath (parent cabalfp) 182 gpd <- liftIO $ gpdio NoPrintWarnings 183 unless (cabalfp == cabalfp') 184 $ error $ "getCabalLbs: cabalfp /= cabalfp': " ++ show (cabalfp, cabalfp') 185 installMap <- toInstallMap sourceMap 186 (installedMap, _, _, _) <- getInstalled installMap 187 let internalPackages = Set.fromList $ 188 gpdPackageName gpd : 189 map (Cabal.unqualComponentNameToPackageName . fst) (Cabal.condSubLibraries gpd) 190 gpd' = gtraverseT (addBounds internalPackages installMap installedMap) gpd 191 gpd'' = 192 case mrev of 193 Nothing -> gpd' 194 Just rev -> gpd' 195 { Cabal.packageDescription 196 = (Cabal.packageDescription gpd') 197 { Cabal.customFieldsPD 198 = (("x-revision", show rev):) 199 $ filter (\(x, _) -> map toLower x /= "x-revision") 200 $ Cabal.customFieldsPD 201 $ Cabal.packageDescription gpd' 202 } 203 } 204 ident = Cabal.package $ Cabal.packageDescription gpd'' 205 -- Sanity rendering and reparsing the input, to ensure there are no 206 -- cabal bugs, since there have been bugs here before, and currently 207 -- are at the time of writing: 208 -- 209 -- https://github.com/haskell/cabal/issues/1202 210 -- https://github.com/haskell/cabal/issues/2353 211 -- https://github.com/haskell/cabal/issues/4863 (current issue) 212 let roundtripErrs = 213 [ flow "Bug detected in Cabal library. ((parse . render . parse) === id) does not hold for the cabal file at" 214 <+> pretty cabalfp 215 , "" 216 ] 217 (_warnings, eres) = Cabal.runParseResult 218 $ Cabal.parseGenericPackageDescription 219 $ T.encodeUtf8 220 $ T.pack 221 $ showGenericPackageDescription gpd 222 case eres of 223 Right roundtripped 224 | roundtripped == gpd -> return () 225 | otherwise -> do 226 prettyWarn $ vsep $ roundtripErrs ++ 227 [ "This seems to be fixed in development versions of Cabal, but at time of writing, the fix is not in any released versions." 228 , "" 229 , "Please see this GitHub issue for status:" <+> style Url "https://github.com/commercialhaskell/stack/issues/3549" 230 , "" 231 , fillSep 232 [ flow "If the issue is closed as resolved, then you may be able to fix this by upgrading to a newer version of stack via" 233 , style Shell "stack upgrade" 234 , flow "for latest stable version or" 235 , style Shell "stack upgrade --git" 236 , flow "for the latest development version." 237 ] 238 , "" 239 , fillSep 240 [ flow "If the issue is fixed, but updating doesn't solve the problem, please check if there are similar open issues, and if not, report a new issue to the stack issue tracker, at" 241 , style Url "https://github.com/commercialhaskell/stack/issues/new" 242 ] 243 , "" 244 , flow "If the issue is not fixed, feel free to leave a comment on it indicating that you would like it to be fixed." 245 , "" 246 ] 247 Left (_version, errs) -> do 248 prettyWarn $ vsep $ roundtripErrs ++ 249 [ flow "In particular, parsing the rendered cabal file is yielding a parse error. Please check if there are already issues tracking this, and if not, please report new issues to the stack and cabal issue trackers, via" 250 , bulletedList 251 [ style Url "https://github.com/commercialhaskell/stack/issues/new" 252 , style Url "https://github.com/haskell/cabal/issues/new" 253 ] 254 , flow $ "The parse error is: " ++ unlines (map show (toList errs)) 255 , "" 256 ] 257 return 258 ( ident 259 , TLE.encodeUtf8 $ TL.pack $ showGenericPackageDescription gpd'' 260 ) 261 where 262 addBounds :: Set PackageName -> InstallMap -> InstalledMap -> Dependency -> Dependency 263 addBounds internalPackages installMap installedMap dep@(Dependency name range s) = 264 if name `Set.member` internalPackages 265 then dep 266 else case foundVersion of 267 Nothing -> dep 268 Just version -> Dependency name (simplifyVersionRange 269 $ (if toAddUpper && not (hasUpperBound range) then addUpper version else id) 270 $ (if toAddLower && not (hasLowerBound range) then addLower version else id) 271 range) s 272 where 273 foundVersion = 274 case Map.lookup name installMap of 275 Just (_, version) -> Just version 276 Nothing -> 277 case Map.lookup name installedMap of 278 Just (_, installed) -> Just (installedVersion installed) 279 Nothing -> Nothing 280 281 addUpper version = intersectVersionRanges 282 (earlierVersion $ nextMajorVersion version) 283 addLower version = intersectVersionRanges (orLaterVersion version) 284 285 (toAddLower, toAddUpper) = 286 case pvpBounds of 287 PvpBoundsNone -> (False, False) 288 PvpBoundsUpper -> (False, True) 289 PvpBoundsLower -> (True, False) 290 PvpBoundsBoth -> (True, True) 291 292-- | Traverse a data type. 293gtraverseT :: (Data a,Typeable b) => (Typeable b => b -> b) -> a -> a 294gtraverseT f = 295 gmapT (\x -> case cast x of 296 Nothing -> gtraverseT f x 297 Just b -> fromMaybe x (cast (f b))) 298 299-- | Read in a 'LocalPackage' config. This makes some default decisions 300-- about 'LocalPackage' fields that might not be appropriate for other 301-- use-cases. 302readLocalPackage :: HasEnvConfig env => Path Abs Dir -> RIO env LocalPackage 303readLocalPackage pkgDir = do 304 config <- getDefaultPackageConfig 305 (gpdio, _, cabalfp) <- loadCabalFilePath pkgDir 306 gpd <- liftIO $ gpdio YesPrintWarnings 307 let package = resolvePackage config gpd 308 return LocalPackage 309 { lpPackage = package 310 , lpWanted = False -- HACK: makes it so that sdist output goes to a log instead of a file. 311 , lpCabalFile = cabalfp 312 -- NOTE: these aren't the 'correct values, but aren't used in 313 -- the usage of this function in this module. 314 , lpTestDeps = Map.empty 315 , lpBenchDeps = Map.empty 316 , lpTestBench = Nothing 317 , lpBuildHaddocks = False 318 , lpForceDirty = False 319 , lpDirtyFiles = pure Nothing 320 , lpNewBuildCaches = pure Map.empty 321 , lpComponentFiles = pure Map.empty 322 , lpComponents = Set.empty 323 , lpUnbuildable = Set.empty 324 } 325 326-- | Returns a newline-separate list of paths, and the absolute path to the .cabal file. 327getSDistFileList :: HasEnvConfig env => LocalPackage -> Map PackageIdentifier GhcPkgId -> RIO env (String, Path Abs File) 328getSDistFileList lp deps = 329 withSystemTempDir (stackProgName <> "-sdist") $ \tmpdir -> do 330 let bopts = defaultBuildOpts 331 let boptsCli = defaultBuildOptsCLI 332 baseConfigOpts <- mkBaseConfigOpts boptsCli 333 locals <- projectLocalPackages 334 withExecuteEnv bopts boptsCli baseConfigOpts locals 335 [] [] [] Nothing -- provide empty list of globals. This is a hack around custom Setup.hs files 336 $ \ee -> 337 withSingleContext ac ee task deps (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _outputType -> do 338 let outFile = toFilePath tmpdir FP.</> "source-files-list" 339 cabal CloseOnException KeepTHLoading ["sdist", "--list-sources", outFile] 340 contents <- liftIO (S.readFile outFile) 341 return (T.unpack $ T.decodeUtf8With T.lenientDecode contents, cabalfp) 342 where 343 package = lpPackage lp 344 ac = ActionContext Set.empty [] ConcurrencyAllowed 345 task = Task 346 { taskProvides = PackageIdentifier (packageName package) (packageVersion package) 347 , taskType = TTLocalMutable lp 348 , taskConfigOpts = TaskConfigOpts 349 { tcoMissing = Set.empty 350 , tcoOpts = \_ -> ConfigureOpts [] [] 351 } 352 , taskBuildHaddock = False 353 , taskPresent = Map.empty 354 , taskAllInOne = True 355 , taskCachePkgSrc = CacheSrcLocal (toFilePath (parent $ lpCabalFile lp)) 356 , taskAnyMissing = True 357 , taskBuildTypeConfig = False 358 } 359 360normalizeTarballPaths :: HasRunner env => [FilePath] -> RIO env [FilePath] 361normalizeTarballPaths fps = do 362 -- TODO: consider whether erroring out is better - otherwise the 363 -- user might upload an incomplete tar? 364 unless (null outsideDir) $ 365 logWarn $ 366 "Warning: These files are outside of the package directory, and will be omitted from the tarball: " <> 367 displayShow outsideDir 368 return (nubOrd files) 369 where 370 (outsideDir, files) = partitionEithers (map pathToEither fps) 371 pathToEither fp = maybe (Left fp) Right (normalizePath fp) 372 373normalizePath :: FilePath -> Maybe FilePath 374normalizePath = fmap FP.joinPath . go . FP.splitDirectories . FP.normalise 375 where 376 go [] = Just [] 377 go ("..":_) = Nothing 378 go (_:"..":xs) = go xs 379 go (x:xs) = (x :) <$> go xs 380 381dirsFromFiles :: [FilePath] -> [FilePath] 382dirsFromFiles dirs = Set.toAscList (Set.delete "." results) 383 where 384 results = foldl' (\s -> go s . FP.takeDirectory) Set.empty dirs 385 go s x 386 | Set.member x s = s 387 | otherwise = go (Set.insert x s) (FP.takeDirectory x) 388 389-- | Check package in given tarball. This will log all warnings 390-- and will throw an exception in case of critical errors. 391-- 392-- Note that we temporarily decompress the archive to analyze it. 393checkSDistTarball 394 :: HasEnvConfig env 395 => SDistOpts -- ^ The configuration of what to check 396 -> Path Abs File -- ^ Absolute path to tarball 397 -> RIO env () 398checkSDistTarball opts tarball = withTempTarGzContents tarball $ \pkgDir' -> do 399 pkgDir <- (pkgDir' </>) `liftM` 400 (parseRelDir . FP.takeBaseName . FP.takeBaseName . toFilePath $ tarball) 401 -- ^ drop ".tar" ^ drop ".gz" 402 when (sdoptsBuildTarball opts) (buildExtractedTarball ResolvedPath 403 { resolvedRelative = RelFilePath "this-is-not-used" -- ugly hack 404 , resolvedAbsolute = pkgDir 405 }) 406 unless (sdoptsIgnoreCheck opts) (checkPackageInExtractedTarball pkgDir) 407 408checkPackageInExtractedTarball 409 :: HasEnvConfig env 410 => Path Abs Dir -- ^ Absolute path to tarball 411 -> RIO env () 412checkPackageInExtractedTarball pkgDir = do 413 (gpdio, name, _cabalfp) <- loadCabalFilePath pkgDir 414 gpd <- liftIO $ gpdio YesPrintWarnings 415 config <- getDefaultPackageConfig 416 let PackageDescriptionPair pkgDesc _ = resolvePackageDescription config gpd 417 logInfo $ 418 "Checking package '" <> fromString (packageNameString name) <> "' for common mistakes" 419 let pkgChecks = 420 -- MSS 2017-12-12: Try out a few different variants of 421 -- pkgDesc to try and provoke an error or warning. I don't 422 -- know why, but when using `Just pkgDesc`, it appears that 423 -- Cabal does not detect that `^>=` is used with 424 -- `cabal-version: 1.24` or earlier. It seems like pkgDesc 425 -- (the one we create) does not populate the `buildDepends` 426 -- field, whereas flattenPackageDescription from Cabal 427 -- does. In any event, using `Nothing` seems more logical 428 -- for this check anyway, and the fallback to `Just pkgDesc` 429 -- is just a crazy sanity check. 430 case Check.checkPackage gpd Nothing of 431 [] -> Check.checkPackage gpd (Just pkgDesc) 432 x -> x 433 fileChecks <- liftIO $ Check.checkPackageFiles minBound pkgDesc (toFilePath pkgDir) 434 let checks = pkgChecks ++ fileChecks 435 (errors, warnings) = 436 let criticalIssue (Check.PackageBuildImpossible _) = True 437 criticalIssue (Check.PackageDistInexcusable _) = True 438 criticalIssue _ = False 439 in partition criticalIssue checks 440 unless (null warnings) $ 441 logWarn $ "Package check reported the following warnings:\n" <> 442 mconcat (intersperse "\n" . fmap displayShow $ warnings) 443 case NE.nonEmpty errors of 444 Nothing -> return () 445 Just ne -> throwM $ CheckException ne 446 447buildExtractedTarball :: HasEnvConfig env => ResolvedPath Dir -> RIO env () 448buildExtractedTarball pkgDir = do 449 envConfig <- view envConfigL 450 localPackageToBuild <- readLocalPackage $ resolvedAbsolute pkgDir 451 -- We remove the path based on the name of the package 452 let isPathToRemove path = do 453 localPackage <- readLocalPackage path 454 return $ packageName (lpPackage localPackage) == packageName (lpPackage localPackageToBuild) 455 pathsToKeep 456 <- fmap Map.fromList 457 $ flip filterM (Map.toList (smwProject (bcSMWanted (envConfigBuildConfig envConfig)))) 458 $ fmap not . isPathToRemove . resolvedAbsolute . ppResolvedDir . snd 459 pp <- mkProjectPackage YesPrintWarnings pkgDir False 460 let adjustEnvForBuild env = 461 let updatedEnvConfig = envConfig 462 { envConfigSourceMap = updatePackagesInSourceMap (envConfigSourceMap envConfig) 463 , envConfigBuildConfig = updateBuildConfig (envConfigBuildConfig envConfig) 464 } 465 updateBuildConfig bc = bc 466 { bcConfig = (bcConfig bc) 467 { configBuild = defaultBuildOpts { boptsTests = True } } 468 } 469 in set envConfigL updatedEnvConfig env 470 updatePackagesInSourceMap sm = 471 sm {smProject = Map.insert (cpName $ ppCommon pp) pp pathsToKeep} 472 local adjustEnvForBuild $ build Nothing 473 474-- | Version of 'checkSDistTarball' that first saves lazy bytestring to 475-- temporary directory and then calls 'checkSDistTarball' on it. 476checkSDistTarball' 477 :: HasEnvConfig env 478 => SDistOpts 479 -> String -- ^ Tarball name 480 -> L.ByteString -- ^ Tarball contents as a byte string 481 -> RIO env () 482checkSDistTarball' opts name bytes = withSystemTempDir "stack" $ \tpath -> do 483 npath <- (tpath </>) `liftM` parseRelFile name 484 liftIO $ L.writeFile (toFilePath npath) bytes 485 checkSDistTarball opts npath 486 487withTempTarGzContents 488 :: Path Abs File -- ^ Location of tarball 489 -> (Path Abs Dir -> RIO env a) -- ^ Perform actions given dir with tarball contents 490 -> RIO env a 491withTempTarGzContents apath f = withSystemTempDir "stack" $ \tpath -> do 492 archive <- liftIO $ L.readFile (toFilePath apath) 493 liftIO . Tar.unpack (toFilePath tpath) . Tar.read . GZip.decompress $ archive 494 f tpath 495 496-------------------------------------------------------------------------------- 497 498-- Copy+modified from the tar package to avoid issues with lazy IO ( see 499-- https://github.com/commercialhaskell/stack/issues/1344 ) 500 501packFileEntry :: FilePath -- ^ Full path to find the file on the local disk 502 -> Tar.TarPath -- ^ Path to use for the tar Entry in the archive 503 -> IO Tar.Entry 504packFileEntry filepath tarpath = do 505 mtime <- getModTime filepath 506 perms <- getPermissions filepath 507 content <- S.readFile filepath 508 let size = fromIntegral (S.length content) 509 return (Tar.simpleEntry tarpath (Tar.NormalFile (L.fromStrict content) size)) { 510 Tar.entryPermissions = if executable perms then Tar.executableFilePermissions 511 else Tar.ordinaryFilePermissions, 512 Tar.entryTime = mtime 513 } 514 515getModTime :: FilePath -> IO Tar.EpochTime 516getModTime path = do 517 t <- getModificationTime path 518 return . floor . utcTimeToPOSIXSeconds $ t 519 520getDefaultPackageConfig :: (MonadIO m, MonadReader env m, HasEnvConfig env) 521 => m PackageConfig 522getDefaultPackageConfig = do 523 platform <- view platformL 524 compilerVersion <- view actualCompilerVersionL 525 return PackageConfig 526 { packageConfigEnableTests = False 527 , packageConfigEnableBenchmarks = False 528 , packageConfigFlags = mempty 529 , packageConfigGhcOptions = [] 530 , packageConfigCabalConfigOpts = [] 531 , packageConfigCompilerVersion = compilerVersion 532 , packageConfigPlatform = platform 533 } 534