From 8bf2f9ab2c1ff695b0ee5a8f2b7c65b6537a0a3e Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Oct 2016 23:23:44 +0530 Subject: [PATCH 01/10] Add explicit patches directory support to functions --- epm/Distribution/Client/Patch.hs | 37 +++++++++++++++++++++----------- 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/epm/Distribution/Client/Patch.hs b/epm/Distribution/Client/Patch.hs index 8aefd6d48c1..90ab6dd3538 100644 --- a/epm/Distribution/Client/Patch.hs +++ b/epm/Distribution/Client/Patch.hs @@ -24,25 +24,31 @@ import System.Directory ( doesFileExist ) import qualified Data.ByteString.Lazy as BS -patchedPackageCabalFile :: PackageIdentifier -> IO (Maybe BS.ByteString) +patchedPackageCabalFile :: PackageIdentifier + -> IO FilePath + -> IO (Maybe BS.ByteString) patchedPackageCabalFile (PackageIdentifier { pkgName = name - , pkgVersion = Version { versionBranch = versions } }) - = findCabalFilePatch $ unPackageName name + , pkgVersion = Version { versionBranch = versions } }) patchesDir + = findCabalFilePatch (unPackageName name ++ "-" ++ (intercalate "." $ map show versions) - <.> "cabal" + <.> "cabal") patchesDir -patchedTarPackageCabalFile :: FilePath -> IO (Maybe (FilePath, BS.ByteString)) -patchedTarPackageCabalFile tarFilePath = - fmap (fmap (\bs -> (cabalFile, bs))) $ findCabalFilePatch cabalFile +patchedTarPackageCabalFile :: FilePath + -> IO FilePath + -> IO (Maybe (FilePath, BS.ByteString)) +patchedTarPackageCabalFile tarFilePath patchesDir' = + fmap (fmap (\bs -> (cabalFile, bs))) $ findCabalFilePatch cabalFile patchesDir' where packageAndVersion = dropExtension . dropExtension $ tarFilePath cabalFile = packageAndVersion <.> "cabal" -findCabalFilePatch :: FilePath -> IO (Maybe BS.ByteString) -findCabalFilePatch cabalFile = do - patchesDir <- defaultPatchesDir +findCabalFilePatch :: FilePath + -> IO FilePath -- ^ Filepath of the patches directory + -> IO (Maybe BS.ByteString) +findCabalFilePatch cabalFile patchesDir' = do + patchesDir <- patchesDir' -- TODO: Speed this up with a cache? let cabalPatchLocation = patchesDir "patches" cabalFile exists <- doesFileExist cabalPatchLocation @@ -50,9 +56,14 @@ findCabalFilePatch cabalFile = do then fmap Just $ BS.readFile cabalPatchLocation else return Nothing -patchedExtractTarGzFile :: Verbosity -> FilePath -> FilePath -> FilePath -> IO () -patchedExtractTarGzFile verbosity dir expected tar = do - patchesDir <- defaultPatchesDir +patchedExtractTarGzFile :: Verbosity + -> FilePath -- ^ Destination directory of tar.gz file + -> FilePath -- ^ Expected subdir (to check for tarbombs) + -> FilePath -- ^ Tarball + -> IO FilePath -- ^ Filepath of the patches directory + -> IO () +patchedExtractTarGzFile verbosity dir expected tar patchesDir' = do + patchesDir <- patchesDir' -- TODO: Speed this up with a cache? let patchFileLocation = patchesDir "patches" patchFile exists <- doesFileExist patchFileLocation From a0d8e3474d5dbf44920ee312b5eda7f84a457828 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Oct 2016 23:25:16 +0530 Subject: [PATCH 02/10] Fix Targets module for the new type signature --- epm/Distribution/Client/Targets.hs | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/epm/Distribution/Client/Targets.hs b/epm/Distribution/Client/Targets.hs index 18723b073f8..1f888c5d49b 100644 --- a/epm/Distribution/Client/Targets.hs +++ b/epm/Distribution/Client/Targets.hs @@ -45,6 +45,10 @@ module Distribution.Client.Targets ( ) where +import System.Directory + ( getAppUserDataDirectory) +import System.FilePath + ( ()) import Distribution.Package ( Package(..), PackageName(..) , PackageIdentifier(..), packageName, packageVersion @@ -53,7 +57,6 @@ import Distribution.Client.Types ( SourcePackage(..), PackageLocation(..), OptionalStanza(..) ) import Distribution.Client.Dependency.Types ( PackageConstraint(..) ) - import qualified Distribution.Client.World as World import Distribution.Client.PackageIndex (PackageIndex) import qualified Distribution.Client.PackageIndex as PackageIndex @@ -462,6 +465,17 @@ fetchPackageTarget verbosity target = case target of -- -- This only affects targets given by location, named targets are unaffected. -- + +-- We are not using the functions present in Client.Config and +-- instead defining it again to avoid cyclic import error. +defaultCabalDir :: IO FilePath +defaultCabalDir = getAppUserDataDirectory "epm" + +defaultPatchesDir :: IO FilePath +defaultPatchesDir = do + dir <- defaultCabalDir + return $ dir "patches" + readPackageTarget :: Verbosity -> PackageTarget (PackageLocation FilePath) -> IO (PackageTarget SourcePackage) @@ -515,7 +529,7 @@ readPackageTarget verbosity target = case target of extractTarballPackageCabalFile :: FilePath -> String -> IO (FilePath, BS.ByteString) extractTarballPackageCabalFile tarballFile tarballOriginalLoc = do - maybePatchedCabalFile <- patchedTarPackageCabalFile tarballFile + maybePatchedCabalFile <- patchedTarPackageCabalFile tarballFile defaultPatchesDir maybe ( either (die . formatErr) return . check From 31fbaddf27af46c5cca150fe609cfbae9bdcbc35 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Oct 2016 23:25:38 +0530 Subject: [PATCH 03/10] Fix the Get module for the new type signature --- epm/Distribution/Client/Get.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/epm/Distribution/Client/Get.hs b/epm/Distribution/Client/Get.hs index e7e7b7280b4..5010a52d31c 100644 --- a/epm/Distribution/Client/Get.hs +++ b/epm/Distribution/Client/Get.hs @@ -43,7 +43,7 @@ import Distribution.Client.Compat.Process ( readProcessWithExitCode ) import Distribution.Compat.Exception ( catchIO ) - +import Distribution.Client.Config ( defaultPatchesDir ) import Control.Exception ( finally ) import Control.Monad @@ -170,7 +170,7 @@ unpackPackage verbosity prefix pkgid descOverride pkgPath = do when existsFile $ die $ "A file \"" ++ pkgdir ++ "\" is in the way, not unpacking." notice verbosity $ "Unpacking to " ++ pkgdir' - patchedExtractTarGzFile verbosity prefix pkgdirname pkgPath + patchedExtractTarGzFile verbosity prefix pkgdirname pkgPath defaultPatchesDir case descOverride of Nothing -> return () From 55e697277e57cb7be7a59ad5531e7ccdf9c6c978 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Oct 2016 23:26:04 +0530 Subject: [PATCH 04/10] Fix packageIndexFromCache compile error --- epm/Distribution/Client/IndexUtils.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/epm/Distribution/Client/IndexUtils.hs b/epm/Distribution/Client/IndexUtils.hs index e4162116259..b26a158c210 100644 --- a/epm/Distribution/Client/IndexUtils.hs +++ b/epm/Distribution/Client/IndexUtils.hs @@ -51,6 +51,7 @@ import Distribution.Simple.Program ( ProgramConfiguration ) import qualified Distribution.Simple.Configure as Configure ( getInstalledPackages ) +import Distribution.Client.Config ( defaultPatchesDir ) import Distribution.ParseUtils ( ParseResult(..) ) import Distribution.Version @@ -450,7 +451,7 @@ packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs -- from the index tarball if it turns out that we need it. -- Most of the time we only need the package id. ~(pkg, pkgtxt) <- unsafeInterleaveIO $ do - mPatch <- patchedPackageCabalFile pkgid + mPatch <- patchedPackageCabalFile pkgid defaultPatchesDir pkgtxt <- maybe (getEntryContent blockno) return mPatch pkg <- readPackageDescription pkgtxt return (pkg, pkgtxt) From 8aa1717dcdec6bf71c4e0738b45c95062642ef29 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Oct 2016 23:26:30 +0530 Subject: [PATCH 05/10] Add the additional flag and do the plumbing Effectively adds the option "--eta-patches-directory" --- epm/Distribution/Client/Setup.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/epm/Distribution/Client/Setup.hs b/epm/Distribution/Client/Setup.hs index 8c006766b54..38f598742df 100644 --- a/epm/Distribution/Client/Setup.hs +++ b/epm/Distribution/Client/Setup.hs @@ -1145,7 +1145,8 @@ data InstallFlags = InstallFlags { installSymlinkBinDir :: Flag FilePath, installOneShot :: Flag Bool, installNumJobs :: Flag (Maybe Int), - installRunTests :: Flag Bool + installRunTests :: Flag Bool, + installEtaPatchesDirectory :: Flag FilePath } defaultInstallFlags :: InstallFlags @@ -1172,7 +1173,8 @@ defaultInstallFlags = InstallFlags { installSymlinkBinDir = mempty, installOneShot = Flag False, installNumJobs = mempty, - installRunTests = mempty + installRunTests = mempty, + installEtaPatchesDirectory = mempty } where docIndexFile = toPathTemplate ("$datadir" "doc" @@ -1346,6 +1348,11 @@ installOptions showOrParseArgs = installSymlinkBinDir (\v flags -> flags { installSymlinkBinDir = v }) (reqArgFlag "DIR") + , option [] ["eta-patches-directory"] + "Specify explicit Eta patches directory" + installEtaPatchesDirectory (\v flags -> flags { installEtaPatchesDirectory = v }) + (reqArgFlag "DIR") + , option [] ["build-summary"] "Save build summaries to file (name template can use $pkgid, $compiler, $os, $arch)" installSummaryFile (\v flags -> flags { installSummaryFile = v }) @@ -1417,7 +1424,8 @@ instance Monoid InstallFlags where installSymlinkBinDir = mempty, installOneShot = mempty, installNumJobs = mempty, - installRunTests = mempty + installRunTests = mempty, + installEtaPatchesDirectory = mempty } mappend a b = InstallFlags { installDocumentation = combine installDocumentation, @@ -1442,7 +1450,8 @@ instance Monoid InstallFlags where installSymlinkBinDir = combine installSymlinkBinDir, installOneShot = combine installOneShot, installNumJobs = combine installNumJobs, - installRunTests = combine installRunTests + installRunTests = combine installRunTests, + installEtaPatchesDirectory = combine installEtaPatchesDirectory } where combine field = field a `mappend` field b From 41625bd7e68dfd66734e9f6da14e6c1fd7022aa8 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Oct 2016 23:43:52 +0530 Subject: [PATCH 06/10] Add installEtaPatchesDirectory option --- epm/Distribution/Client/Config.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/epm/Distribution/Client/Config.hs b/epm/Distribution/Client/Config.hs index 14b3790de2a..752a0a00d1a 100644 --- a/epm/Distribution/Client/Config.hs +++ b/epm/Distribution/Client/Config.hs @@ -228,6 +228,7 @@ instance Monoid SavedConfig where installShadowPkgs = combine installShadowPkgs, installStrongFlags = combine installStrongFlags, installReinstall = combine installReinstall, + installEtaPatchesDirectory = combine installEtaPatchesDirectory, installAvoidReinstalls = combine installAvoidReinstalls, installOverrideReinstall = combine installOverrideReinstall, installUpgradeDeps = combine installUpgradeDeps, From d5e27c610793770f23ab03de44d505bd85933dd7 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Oct 2016 23:44:09 +0530 Subject: [PATCH 07/10] implement patches option --- epm/Distribution/Client/Install.hs | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/epm/Distribution/Client/Install.hs b/epm/Distribution/Client/Install.hs index 9488b7b273a..d362ab333a2 100644 --- a/epm/Distribution/Client/Install.hs +++ b/epm/Distribution/Client/Install.hs @@ -79,7 +79,7 @@ import Distribution.Client.Setup , ConfigFlags(..), configureCommand, filterConfigureFlags , ConfigExFlags(..), InstallFlags(..) ) import Distribution.Client.Config - ( defaultCabalDir, defaultUserInstall ) + ( defaultCabalDir, defaultUserInstall, defaultPatchesDir ) import Distribution.Client.Patch import Distribution.Client.Sandbox.Timestamp ( withUpdateTimestamps ) @@ -1009,7 +1009,7 @@ performInstallations verbosity rpkg $ \configFlags' src pkg pkgoverride -> fetchSourcePackage verbosity fetchLimit src $ \src' -> installLocalPackage verbosity buildLimit - (packageId pkg) src' distPref $ \mpath -> + (packageId pkg) src' distPref etaPatchesDir $ \mpath -> installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key (setupScriptOptions installedPkgIndex cacheLock) miscOptions configFlags' installFlags haddockFlags @@ -1052,6 +1052,7 @@ performInstallations verbosity } reportingLevel = fromFlag (installBuildReports installFlags) logsDir = fromFlag (globalLogsDir globalFlags) + etaPatchesDir = fromFlagOrDefault [] (installEtaPatchesDirectory installFlags) -- Should the build output be written to a log file instead of stdout? useLogFile :: UseLogFile @@ -1234,9 +1235,10 @@ installLocalPackage :: Verbosity -> JobLimit -> PackageIdentifier -> PackageLocation FilePath -> FilePath + -> FilePath -> (Maybe FilePath -> IO BuildResult) -> IO BuildResult -installLocalPackage verbosity jobLimit pkgid location distPref installPkg = +installLocalPackage verbosity jobLimit pkgid location distPref patchDir installPkg = case location of @@ -1245,15 +1247,15 @@ installLocalPackage verbosity jobLimit pkgid location distPref installPkg = LocalTarballPackage tarballPath -> installLocalTarballPackage verbosity jobLimit - pkgid tarballPath distPref installPkg + pkgid tarballPath distPref installPkg patchDir RemoteTarballPackage _ tarballPath -> installLocalTarballPackage verbosity jobLimit - pkgid tarballPath distPref installPkg + pkgid tarballPath distPref installPkg patchDir RepoTarballPackage _ _ tarballPath -> installLocalTarballPackage verbosity jobLimit - pkgid tarballPath distPref installPkg + pkgid tarballPath distPref installPkg patchDir installLocalTarballPackage @@ -1261,9 +1263,10 @@ installLocalTarballPackage -> JobLimit -> PackageIdentifier -> FilePath -> FilePath -> (Maybe FilePath -> IO BuildResult) + -> FilePath -> IO BuildResult installLocalTarballPackage verbosity jobLimit pkgid - tarballPath distPref installPkg = do + tarballPath distPref installPkg patchDir = do tmp <- getTemporaryDirectory withTempDirectory verbosity tmp "cabal-tmp" $ \tmpDirPath -> onFailure UnpackFailed $ do @@ -1274,7 +1277,7 @@ installLocalTarballPackage verbosity jobLimit pkgid withJobLimit jobLimit $ do info verbosity $ "Extracting " ++ tarballPath ++ " to " ++ tmpDirPath ++ "..." - patchedExtractTarGzFile verbosity tmpDirPath relUnpackedPath tarballPath + patchedExtractTarGzFile verbosity tmpDirPath relUnpackedPath tarballPath (patchDir' patchDir) exists <- doesFileExist descFilePath when (not exists) $ die $ "Package .cabal file not found: " ++ show descFilePath @@ -1290,6 +1293,10 @@ installLocalTarballPackage verbosity jobLimit pkgid -- -- TODO: 'cabal get happy && cd sandbox && cabal install ../happy' still -- fails even with this workaround. We probably can live with that. + patchDir' pd = case pd of + [] -> defaultPatchesDir + _ -> return patchDir + maybeRenameDistDir :: FilePath -> IO () maybeRenameDistDir absUnpackedPath = do let distDirPath = absUnpackedPath defaultDistPref From 6f978879d2bcd514b9f2d0ed5b101defe055ab7b Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Thu, 27 Oct 2016 23:44:14 +0530 Subject: [PATCH 08/10] Fix the compile error --- epm/Distribution/Client/Patch.hs-boot | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/epm/Distribution/Client/Patch.hs-boot b/epm/Distribution/Client/Patch.hs-boot index b32d92de79a..722abf7de68 100644 --- a/epm/Distribution/Client/Patch.hs-boot +++ b/epm/Distribution/Client/Patch.hs-boot @@ -4,5 +4,9 @@ import Distribution.Package ( PackageIdentifier ) import System.FilePath ( FilePath ) import qualified Data.ByteString.Lazy as BS -patchedTarPackageCabalFile :: FilePath -> IO (Maybe (FilePath, BS.ByteString)) -patchedPackageCabalFile :: PackageIdentifier -> IO (Maybe BS.ByteString) \ No newline at end of file +patchedTarPackageCabalFile :: FilePath + -> IO FilePath + -> IO (Maybe (FilePath, BS.ByteString)) +patchedPackageCabalFile :: PackageIdentifier + -> IO FilePath + -> IO (Maybe BS.ByteString) From ccbe5e887bd60ebae53f996937a94787a0a082cf Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Sat, 29 Oct 2016 20:04:39 +0530 Subject: [PATCH 09/10] Change option name, type signature, documentation and reuse See Rahul's comment for more details: https://github.com/typelead/epm/pull/3 --- epm/Distribution/Client/Install.hs | 12 ++++-------- epm/Distribution/Client/Setup.hs | 2 +- epm/Distribution/Client/Targets.hs | 11 +---------- 3 files changed, 6 insertions(+), 19 deletions(-) diff --git a/epm/Distribution/Client/Install.hs b/epm/Distribution/Client/Install.hs index d362ab333a2..c3d0e2cf711 100644 --- a/epm/Distribution/Client/Install.hs +++ b/epm/Distribution/Client/Install.hs @@ -1052,7 +1052,7 @@ performInstallations verbosity } reportingLevel = fromFlag (installBuildReports installFlags) logsDir = fromFlag (globalLogsDir globalFlags) - etaPatchesDir = fromFlagOrDefault [] (installEtaPatchesDirectory installFlags) + etaPatchesDir = fromFlagOrDefault defaultPatchesDir (toFlag $ return $ fromFlag $ installEtaPatchesDirectory installFlags) -- Should the build output be written to a log file instead of stdout? useLogFile :: UseLogFile @@ -1235,7 +1235,7 @@ installLocalPackage :: Verbosity -> JobLimit -> PackageIdentifier -> PackageLocation FilePath -> FilePath - -> FilePath + -> IO FilePath -- ^ Patches directory option -> (Maybe FilePath -> IO BuildResult) -> IO BuildResult installLocalPackage verbosity jobLimit pkgid location distPref patchDir installPkg = @@ -1263,7 +1263,7 @@ installLocalTarballPackage -> JobLimit -> PackageIdentifier -> FilePath -> FilePath -> (Maybe FilePath -> IO BuildResult) - -> FilePath + -> IO FilePath -> IO BuildResult installLocalTarballPackage verbosity jobLimit pkgid tarballPath distPref installPkg patchDir = do @@ -1277,7 +1277,7 @@ installLocalTarballPackage verbosity jobLimit pkgid withJobLimit jobLimit $ do info verbosity $ "Extracting " ++ tarballPath ++ " to " ++ tmpDirPath ++ "..." - patchedExtractTarGzFile verbosity tmpDirPath relUnpackedPath tarballPath (patchDir' patchDir) + patchedExtractTarGzFile verbosity tmpDirPath relUnpackedPath tarballPath patchDir exists <- doesFileExist descFilePath when (not exists) $ die $ "Package .cabal file not found: " ++ show descFilePath @@ -1293,10 +1293,6 @@ installLocalTarballPackage verbosity jobLimit pkgid -- -- TODO: 'cabal get happy && cd sandbox && cabal install ../happy' still -- fails even with this workaround. We probably can live with that. - patchDir' pd = case pd of - [] -> defaultPatchesDir - _ -> return patchDir - maybeRenameDistDir :: FilePath -> IO () maybeRenameDistDir absUnpackedPath = do let distDirPath = absUnpackedPath defaultDistPref diff --git a/epm/Distribution/Client/Setup.hs b/epm/Distribution/Client/Setup.hs index 38f598742df..e9d3a884c74 100644 --- a/epm/Distribution/Client/Setup.hs +++ b/epm/Distribution/Client/Setup.hs @@ -1348,7 +1348,7 @@ installOptions showOrParseArgs = installSymlinkBinDir (\v flags -> flags { installSymlinkBinDir = v }) (reqArgFlag "DIR") - , option [] ["eta-patches-directory"] + , option [] ["patches-directory"] "Specify explicit Eta patches directory" installEtaPatchesDirectory (\v flags -> flags { installEtaPatchesDirectory = v }) (reqArgFlag "DIR") diff --git a/epm/Distribution/Client/Targets.hs b/epm/Distribution/Client/Targets.hs index 1f888c5d49b..0d71f338a4d 100644 --- a/epm/Distribution/Client/Targets.hs +++ b/epm/Distribution/Client/Targets.hs @@ -64,6 +64,7 @@ import qualified Distribution.Client.Tar as Tar import Distribution.Client.FetchUtils import Distribution.Client.Utils ( tryFindPackageDesc ) import {-# SOURCE #-} Distribution.Client.Patch ( patchedTarPackageCabalFile ) +import {-# SOURCE #-} Distribution.Client.Config (defaultCabalDir, defaultPatchesDir) import Distribution.PackageDescription ( GenericPackageDescription, FlagName(..), FlagAssignment ) @@ -466,16 +467,6 @@ fetchPackageTarget verbosity target = case target of -- This only affects targets given by location, named targets are unaffected. -- --- We are not using the functions present in Client.Config and --- instead defining it again to avoid cyclic import error. -defaultCabalDir :: IO FilePath -defaultCabalDir = getAppUserDataDirectory "epm" - -defaultPatchesDir :: IO FilePath -defaultPatchesDir = do - dir <- defaultCabalDir - return $ dir "patches" - readPackageTarget :: Verbosity -> PackageTarget (PackageLocation FilePath) -> IO (PackageTarget SourcePackage) From e3d036646fbb19a73f46e3c072b7ab48a9bcdf0a Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Sat, 29 Oct 2016 20:06:14 +0530 Subject: [PATCH 10/10] Add corresponding hs-boot file for mutually recursive modules --- epm/Distribution/Client/Config.hs-boot | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 epm/Distribution/Client/Config.hs-boot diff --git a/epm/Distribution/Client/Config.hs-boot b/epm/Distribution/Client/Config.hs-boot new file mode 100644 index 00000000000..6284b65938a --- /dev/null +++ b/epm/Distribution/Client/Config.hs-boot @@ -0,0 +1,4 @@ +module Distribution.Client.Config where + +defaultCabalDir :: IO FilePath +defaultPatchesDir :: IO FilePath