Add install --log-builds flag

Eg can use cabal install foo --log-builds='$pkgid-$compiler.log' and the build log for each package will written to a separate file. If an existing file is given then the log is appended. This or something like it should help in future with build reporting of the non-anonymous kind.
haskell · Jul 30, 2008 · 5702472 · 5702472
1 parent 5cb6ea3
commit 5702472
Show file tree

Hide file tree

Showing 2 changed files with 40 additions and 9 deletions.
diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
@@ -23,7 +23,10 @@ import Control.Monad
          ( when, unless )
 import System.Directory
          ( getTemporaryDirectory, doesFileExist )
-import System.FilePath ((</>),(<.>))
+import System.FilePath
+         ( (</>), (<.>) )
+import System.IO
+         ( openFile, IOMode(AppendMode) )
 
 import Distribution.Client.Dependency
          ( resolveDependenciesWithProgress, PackagesVersionPreference(..)
@@ -61,6 +64,9 @@ import Distribution.Simple.Setup
          ( flagToMaybe )
 import Distribution.Simple.Utils
          ( defaultPackageDesc, inDir, rawSystemExit, withTempDirectory )
+import Distribution.Simple.InstallDirs
+         ( fromPathTemplate, toPathTemplate
+         , initialPathTemplateEnv, substPathTemplate )
 import Distribution.Package
          ( PackageIdentifier(..), Package(..), thisPackageVersion )
 import Distribution.PackageDescription as PackageDescription
@@ -144,9 +150,10 @@ installWithPlanner planner verbosity packageDB repos comp conf configFlags insta
         installPlan' <-
           executeInstallPlan installPlan $ \cpkg ->
             installConfiguredPackage configFlags cpkg $ \configFlags' apkg ->
-              installAvailablePackage verbosity apkg $
+              installAvailablePackage verbosity apkg $ \pkg mpath ->
                 installUnpackedPackage verbosity (setupScriptOptions installed)
                                        miscOptions configFlags'
+                                       pkg mpath useLogFile
         writeInstallPlanBuildReports installPlan'
         writeInstallPlanBuildLog     installPlan'
         printBuildFailures installPlan'
@@ -163,6 +170,14 @@ installWithPlanner planner verbosity packageDB repos comp conf configFlags insta
       useLoggingHandle = Nothing,
       useWorkingDir    = Nothing
     }
+    useLogFile :: Maybe (PackageIdentifier -> FilePath)
+    useLogFile = fmap substLogFileName
+                   (Cabal.flagToMaybe (installLogFile installFlags))
+    substLogFileName path pkg = fromPathTemplate
+                              . substPathTemplate env
+                              . toPathTemplate
+                              $ path
+      where env = initialPathTemplateEnv (packageId pkg) (compilerId comp)
     dryRun       = Cabal.fromFlag (installDryRun installFlags)
     miscOptions  = InstallMisc {
       rootCmd    = if Cabal.fromFlag (Cabal.configUserInstall configFlags)
@@ -315,8 +330,10 @@ installUnpackedPackage :: Verbosity
                    -> Cabal.ConfigFlags
                    -> GenericPackageDescription
                    -> Maybe FilePath -- ^ Directory to change to before starting the installation.
+                   -> Maybe (PackageIdentifier -> FilePath) -- ^ File to log output to (if any)
                    -> IO BuildResult
-installUnpackedPackage verbosity scriptOptions miscOptions configFlags pkg mpath
+installUnpackedPackage verbosity scriptOptions miscOptions configFlags
+                       pkg workingDir useLogFile
     = onFailure ConfigureFailed $ do
         setup configureCommand (filterConfigureFlags configFlags)
         onFailure BuildFailed $ do
@@ -329,9 +346,14 @@ installUnpackedPackage verbosity scriptOptions miscOptions configFlags pkg mpath
             return BuildOk
   where
     buildCommand     = Cabal.buildCommand defaultProgramConfiguration
-    setup cmd flags  =
+    setup cmd flags  = do
+      logFileHandle <- case useLogFile of
+        Nothing          -> return Nothing
+        Just logFileName -> fmap Just $
+                              openFile (logFileName (packageId pkg)) AppendMode
       setupWrapper verbosity
-        scriptOptions { useWorkingDir = mpath }
+        scriptOptions { useLoggingHandle = logFileHandle
+                      , useWorkingDir    = workingDir }
         (Just $ PackageDescription.packageDescription pkg)
         cmd flags []
     reexec cmd = do
@@ -341,7 +363,7 @@ installUnpackedPackage verbosity scriptOptions miscOptions configFlags pkg mpath
       let self = bindir </> "cabal" <.> exeExtension
       weExist <- doesFileExist self
       if weExist
-        then inDir mpath $
+        then inDir workingDir $
                rawSystemExit verbosity cmd
                  [self, "install", "--only"
                  ,"--verbose=" ++ showForCabal verbosity]

diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
@@ -204,15 +204,17 @@ data InstallFlags = InstallFlags {
     installDryRun       :: Flag Bool,
     installOnly         :: Flag Bool,
     installRootCmd      :: Flag String,
-    installCabalVersion :: Flag Version
+    installCabalVersion :: Flag Version,
+    installLogFile      :: Flag FilePath
   }
 
 defaultInstallFlags :: InstallFlags
 defaultInstallFlags = InstallFlags {
     installDryRun       = Flag False,
     installOnly         = Flag False,
     installRootCmd      = mempty,
-    installCabalVersion = mempty
+    installCabalVersion = mempty,
+    installLogFile      = mempty
   }
 
 installCommand :: CommandUI (Cabal.ConfigFlags, InstallFlags)
@@ -241,6 +243,12 @@ installCommand = configureCommand {
           (reqArg "VERSION" (readP_to_E ("Cannot parse cabal lib version: "++)
                                         (fmap toFlag parse))
                             (map display . flagToList))
+
+      , option [] ["log-builds"]
+          "Log all builds to file (name template can use $pkgid, $compiler, $os, $arch)"
+          installLogFile (\v flags -> flags { installLogFile = v })
+          (reqArg' "FILE" toFlag flagToList)
+
       ] ++ case showOrParseArgs of      -- TODO: remove when "cabal install" avoids
           ParseArgs ->
             option [] ["only"]
@@ -257,7 +265,8 @@ instance Monoid InstallFlags where
     installDryRun       = combine installDryRun,
     installOnly         = combine installOnly,
     installRootCmd      = combine installRootCmd,
-    installCabalVersion = combine installCabalVersion
+    installCabalVersion = combine installCabalVersion,
+    installLogFile      = combine installLogFile
   }
     where combine field = field a `mappend` field b