Adds --target-packge-db

haskell · Nov 20, 2017 · e3dd744 · e3dd744
1 parent de1dc32
commit e3dd744
Show file tree

Hide file tree

Showing 6 changed files with 43 additions and 4 deletions.
diff --git a/Cabal/Distribution/Make.hs b/Cabal/Distribution/Make.hs
@@ -146,6 +146,8 @@ copyAction flags args = do
   let destArgs = case fromFlag $ copyDest flags of
         NoCopyDest      -> ["install"]
         CopyTo path     -> ["copy", "destdir=" ++ path]
+        CopyToDb _      -> error "CopyToDb not supported via Make"
+
   rawSystemExit (fromFlag $ copyVerbosity flags) "make" destArgs
 
 installAction :: InstallFlags -> [String] -> IO ()

diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs
@@ -742,7 +742,7 @@ defaultInstallHook :: PackageDescription -> LocalBuildInfo
 defaultInstallHook pkg_descr localbuildinfo _ flags = do
   let copyFlags = defaultCopyFlags {
                       copyDistPref   = installDistPref flags,
-                      copyDest       = toFlag NoCopyDest,
+                      copyDest       = installDest     flags,
                       copyVerbosity  = installVerbosity flags
                   }
   install pkg_descr localbuildinfo copyFlags

diff --git a/Cabal/Distribution/Simple/InstallDirs.hs b/Cabal/Distribution/Simple/InstallDirs.hs
@@ -59,7 +59,8 @@ import Distribution.Text
 import System.Directory (getAppUserDataDirectory)
 import System.FilePath
   ( (</>), isPathSeparator
-  , pathSeparator, dropDrive )
+  , pathSeparator, dropDrive
+  , takeDirectory )
 
 #ifdef mingw32_HOST_OS
 import qualified Prelude
@@ -287,19 +288,26 @@ absoluteInstallDirs :: PackageIdentifier
 absoluteInstallDirs pkgId libname compilerId copydest platform dirs =
     (case copydest of
        CopyTo destdir -> fmap ((destdir </>) . dropDrive)
+       CopyToDb dbdir -> fmap (substPrefix "${pkgroot}" (takeDirectory dbdir))
        _              -> id)
   . appendSubdirs (</>)
   . fmap fromPathTemplate
   $ substituteInstallDirTemplates env dirs
   where
     env = initialPathTemplateEnv pkgId libname compilerId platform
+    substPrefix pre root path
+      | pre `isPrefixOf` path = root ++ drop (length pre) path
+      | otherwise             = path
 
 
 -- |The location prefix for the /copy/ command.
 data CopyDest
   = NoCopyDest
   | CopyTo FilePath
-  deriving (Eq, Show)
+  | CopyToDb FilePath
+  deriving (Eq, Show, Generic)
+
+instance Binary CopyDest
 
 -- | Check which of the paths are relative to the installation $prefix.
 --

diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs
@@ -950,9 +950,21 @@ copyCommand = CommandUI
 
       ,option "" ["destdir"]
          "directory to copy files to, prepended to installation directories"
-         copyDest (\v flags -> flags { copyDest = v })
+         copyDest (\v flags -> case copyDest flags of
+                      NoFlag -> flags { copyDest = v }
+                      Flag NoCopyDest -> flags { copyDest = v }
+                      _ -> error "Use either 'destdir' or 'target-package-db'.")
          (reqArg "DIR" (succeedReadE (Flag . CopyTo))
                        (\f -> case f of Flag (CopyTo p) -> [p]; _ -> []))
+
+      ,option "" ["target-package-db"]
+         "package database to copy files into. Required when using ${pkgroot} prefix."
+         copyDest (\v flags -> case copyDest flags of
+                      NoFlag -> flags { copyDest = v }
+                      Flag NoCopyDest -> flags { copyDest = v }
+                      _ -> error "Use either 'destdir' or 'target-package-db'.")
+         (reqArg "DATABASE" (succeedReadE (Flag . CopyToDb))
+                            (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> []))
       ]
   }
 
@@ -973,6 +985,7 @@ instance Semigroup CopyFlags where
 -- | Flags to @install@: (package db, verbosity)
 data InstallFlags = InstallFlags {
     installPackageDB :: Flag PackageDB,
+    installDest      :: Flag CopyDest,
     installDistPref  :: Flag FilePath,
     installUseWrapper :: Flag Bool,
     installInPlace    :: Flag Bool,
@@ -983,6 +996,7 @@ data InstallFlags = InstallFlags {
 defaultInstallFlags :: InstallFlags
 defaultInstallFlags  = InstallFlags {
     installPackageDB = NoFlag,
+    installDest      = NoFlag,
     installDistPref  = NoFlag,
     installUseWrapper = Flag False,
     installInPlace    = Flag False,
@@ -1024,6 +1038,12 @@ installCommand = CommandUI
                       "upon configuration register this package in the user's local package database")
                     , (Flag GlobalPackageDB, ([],["global"]),
                       "(default) upon configuration register this package in the system-wide package database")])
+      ,option "" ["target-package-db"]
+         "package database to copy files into. Required when using ${pkgroot} prefix."
+         installDest (\v flags -> flags { installDest = v })
+         (reqArg "DATABASE" (succeedReadE (Flag . CopyToDb))
+                            (\f -> case f of Flag (CopyToDb p) -> [p]; _ -> []))
+
       ]
   }
 

diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs
@@ -502,6 +502,7 @@ convertToLegacySharedConfig
     installFlags = InstallFlags {
       installDocumentation     = mempty,
       installHaddockIndex      = projectConfigHaddockIndex,
+      installDest              = mempty,
       installDryRun            = projectConfigDryRun,
       installReinstall         = mempty, --projectConfigReinstall,
       installAvoidReinstalls   = mempty, --projectConfigAvoidReinstalls,

diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
@@ -1471,6 +1471,7 @@ instance Semigroup InfoFlags where
 data InstallFlags = InstallFlags {
     installDocumentation    :: Flag Bool,
     installHaddockIndex     :: Flag PathTemplate,
+    installDest             :: Flag Cabal.CopyDest,
     installDryRun           :: Flag Bool,
     installMaxBackjumps     :: Flag Int,
     installReorderGoals     :: Flag ReorderGoals,
@@ -1515,6 +1516,7 @@ defaultInstallFlags :: InstallFlags
 defaultInstallFlags = InstallFlags {
     installDocumentation   = Flag False,
     installHaddockIndex    = Flag docIndexFile,
+    installDest            = Flag Cabal.NoCopyDest,
     installDryRun          = Flag False,
     installMaxBackjumps    = Flag defaultMaxBackjumps,
     installReorderGoals    = Flag (ReorderGoals False),
@@ -1663,6 +1665,12 @@ installOptions showOrParseArgs =
           "Do not install anything, only print what would be installed."
           installDryRun (\v flags -> flags { installDryRun = v })
           trueArg
+
+      , option "" ["target-package-db"]
+         "package database to install into. Required when using ${pkgroot} prefix."
+         installDest (\v flags -> flags { installDest = v })
+         (reqArg "DATABASE" (succeedReadE (Flag . Cabal.CopyToDb))
+                            (\f -> case f of Flag (Cabal.CopyToDb p) -> [p]; _ -> []))
       ] ++
 
       optionSolverFlags showOrParseArgs