{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Stack.SDist
( getSDistTarball
, checkSDistTarball
, checkSDistTarball'
, SDistOpts (..)
) where
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Codec.Compression.GZip as GZip
import Control.Applicative
import Control.Concurrent.Execute (ActionContext(..), Concurrency(..))
import Stack.Prelude hiding (Display (..))
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import Data.Char (toLower)
import Data.Data (cast)
import Data.List
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import Data.Time.Clock.POSIX
import Distribution.Package (Dependency (..))
import qualified Distribution.PackageDescription as Cabal
import qualified Distribution.PackageDescription.Check as Check
import qualified Distribution.PackageDescription.Parsec as Cabal
import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription)
import Distribution.Version (simplifyVersionRange, orLaterVersion, earlierVersion, hasUpperBound, hasLowerBound)
import Path
import Path.IO hiding (getModificationTime, getPermissions, withSystemTempDir)
import RIO.PrettyPrint
import Stack.Build (mkBaseConfigOpts, build, buildLocalTargets)
import Stack.Build.Execute
import Stack.Build.Installed
import Stack.Build.Source (projectLocalPackages)
import Stack.Types.GhcPkgId
import Stack.Package
import Stack.SourceMap
import Stack.Types.Build
import Stack.Types.Config
import Stack.Types.Package
import Stack.Types.SourceMap
import Stack.Types.Version
import System.Directory (getModificationTime, getPermissions)
import qualified System.FilePath as FP
data SDistOpts = SDistOpts
{ SDistOpts -> [FilePath]
sdoptsDirsToWorkWith :: [String]
, SDistOpts -> Maybe PvpBounds
sdoptsPvpBounds :: Maybe PvpBounds
, SDistOpts -> Bool
sdoptsIgnoreCheck :: Bool
, SDistOpts -> Bool
sdoptsBuildTarball :: Bool
, SDistOpts -> Maybe FilePath
sdoptsTarPath :: Maybe FilePath
}
newtype CheckException
= CheckException (NonEmpty Check.PackageCheck)
deriving (Typeable)
instance Exception CheckException
instance Show CheckException where
show :: CheckException -> FilePath
show (CheckException NonEmpty PackageCheck
xs) =
FilePath
"Package check reported the following errors:\n" forall a. [a] -> [a] -> [a]
++
(forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ NonEmpty PackageCheck
xs)
getSDistTarball
:: HasEnvConfig env
=> Maybe PvpBounds
-> Path Abs Dir
-> RIO env (FilePath, L.ByteString, Maybe (PackageIdentifier, L.ByteString))
getSDistTarball :: forall env.
HasEnvConfig env =>
Maybe PvpBounds
-> Path Abs Dir
-> RIO
env (FilePath, ByteString, Maybe (PackageIdentifier, ByteString))
getSDistTarball Maybe PvpBounds
mpvpBounds Path Abs Dir
pkgDir = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
let PvpBounds PvpBoundsType
pvpBounds Bool
asRevision = forall a. a -> Maybe a -> a
fromMaybe (Config -> PvpBounds
configPvpBounds Config
config) Maybe PvpBounds
mpvpBounds
tweakCabal :: Bool
tweakCabal = PvpBoundsType
pvpBounds forall a. Eq a => a -> a -> Bool
/= PvpBoundsType
PvpBoundsNone
pkgFp :: FilePath
pkgFp = forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
pkgDir
LocalPackage
lp <- forall env.
HasEnvConfig env =>
Path Abs Dir -> RIO env LocalPackage
readLocalPackage Path Abs Dir
pkgDir
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Package -> Maybe (Map PackageName VersionRange)
packageSetupDeps (LocalPackage -> Package
lpPackage LocalPackage
lp)) forall a b. (a -> b) -> a -> b
$ \Map PackageName VersionRange
customSetupDeps ->
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FilePath
packageNameString) (forall k a. Map k a -> [k]
Map.keys Map PackageName VersionRange
customSetupDeps)) of
Just NonEmpty Text
nonEmptyDepTargets -> do
Either SomeException ()
eres <- forall env.
HasEnvConfig env =>
NonEmpty Text -> RIO env (Either SomeException ())
buildLocalTargets NonEmpty Text
nonEmptyDepTargets
case Either SomeException ()
eres of
Left SomeException
err ->
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Error building custom-setup dependencies: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow SomeException
err
Right ()
_ ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe (NonEmpty Text)
Nothing ->
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"unexpected empty custom-setup dependencies"
SourceMap
sourceMap <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
InstallMap
installMap <- forall (m :: * -> *). MonadIO m => SourceMap -> m InstallMap
toInstallMap SourceMap
sourceMap
(InstalledMap
installedMap, [DumpPackage]
_globalDumpPkgs, [DumpPackage]
_snapshotDumpPkgs, [DumpPackage]
_localDumpPkgs) <-
forall env.
HasEnvConfig env =>
InstallMap
-> RIO
env (InstalledMap, [DumpPackage], [DumpPackage], [DumpPackage])
getInstalled InstallMap
installMap
let deps :: Map PackageIdentifier GhcPkgId
deps = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (PackageIdentifier
pid, GhcPkgId
ghcPkgId)
| (InstallLocation
_, Library PackageIdentifier
pid GhcPkgId
ghcPkgId Maybe (Either License License)
_) <- forall k a. Map k a -> [a]
Map.elems InstalledMap
installedMap]
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Getting file list for " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => FilePath -> a
fromString FilePath
pkgFp
(FilePath
fileList, Path Abs File
cabalfp) <- forall env.
HasEnvConfig env =>
LocalPackage
-> Map PackageIdentifier GhcPkgId
-> RIO env (FilePath, Path Abs File)
getSDistFileList LocalPackage
lp Map PackageIdentifier GhcPkgId
deps
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Building sdist tarball for " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => FilePath -> a
fromString FilePath
pkgFp
[FilePath]
files <- forall env. HasRunner env => [FilePath] -> RIO env [FilePath]
normalizeTarballPaths (forall a b. (a -> b) -> [a] -> [b]
map (Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripCR forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) (FilePath -> [FilePath]
lines FilePath
fileList))
IORef (Maybe (PackageIdentifier, ByteString))
cabalFileRevisionRef <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef forall a. Maybe a
Nothing)
let tarPath :: Bool -> FilePath -> IO TarPath
tarPath Bool
isDir FilePath
fp = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
FilePath -> m a
throwString forall (m :: * -> *) a. Monad m => a -> m a
return
(Bool -> FilePath -> Either FilePath TarPath
Tar.toTarPath Bool
isDir (ShowS
forceUtf8Enc (FilePath
pkgId FilePath -> ShowS
FP.</> FilePath
fp)))
forceUtf8Enc :: ShowS
forceUtf8Enc = ByteString -> FilePath
S8.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
packWith :: (FilePath -> TarPath -> IO Entry)
-> Bool -> FilePath -> RIO env Entry
packWith FilePath -> TarPath -> IO Entry
f Bool
isDir FilePath
fp = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> TarPath -> IO Entry
f (FilePath
pkgFp FilePath -> ShowS
FP.</> FilePath
fp) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> FilePath -> IO TarPath
tarPath Bool
isDir FilePath
fp
packDir :: FilePath -> RIO env Entry
packDir = (FilePath -> TarPath -> IO Entry)
-> Bool -> FilePath -> RIO env Entry
packWith FilePath -> TarPath -> IO Entry
Tar.packDirectoryEntry Bool
True
packFile :: FilePath -> RIO env Entry
packFile FilePath
fp
| Bool
tweakCabal Bool -> Bool -> Bool
&& FilePath -> Bool
isCabalFp FilePath
fp Bool -> Bool -> Bool
&& Bool
asRevision = do
(PackageIdentifier, ByteString)
lbsIdent <- forall env.
HasEnvConfig env =>
PvpBoundsType
-> Maybe Int
-> Path Abs File
-> SourceMap
-> RIO env (PackageIdentifier, ByteString)
getCabalLbs PvpBoundsType
pvpBounds (forall a. a -> Maybe a
Just Int
1) Path Abs File
cabalfp SourceMap
sourceMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe (PackageIdentifier, ByteString))
cabalFileRevisionRef (forall a. a -> Maybe a
Just (PackageIdentifier, ByteString)
lbsIdent))
(FilePath -> TarPath -> IO Entry)
-> Bool -> FilePath -> RIO env Entry
packWith FilePath -> TarPath -> IO Entry
packFileEntry Bool
False FilePath
fp
| Bool
tweakCabal Bool -> Bool -> Bool
&& FilePath -> Bool
isCabalFp FilePath
fp = do
(PackageIdentifier
_ident, ByteString
lbs) <- forall env.
HasEnvConfig env =>
PvpBoundsType
-> Maybe Int
-> Path Abs File
-> SourceMap
-> RIO env (PackageIdentifier, ByteString)
getCabalLbs PvpBoundsType
pvpBounds forall a. Maybe a
Nothing Path Abs File
cabalfp SourceMap
sourceMap
POSIXTime
currTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
TarPath
tp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO TarPath
tarPath Bool
False FilePath
fp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (TarPath -> ByteString -> Entry
Tar.fileEntry TarPath
tp ByteString
lbs) { entryTime :: EpochTime
Tar.entryTime = forall a b. (RealFrac a, Integral b) => a -> b
floor POSIXTime
currTime }
| Bool
otherwise = (FilePath -> TarPath -> IO Entry)
-> Bool -> FilePath -> RIO env Entry
packWith FilePath -> TarPath -> IO Entry
packFileEntry Bool
False FilePath
fp
isCabalFp :: FilePath -> Bool
isCabalFp FilePath
fp = forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
pkgDir FilePath -> ShowS
FP.</> FilePath
fp forall a. Eq a => a -> a -> Bool
== forall b t. Path b t -> FilePath
toFilePath Path Abs File
cabalfp
tarName :: FilePath
tarName = FilePath
pkgId FilePath -> ShowS
FP.<.> FilePath
"tar.gz"
pkgId :: FilePath
pkgId = PackageIdentifier -> FilePath
packageIdentifierString (Package -> PackageIdentifier
packageIdentifier (LocalPackage -> Package
lpPackage LocalPackage
lp))
[Entry]
dirEntries <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> RIO env Entry
packDir ([FilePath] -> [FilePath]
dirsFromFiles [FilePath]
files)
[Entry]
fileEntries <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> RIO env Entry
packFile [FilePath]
files
Maybe (PackageIdentifier, ByteString)
mcabalFileRevision <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Maybe (PackageIdentifier, ByteString))
cabalFileRevisionRef)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
tarName, ByteString -> ByteString
GZip.compress ([Entry] -> ByteString
Tar.write ([Entry]
dirEntries forall a. [a] -> [a] -> [a]
++ [Entry]
fileEntries)), Maybe (PackageIdentifier, ByteString)
mcabalFileRevision)
getCabalLbs :: HasEnvConfig env
=> PvpBoundsType
-> Maybe Int
-> Path Abs File
-> SourceMap
-> RIO env (PackageIdentifier, L.ByteString)
getCabalLbs :: forall env.
HasEnvConfig env =>
PvpBoundsType
-> Maybe Int
-> Path Abs File
-> SourceMap
-> RIO env (PackageIdentifier, ByteString)
getCabalLbs PvpBoundsType
pvpBounds Maybe Int
mrev Path Abs File
cabalfp SourceMap
sourceMap = do
(PrintWarnings -> IO GenericPackageDescription
gpdio, PackageName
_name, Path Abs File
cabalfp') <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Path Abs Dir
-> RIO
env
(PrintWarnings -> IO GenericPackageDescription, PackageName,
Path Abs File)
loadCabalFilePath (forall b t. Path b t -> Path b Dir
parent Path Abs File
cabalfp)
GenericPackageDescription
gpd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ PrintWarnings -> IO GenericPackageDescription
gpdio PrintWarnings
NoPrintWarnings
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Path Abs File
cabalfp forall a. Eq a => a -> a -> Bool
== Path Abs File
cabalfp')
forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"getCabalLbs: cabalfp /= cabalfp': " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (Path Abs File
cabalfp, Path Abs File
cabalfp')
InstallMap
installMap <- forall (m :: * -> *). MonadIO m => SourceMap -> m InstallMap
toInstallMap SourceMap
sourceMap
(InstalledMap
installedMap, [DumpPackage]
_, [DumpPackage]
_, [DumpPackage]
_) <- forall env.
HasEnvConfig env =>
InstallMap
-> RIO
env (InstalledMap, [DumpPackage], [DumpPackage], [DumpPackage])
getInstalled InstallMap
installMap
let internalPackages :: Set PackageName
internalPackages = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
GenericPackageDescription -> PackageName
gpdPackageName GenericPackageDescription
gpd forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map (UnqualComponentName -> PackageName
Cabal.unqualComponentNameToPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
Cabal.condSubLibraries GenericPackageDescription
gpd)
gpd' :: GenericPackageDescription
gpd' = forall a b.
(Data a, Typeable b) =>
(Typeable b => b -> b) -> a -> a
gtraverseT (Set PackageName
-> InstallMap -> InstalledMap -> Dependency -> Dependency
addBounds Set PackageName
internalPackages InstallMap
installMap InstalledMap
installedMap) GenericPackageDescription
gpd
gpd'' :: GenericPackageDescription
gpd'' =
case Maybe Int
mrev of
Maybe Int
Nothing -> GenericPackageDescription
gpd'
Just Int
rev -> GenericPackageDescription
gpd'
{ packageDescription :: PackageDescription
Cabal.packageDescription
= (GenericPackageDescription -> PackageDescription
Cabal.packageDescription GenericPackageDescription
gpd')
{ customFieldsPD :: [(FilePath, FilePath)]
Cabal.customFieldsPD
= ((FilePath
"x-revision", forall a. Show a => a -> FilePath
show Int
rev)forall a. a -> [a] -> [a]
:)
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\(FilePath
x, FilePath
_) -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
x forall a. Eq a => a -> a -> Bool
/= FilePath
"x-revision")
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [(FilePath, FilePath)]
Cabal.customFieldsPD
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
Cabal.packageDescription GenericPackageDescription
gpd'
}
}
ident :: PackageIdentifier
ident = PackageDescription -> PackageIdentifier
Cabal.package forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> PackageDescription
Cabal.packageDescription GenericPackageDescription
gpd''
let roundtripErrs :: [StyleDoc]
roundtripErrs =
[ FilePath -> StyleDoc
flow FilePath
"Bug detected in Cabal library. ((parse . render . parse) === id) does not hold for the cabal file at"
StyleDoc -> StyleDoc -> StyleDoc
<+> forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
cabalfp
, StyleDoc
""
]
([PWarning]
_warnings, Either (Maybe Version, NonEmpty PError) GenericPackageDescription
eres) = forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
Cabal.runParseResult
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseResult GenericPackageDescription
Cabal.parseGenericPackageDescription
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> FilePath
showGenericPackageDescription GenericPackageDescription
gpd
case Either (Maybe Version, NonEmpty PError) GenericPackageDescription
eres of
Right GenericPackageDescription
roundtripped
| GenericPackageDescription
roundtripped forall a. Eq a => a -> a -> Bool
== GenericPackageDescription
gpd -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyWarn forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> StyleDoc
vsep forall a b. (a -> b) -> a -> b
$ [StyleDoc]
roundtripErrs forall a. [a] -> [a] -> [a]
++
[ StyleDoc
"This seems to be fixed in development versions of Cabal, but at time of writing, the fix is not in any released versions."
, StyleDoc
""
, StyleDoc
"Please see this GitHub issue for status:" StyleDoc -> StyleDoc -> StyleDoc
<+> Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/issues/3549"
, StyleDoc
""
, [StyleDoc] -> StyleDoc
fillSep
[ FilePath -> StyleDoc
flow FilePath
"If the issue is closed as resolved, then you may be able to fix this by upgrading to a newer version of stack via"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"stack upgrade"
, FilePath -> StyleDoc
flow FilePath
"for latest stable version or"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"stack upgrade --git"
, FilePath -> StyleDoc
flow FilePath
"for the latest development version."
]
, StyleDoc
""
, [StyleDoc] -> StyleDoc
fillSep
[ FilePath -> StyleDoc
flow FilePath
"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"
, Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/issues/new"
]
, StyleDoc
""
, FilePath -> StyleDoc
flow FilePath
"If the issue is not fixed, feel free to leave a comment on it indicating that you would like it to be fixed."
, StyleDoc
""
]
Left (Maybe Version
_version, NonEmpty PError
errs) -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyWarn forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> StyleDoc
vsep forall a b. (a -> b) -> a -> b
$ [StyleDoc]
roundtripErrs forall a. [a] -> [a] -> [a]
++
[ FilePath -> StyleDoc
flow FilePath
"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"
, [StyleDoc] -> StyleDoc
bulletedList
[ Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/issues/new"
, Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/haskell/cabal/issues/new"
]
, FilePath -> StyleDoc
flow forall a b. (a -> b) -> a -> b
$ FilePath
"The parse error is: " forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> FilePath
show (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty PError
errs))
, StyleDoc
""
]
forall (m :: * -> *) a. Monad m => a -> m a
return
( PackageIdentifier
ident
, Text -> ByteString
TLE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ FilePath -> Text
TL.pack forall a b. (a -> b) -> a -> b
$ GenericPackageDescription -> FilePath
showGenericPackageDescription GenericPackageDescription
gpd''
)
where
addBounds :: Set PackageName -> InstallMap -> InstalledMap -> Dependency -> Dependency
addBounds :: Set PackageName
-> InstallMap -> InstalledMap -> Dependency -> Dependency
addBounds Set PackageName
internalPackages InstallMap
installMap InstalledMap
installedMap dep :: Dependency
dep@(Dependency PackageName
name VersionRange
range NonEmptySet LibraryName
s) =
if PackageName
name forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PackageName
internalPackages
then Dependency
dep
else case Maybe Version
foundVersion of
Maybe Version
Nothing -> Dependency
dep
Just Version
version -> PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
Dependency PackageName
name (VersionRange -> VersionRange
simplifyVersionRange
forall a b. (a -> b) -> a -> b
$ (if Bool
toAddUpper Bool -> Bool -> Bool
&& Bool -> Bool
not (VersionRange -> Bool
hasUpperBound VersionRange
range) then Version -> VersionRange -> VersionRange
addUpper Version
version else forall a. a -> a
id)
forall a b. (a -> b) -> a -> b
$ (if Bool
toAddLower Bool -> Bool -> Bool
&& Bool -> Bool
not (VersionRange -> Bool
hasLowerBound VersionRange
range) then Version -> VersionRange -> VersionRange
addLower Version
version else forall a. a -> a
id)
VersionRange
range) NonEmptySet LibraryName
s
where
foundVersion :: Maybe Version
foundVersion =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name InstallMap
installMap of
Just (InstallLocation
_, Version
version) -> forall a. a -> Maybe a
Just Version
version
Maybe (InstallLocation, Version)
Nothing ->
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
name InstalledMap
installedMap of
Just (InstallLocation
_, Installed
installed) -> forall a. a -> Maybe a
Just (Installed -> Version
installedVersion Installed
installed)
Maybe (InstallLocation, Installed)
Nothing -> forall a. Maybe a
Nothing
addUpper :: Version -> VersionRange -> VersionRange
addUpper Version
version = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges
(Version -> VersionRange
earlierVersion forall a b. (a -> b) -> a -> b
$ Version -> Version
nextMajorVersion Version
version)
addLower :: Version -> VersionRange -> VersionRange
addLower Version
version = VersionRange -> VersionRange -> VersionRange
intersectVersionRanges (Version -> VersionRange
orLaterVersion Version
version)
(Bool
toAddLower, Bool
toAddUpper) =
case PvpBoundsType
pvpBounds of
PvpBoundsType
PvpBoundsNone -> (Bool
False, Bool
False)
PvpBoundsType
PvpBoundsUpper -> (Bool
False, Bool
True)
PvpBoundsType
PvpBoundsLower -> (Bool
True, Bool
False)
PvpBoundsType
PvpBoundsBoth -> (Bool
True, Bool
True)
gtraverseT :: (Data a,Typeable b) => (Typeable b => b -> b) -> a -> a
gtraverseT :: forall a b.
(Data a, Typeable b) =>
(Typeable b => b -> b) -> a -> a
gtraverseT Typeable b => b -> b
f =
forall a. Data a => (forall b. Data b => b -> b) -> a -> a
gmapT (\b
x -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast b
x of
Maybe b
Nothing -> forall a b.
(Data a, Typeable b) =>
(Typeable b => b -> b) -> a -> a
gtraverseT Typeable b => b -> b
f b
x
Just b
b -> forall a. a -> Maybe a -> a
fromMaybe b
x (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast (Typeable b => b -> b
f b
b)))
readLocalPackage :: HasEnvConfig env => Path Abs Dir -> RIO env LocalPackage
readLocalPackage :: forall env.
HasEnvConfig env =>
Path Abs Dir -> RIO env LocalPackage
readLocalPackage Path Abs Dir
pkgDir = do
PackageConfig
config <- forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasEnvConfig env) =>
m PackageConfig
getDefaultPackageConfig
(PrintWarnings -> IO GenericPackageDescription
gpdio, PackageName
_, Path Abs File
cabalfp) <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Path Abs Dir
-> RIO
env
(PrintWarnings -> IO GenericPackageDescription, PackageName,
Path Abs File)
loadCabalFilePath Path Abs Dir
pkgDir
GenericPackageDescription
gpd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ PrintWarnings -> IO GenericPackageDescription
gpdio PrintWarnings
YesPrintWarnings
let package :: Package
package = PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpd
forall (m :: * -> *) a. Monad m => a -> m a
return LocalPackage
{ lpPackage :: Package
lpPackage = Package
package
, lpWanted :: Bool
lpWanted = Bool
False
, lpCabalFile :: Path Abs File
lpCabalFile = Path Abs File
cabalfp
, lpTestDeps :: Map PackageName VersionRange
lpTestDeps = forall k a. Map k a
Map.empty
, lpBenchDeps :: Map PackageName VersionRange
lpBenchDeps = forall k a. Map k a
Map.empty
, lpTestBench :: Maybe Package
lpTestBench = forall a. Maybe a
Nothing
, lpBuildHaddocks :: Bool
lpBuildHaddocks = Bool
False
, lpForceDirty :: Bool
lpForceDirty = Bool
False
, lpDirtyFiles :: MemoizedWith EnvConfig (Maybe (Set FilePath))
lpDirtyFiles = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
, lpNewBuildCaches :: MemoizedWith
EnvConfig (Map NamedComponent (Map FilePath FileCacheInfo))
lpNewBuildCaches = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Map.empty
, lpComponentFiles :: MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
lpComponentFiles = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k a. Map k a
Map.empty
, lpComponents :: Set NamedComponent
lpComponents = forall a. Set a
Set.empty
, lpUnbuildable :: Set NamedComponent
lpUnbuildable = forall a. Set a
Set.empty
}
getSDistFileList :: HasEnvConfig env => LocalPackage -> Map PackageIdentifier GhcPkgId -> RIO env (String, Path Abs File)
getSDistFileList :: forall env.
HasEnvConfig env =>
LocalPackage
-> Map PackageIdentifier GhcPkgId
-> RIO env (FilePath, Path Abs File)
getSDistFileList LocalPackage
lp Map PackageIdentifier GhcPkgId
deps =
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> (Path Abs Dir -> m a) -> m a
withSystemTempDir (FilePath
stackProgName forall a. Semigroup a => a -> a -> a
<> FilePath
"-sdist") forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
tmpdir -> do
let bopts :: BuildOpts
bopts = BuildOpts
defaultBuildOpts
let boptsCli :: BuildOptsCLI
boptsCli = BuildOptsCLI
defaultBuildOptsCLI
BaseConfigOpts
baseConfigOpts <- forall env.
HasEnvConfig env =>
BuildOptsCLI -> RIO env BaseConfigOpts
mkBaseConfigOpts BuildOptsCLI
boptsCli
[LocalPackage]
locals <- forall env. HasEnvConfig env => RIO env [LocalPackage]
projectLocalPackages
forall env a.
HasEnvConfig env =>
BuildOpts
-> BuildOptsCLI
-> BaseConfigOpts
-> [LocalPackage]
-> [DumpPackage]
-> [DumpPackage]
-> [DumpPackage]
-> Maybe Int
-> (ExecuteEnv -> RIO env a)
-> RIO env a
withExecuteEnv BuildOpts
bopts BuildOptsCLI
boptsCli BaseConfigOpts
baseConfigOpts [LocalPackage]
locals
[] [] [] forall a. Maybe a
Nothing
forall a b. (a -> b) -> a -> b
$ \ExecuteEnv
ee ->
forall env a.
HasEnvConfig env =>
ActionContext
-> ExecuteEnv
-> Task
-> Map PackageIdentifier GhcPkgId
-> Maybe FilePath
-> (Package
-> Path Abs File
-> Path Abs Dir
-> (KeepOutputOpen -> ExcludeTHLoading -> [FilePath] -> RIO env ())
-> (Utf8Builder -> RIO env ())
-> OutputType
-> RIO env a)
-> RIO env a
withSingleContext ActionContext
ac ExecuteEnv
ee Task
task Map PackageIdentifier GhcPkgId
deps (forall a. a -> Maybe a
Just FilePath
"sdist") forall a b. (a -> b) -> a -> b
$ \Package
_package Path Abs File
cabalfp Path Abs Dir
_pkgDir KeepOutputOpen -> ExcludeTHLoading -> [FilePath] -> RIO env ()
cabal Utf8Builder -> RIO env ()
_announce OutputType
_outputType -> do
let outFile :: FilePath
outFile = forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
tmpdir FilePath -> ShowS
FP.</> FilePath
"source-files-list"
KeepOutputOpen -> ExcludeTHLoading -> [FilePath] -> RIO env ()
cabal KeepOutputOpen
CloseOnException ExcludeTHLoading
KeepTHLoading [FilePath
"sdist", FilePath
"--list-sources", FilePath
outFile]
ByteString
contents <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
S.readFile FilePath
outFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode ByteString
contents, Path Abs File
cabalfp)
where
package :: Package
package = LocalPackage -> Package
lpPackage LocalPackage
lp
ac :: ActionContext
ac = Set ActionId -> [Action] -> Concurrency -> ActionContext
ActionContext forall a. Set a
Set.empty [] Concurrency
ConcurrencyAllowed
task :: Task
task = Task
{ taskProvides :: PackageIdentifier
taskProvides = PackageName -> Version -> PackageIdentifier
PackageIdentifier (Package -> PackageName
packageName Package
package) (Package -> Version
packageVersion Package
package)
, taskType :: TaskType
taskType = LocalPackage -> TaskType
TTLocalMutable LocalPackage
lp
, taskConfigOpts :: TaskConfigOpts
taskConfigOpts = TaskConfigOpts
{ tcoMissing :: Set PackageIdentifier
tcoMissing = forall a. Set a
Set.empty
, tcoOpts :: Map PackageIdentifier GhcPkgId -> ConfigureOpts
tcoOpts = \Map PackageIdentifier GhcPkgId
_ -> [FilePath] -> [FilePath] -> ConfigureOpts
ConfigureOpts [] []
}
, taskBuildHaddock :: Bool
taskBuildHaddock = Bool
False
, taskPresent :: Map PackageIdentifier GhcPkgId
taskPresent = forall k a. Map k a
Map.empty
, taskAllInOne :: Bool
taskAllInOne = Bool
True
, taskCachePkgSrc :: CachePkgSrc
taskCachePkgSrc = FilePath -> CachePkgSrc
CacheSrcLocal (forall b t. Path b t -> FilePath
toFilePath (forall b t. Path b t -> Path b Dir
parent forall a b. (a -> b) -> a -> b
$ LocalPackage -> Path Abs File
lpCabalFile LocalPackage
lp))
, taskAnyMissing :: Bool
taskAnyMissing = Bool
True
, taskBuildTypeConfig :: Bool
taskBuildTypeConfig = Bool
False
}
normalizeTarballPaths :: HasRunner env => [FilePath] -> RIO env [FilePath]
normalizeTarballPaths :: forall env. HasRunner env => [FilePath] -> RIO env [FilePath]
normalizeTarballPaths [FilePath]
fps = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
outsideDir) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Warning: These files are outside of the package directory, and will be omitted from the tarball: " forall a. Semigroup a => a -> a -> a
<>
forall a. Show a => a -> Utf8Builder
displayShow [FilePath]
outsideDir
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => [a] -> [a]
nubOrd [FilePath]
files)
where
([FilePath]
outsideDir, [FilePath]
files) = forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Either FilePath FilePath
pathToEither [FilePath]
fps)
pathToEither :: FilePath -> Either FilePath FilePath
pathToEither FilePath
fp = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left FilePath
fp) forall a b. b -> Either a b
Right (FilePath -> Maybe FilePath
normalizePath FilePath
fp)
normalizePath :: FilePath -> Maybe FilePath
normalizePath :: FilePath -> Maybe FilePath
normalizePath = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> FilePath
FP.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Eq a, IsString a) => [a] -> Maybe [a]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
FP.splitDirectories forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
FP.normalise
where
go :: [a] -> Maybe [a]
go [] = forall a. a -> Maybe a
Just []
go (a
"..":[a]
_) = forall a. Maybe a
Nothing
go (a
_:a
"..":[a]
xs) = [a] -> Maybe [a]
go [a]
xs
go (a
x:[a]
xs) = (a
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Maybe [a]
go [a]
xs
dirsFromFiles :: [FilePath] -> [FilePath]
dirsFromFiles :: [FilePath] -> [FilePath]
dirsFromFiles [FilePath]
dirs = forall a. Set a -> [a]
Set.toAscList (forall a. Ord a => a -> Set a -> Set a
Set.delete FilePath
"." Set FilePath
results)
where
results :: Set FilePath
results = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Set FilePath
s -> Set FilePath -> FilePath -> Set FilePath
go Set FilePath
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
FP.takeDirectory) forall a. Set a
Set.empty [FilePath]
dirs
go :: Set FilePath -> FilePath -> Set FilePath
go Set FilePath
s FilePath
x
| forall a. Ord a => a -> Set a -> Bool
Set.member FilePath
x Set FilePath
s = Set FilePath
s
| Bool
otherwise = Set FilePath -> FilePath -> Set FilePath
go (forall a. Ord a => a -> Set a -> Set a
Set.insert FilePath
x Set FilePath
s) (ShowS
FP.takeDirectory FilePath
x)
checkSDistTarball
:: HasEnvConfig env
=> SDistOpts
-> Path Abs File
-> RIO env ()
checkSDistTarball :: forall env.
HasEnvConfig env =>
SDistOpts -> Path Abs File -> RIO env ()
checkSDistTarball SDistOpts
opts Path Abs File
tarball = forall env a.
Path Abs File -> (Path Abs Dir -> RIO env a) -> RIO env a
withTempTarGzContents Path Abs File
tarball forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
pkgDir' -> do
Path Abs Dir
pkgDir <- (Path Abs Dir
pkgDir' forall b t. Path b Dir -> Path Rel t -> Path b t
</>) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM`
(forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
FP.takeBaseName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
FP.takeBaseName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path Abs File
tarball)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SDistOpts -> Bool
sdoptsBuildTarball SDistOpts
opts) (forall env. HasEnvConfig env => ResolvedPath Dir -> RIO env ()
buildExtractedTarball ResolvedPath
{ resolvedRelative :: RelFilePath
resolvedRelative = Text -> RelFilePath
RelFilePath Text
"this-is-not-used"
, resolvedAbsolute :: Path Abs Dir
resolvedAbsolute = Path Abs Dir
pkgDir
})
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SDistOpts -> Bool
sdoptsIgnoreCheck SDistOpts
opts) (forall env. HasEnvConfig env => Path Abs Dir -> RIO env ()
checkPackageInExtractedTarball Path Abs Dir
pkgDir)
checkPackageInExtractedTarball
:: HasEnvConfig env
=> Path Abs Dir
-> RIO env ()
Path Abs Dir
pkgDir = do
(PrintWarnings -> IO GenericPackageDescription
gpdio, PackageName
name, Path Abs File
_cabalfp) <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Path Abs Dir
-> RIO
env
(PrintWarnings -> IO GenericPackageDescription, PackageName,
Path Abs File)
loadCabalFilePath Path Abs Dir
pkgDir
GenericPackageDescription
gpd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ PrintWarnings -> IO GenericPackageDescription
gpdio PrintWarnings
YesPrintWarnings
PackageConfig
config <- forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasEnvConfig env) =>
m PackageConfig
getDefaultPackageConfig
let PackageDescriptionPair PackageDescription
pkgDesc PackageDescription
_ = PackageConfig
-> GenericPackageDescription -> PackageDescriptionPair
resolvePackageDescription PackageConfig
config GenericPackageDescription
gpd
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Checking package '" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => FilePath -> a
fromString (PackageName -> FilePath
packageNameString PackageName
name) forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"' for common mistakes"
let pkgChecks :: [PackageCheck]
pkgChecks =
case GenericPackageDescription
-> Maybe PackageDescription -> [PackageCheck]
Check.checkPackage GenericPackageDescription
gpd forall a. Maybe a
Nothing of
[] -> GenericPackageDescription
-> Maybe PackageDescription -> [PackageCheck]
Check.checkPackage GenericPackageDescription
gpd (forall a. a -> Maybe a
Just PackageDescription
pkgDesc)
[PackageCheck]
x -> [PackageCheck]
x
[PackageCheck]
fileChecks <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Verbosity -> PackageDescription -> FilePath -> IO [PackageCheck]
Check.checkPackageFiles forall a. Bounded a => a
minBound PackageDescription
pkgDesc (forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
pkgDir)
let checks :: [PackageCheck]
checks = [PackageCheck]
pkgChecks forall a. [a] -> [a] -> [a]
++ [PackageCheck]
fileChecks
([PackageCheck]
errors, [PackageCheck]
warnings) =
let criticalIssue :: PackageCheck -> Bool
criticalIssue (Check.PackageBuildImpossible FilePath
_) = Bool
True
criticalIssue (Check.PackageDistInexcusable FilePath
_) = Bool
True
criticalIssue PackageCheck
_ = Bool
False
in forall a. (a -> Bool) -> [a] -> ([a], [a])
partition PackageCheck -> Bool
criticalIssue [PackageCheck]
checks
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
warnings) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Package check reported the following warnings:\n" forall a. Semigroup a => a -> a -> a
<>
forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Utf8Builder
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> Utf8Builder
displayShow forall a b. (a -> b) -> a -> b
$ [PackageCheck]
warnings)
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [PackageCheck]
errors of
Maybe (NonEmpty PackageCheck)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just NonEmpty PackageCheck
ne -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ NonEmpty PackageCheck -> CheckException
CheckException NonEmpty PackageCheck
ne
buildExtractedTarball :: HasEnvConfig env => ResolvedPath Dir -> RIO env ()
ResolvedPath Dir
pkgDir = do
EnvConfig
envConfig <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL
LocalPackage
localPackageToBuild <- forall env.
HasEnvConfig env =>
Path Abs Dir -> RIO env LocalPackage
readLocalPackage forall a b. (a -> b) -> a -> b
$ forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute ResolvedPath Dir
pkgDir
let isPathToRemove :: Path Abs Dir -> RIO env Bool
isPathToRemove Path Abs Dir
path = do
LocalPackage
localPackage <- forall env.
HasEnvConfig env =>
Path Abs Dir -> RIO env LocalPackage
readLocalPackage Path Abs Dir
path
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Package -> PackageName
packageName (LocalPackage -> Package
lpPackage LocalPackage
localPackage) forall a. Eq a => a -> a -> Bool
== Package -> PackageName
packageName (LocalPackage -> Package
lpPackage LocalPackage
localPackageToBuild)
Map PackageName ProjectPackage
pathsToKeep
<- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall k a. Map k a -> [(k, a)]
Map.toList (SMWanted -> Map PackageName ProjectPackage
smwProject (BuildConfig -> SMWanted
bcSMWanted (EnvConfig -> BuildConfig
envConfigBuildConfig EnvConfig
envConfig))))
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> RIO env Bool
isPathToRemove forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPackage -> ResolvedPath Dir
ppResolvedDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
ProjectPackage
pp <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
mkProjectPackage PrintWarnings
YesPrintWarnings ResolvedPath Dir
pkgDir Bool
False
let adjustEnvForBuild :: env -> env
adjustEnvForBuild env
env =
let updatedEnvConfig :: EnvConfig
updatedEnvConfig = EnvConfig
envConfig
{ envConfigSourceMap :: SourceMap
envConfigSourceMap = SourceMap -> SourceMap
updatePackagesInSourceMap (EnvConfig -> SourceMap
envConfigSourceMap EnvConfig
envConfig)
, envConfigBuildConfig :: BuildConfig
envConfigBuildConfig = BuildConfig -> BuildConfig
updateBuildConfig (EnvConfig -> BuildConfig
envConfigBuildConfig EnvConfig
envConfig)
}
updateBuildConfig :: BuildConfig -> BuildConfig
updateBuildConfig BuildConfig
bc = BuildConfig
bc
{ bcConfig :: Config
bcConfig = (BuildConfig -> Config
bcConfig BuildConfig
bc)
{ configBuild :: BuildOpts
configBuild = BuildOpts
defaultBuildOpts { boptsTests :: Bool
boptsTests = Bool
True } }
}
in forall s t a b. ASetter s t a b -> b -> s -> t
set forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL EnvConfig
updatedEnvConfig env
env
updatePackagesInSourceMap :: SourceMap -> SourceMap
updatePackagesInSourceMap SourceMap
sm =
SourceMap
sm {smProject :: Map PackageName ProjectPackage
smProject = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (CommonPackage -> PackageName
cpName forall a b. (a -> b) -> a -> b
$ ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp) ProjectPackage
pp Map PackageName ProjectPackage
pathsToKeep}
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local env -> env
adjustEnvForBuild forall a b. (a -> b) -> a -> b
$ forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
build forall a. Maybe a
Nothing
checkSDistTarball'
:: HasEnvConfig env
=> SDistOpts
-> String
-> L.ByteString
-> RIO env ()
checkSDistTarball' :: forall env.
HasEnvConfig env =>
SDistOpts -> FilePath -> ByteString -> RIO env ()
checkSDistTarball' SDistOpts
opts FilePath
name ByteString
bytes = forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> (Path Abs Dir -> m a) -> m a
withSystemTempDir FilePath
"stack" forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
tpath -> do
Path Abs File
npath <- (Path Abs Dir
tpath forall b t. Path b Dir -> Path Rel t -> Path b t
</>) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
name
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
L.writeFile (forall b t. Path b t -> FilePath
toFilePath Path Abs File
npath) ByteString
bytes
forall env.
HasEnvConfig env =>
SDistOpts -> Path Abs File -> RIO env ()
checkSDistTarball SDistOpts
opts Path Abs File
npath
withTempTarGzContents
:: Path Abs File
-> (Path Abs Dir -> RIO env a)
-> RIO env a
withTempTarGzContents :: forall env a.
Path Abs File -> (Path Abs Dir -> RIO env a) -> RIO env a
withTempTarGzContents Path Abs File
apath Path Abs Dir -> RIO env a
f = forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> (Path Abs Dir -> m a) -> m a
withSystemTempDir FilePath
"stack" forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
tpath -> do
ByteString
archive <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
L.readFile (forall b t. Path b t -> FilePath
toFilePath Path Abs File
apath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => FilePath -> Entries e -> IO ()
Tar.unpack (forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
tpath) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Entries FormatError
Tar.read forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZip.decompress forall a b. (a -> b) -> a -> b
$ ByteString
archive
Path Abs Dir -> RIO env a
f Path Abs Dir
tpath
packFileEntry :: FilePath
-> Tar.TarPath
-> IO Tar.Entry
packFileEntry :: FilePath -> TarPath -> IO Entry
packFileEntry FilePath
filepath TarPath
tarpath = do
EpochTime
mtime <- FilePath -> IO EpochTime
getModTime FilePath
filepath
Permissions
perms <- FilePath -> IO Permissions
getPermissions FilePath
filepath
ByteString
content <- FilePath -> IO ByteString
S.readFile FilePath
filepath
let size :: EpochTime
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
content)
forall (m :: * -> *) a. Monad m => a -> m a
return (TarPath -> EntryContent -> Entry
Tar.simpleEntry TarPath
tarpath (ByteString -> EpochTime -> EntryContent
Tar.NormalFile (ByteString -> ByteString
L.fromStrict ByteString
content) EpochTime
size)) {
entryPermissions :: Permissions
Tar.entryPermissions = if Permissions -> Bool
executable Permissions
perms then Permissions
Tar.executableFilePermissions
else Permissions
Tar.ordinaryFilePermissions,
entryTime :: EpochTime
Tar.entryTime = EpochTime
mtime
}
getModTime :: FilePath -> IO Tar.EpochTime
getModTime :: FilePath -> IO EpochTime
getModTime FilePath
path = do
UTCTime
t <- FilePath -> IO UTCTime
getModificationTime FilePath
path
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall a b. (a -> b) -> a -> b
$ UTCTime
t
getDefaultPackageConfig :: (MonadIO m, MonadReader env m, HasEnvConfig env)
=> m PackageConfig
getDefaultPackageConfig :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasEnvConfig env) =>
m PackageConfig
getDefaultPackageConfig = do
Platform
platform <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasPlatform env => Lens' env Platform
platformL
ActualCompiler
compilerVersion <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
forall (m :: * -> *) a. Monad m => a -> m a
return PackageConfig
{ packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
False
, packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
False
, packageConfigFlags :: Map FlagName Bool
packageConfigFlags = forall a. Monoid a => a
mempty
, packageConfigGhcOptions :: [Text]
packageConfigGhcOptions = []
, packageConfigCabalConfigOpts :: [Text]
packageConfigCabalConfigOpts = []
, packageConfigCompilerVersion :: ActualCompiler
packageConfigCompilerVersion = ActualCompiler
compilerVersion
, packageConfigPlatform :: Platform
packageConfigPlatform = Platform
platform
}