Commit 0de68ce6 authored by mnislaih's avatar mnislaih
Browse files

Upgraded to Distribution.Verbosity

parent c7654840
......@@ -33,6 +33,7 @@ import System.IO.Unsafe
import Distribution.Package (PackageIdentifier)
import Distribution.Version (Dependency)
import Distribution.Verbosity
import System.FilePath ((</>))
import System.Directory
......@@ -97,7 +98,7 @@ getKnownPackages cfg
-- |Write the list of known packages to the pkg.list file.
writeKnownPackages :: ConfigFlags -> [PkgInfo] -> IO ()
writeKnownPackages cfg pkgs
= do message (configOutputGen cfg) 2 $
= do message (configOutputGen cfg) verbose $
"creating package file " ++ pkgList cfg
createDirectoryIfMissing True (configPkgListDir cfg)
writeFile (pkgList cfg) (show pkgs)
......
......@@ -26,6 +26,7 @@ import Network.Hackage.CabalInstall.Config
import qualified Distribution.Simple.Configure as Configure (findProgram, configCompiler)
import Distribution.ParseUtils (showDependency)
import Distribution.Package (showPackageId)
import Distribution.Verbosity
import System.FilePath ((</>))
import Text.Printf (printf)
......@@ -36,9 +37,9 @@ import Data.Maybe (fromMaybe)
{-|
Structure with default responses to various events.
-}
defaultOutputGen :: Int -> IO OutputGen
defaultOutputGen verbose
= do (outch,errch) <- do guard (verbose <= 1)
defaultOutputGen :: Verbosity -> IO OutputGen
defaultOutputGen verbosity
= do (outch,errch) <- do guard (verbosity <= normal)
nullOut <- openFile ("/"</>"dev"</>"null") AppendMode
nullErr <- openFile ("/"</>"dev"</>"null") AppendMode
return (Just nullOut, Just nullErr)
......@@ -48,7 +49,7 @@ defaultOutputGen verbose
, pkgIsPresent = printf "'%s' is present.\n" . showPackageId
, downloadingPkg = printf "Downloading '%s'...\n" . showPackageId
, executingCmd = \cmd args
-> when (verbose > 0) $ printf "Executing: '%s %s'\n" cmd (unwords args)
-> when (verbosity > silent) $ printf "Executing: '%s %s'\n" cmd (unwords args)
, cmdFailed = \cmd args errno
-> error (printf "Command failed: '%s %s'. Errno: %d\n" cmd (unwords args) errno)
, buildingPkg = printf "Building '%s'\n" . showPackageId
......@@ -59,12 +60,12 @@ defaultOutputGen verbose
, noSetupScript = const (error "Couldn't find a setup script in the tarball.")
, noCabalFile = const (error "Couldn't find a .cabal file in the tarball")
, gettingPkgList = \serv ->
when (verbose > 0) (printf "Downloading package list from server '%s'\n" serv)
when (verbosity > silent) (printf "Downloading package list from server '%s'\n" serv)
, showPackageInfo = showPkgInfo
, showOtherPackageInfo = showOtherPkg
, cmdStdout = outch
, cmdStderr = errch
, message = \v s -> when (verbose >= v) (putStrLn s)
, message = \v s -> when (verbosity >= v) (putStrLn s)
}
where showOtherPkg mbPkg dep
= do printf " Package: '%s'\n" (show $ showDependency dep)
......@@ -123,9 +124,9 @@ mkConfigFlags cfg
[localConfigDir, defaultConfigDir] )
let cacheDir = fromMaybe localCacheDir (tempCacheDir cfg)
pkgListDir = fromMaybe localPkgListDir (tempPkgListDir cfg)
when (tempVerbose cfg > 1) $ do printf "Using config dir: %s\n" confDir
printf "Using cache dir: %s\n" cacheDir
printf "Using pkglist dir: %s\n" pkgListDir
when (tempVerbose cfg > normal) $ do printf "Using config dir: %s\n" confDir
printf "Using cache dir: %s\n" cacheDir
printf "Using pkglist dir: %s\n" pkgListDir
outputGen <- defaultOutputGen (tempVerbose cfg)
let config = ConfigFlags
{ configCompiler = comp
......
......@@ -15,7 +15,8 @@ module Network.Hackage.CabalInstall.Install
, installPkg -- :: ConfigFlags -> (PackageIdentifier,[String],String) -> IO ()
) where
import Data.List (elemIndex)
import Data.Maybe (fromJust)
import Debug.Trace
import Control.Exception (bracket_)
......@@ -28,6 +29,7 @@ import Network.Hackage.CabalInstall.TarUtils
import Distribution.SetupWrapper (setupWrapper)
import Distribution.Simple.Configure (getInstalledPackages)
import Distribution.Package (showPackageId, PackageIdentifier)
import Distribution.Verbosity
import System.FilePath ((</>), splitFileName)
import Data.Maybe (fromMaybe, maybeToList)
......@@ -66,10 +68,10 @@ mkPkgOps cfg cmd ops = verbosity ++
"configure" -> user ++ prefix ++ ops
"install" -> user
_ -> []
where verbosity = ["--verbose=" ++ show (configVerbose cfg)]
where verbosity = ["--verbose=" ++ showForCabal (configVerbose cfg)]
user = if configUserIns cfg then ["--user"] else []
prefix = maybeToList (fmap ("--prefix=" ++) (configPrefix cfg))
showForCabal v = show$ fromJust$ elemIndex v [silent,normal,verbose,deafening]
{-|
Download, build and install a given package with some given flags.
......@@ -101,12 +103,13 @@ installPkg cfg globalArgs (pkg,ops,location)
setup cmd
= let cmdOps = mkPkgOps cfg cmd (globalArgs++ops)
path = tmpDirPath </> showPackageId pkg
in do message output 3 $ unwords ["setupWrapper", show (cmd:cmdOps), show path]
in do message output deafening $
unwords ["setupWrapper", show (cmd:cmdOps), show path]
setupWrapper (cmd:cmdOps) (Just path)
bracket_ (createDirectoryIfMissing True tmpDirPath)
(removeDirectoryRecursive tmpDirPath)
(do copyFile pkgPath tmpPkgPath
message output 3 (printf "Extracting %s..." tmpPkgPath)
message output deafening (printf "Extracting %s..." tmpPkgPath)
extractTarFile tarProg tmpPkgPath
installUnpackedPkg cfg pkg tmpPkgPath setup
return ())
......
......@@ -21,6 +21,7 @@ import Data.Maybe (fromMaybe)
import Text.ParserCombinators.ReadP (readP_to_S)
import Distribution.ParseUtils (parseDependency)
import Distribution.Setup (defaultCompilerFlavor, CompilerFlavor(..))
import Distribution.Verbosity
import Data.List (find)
import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..), usageInfo, getOpt')
import System.Exit (exitWith, ExitCode (..))
......@@ -41,7 +42,7 @@ emptyTempFlags = TempFlags {
tempServers = [],
tempRunHc = Nothing,
tempTarPath = Nothing,
tempVerbose = 1,
tempVerbose = normal,
-- tempUpgradeDeps = False,
tempUserIns = True,
tempHelp = False
......@@ -49,9 +50,10 @@ emptyTempFlags = TempFlags {
cmd_verbose :: OptDescr (TempFlags -> TempFlags)
cmd_verbose = Option "v" ["verbose"] (OptArg verboseFlag "n")
"Control verbosity (n is 0--5, normal verbosity level is 1, -v alone is equivalent to -v2)"
"Control verbosity (n is 0--3, normal verbosity level is 1, -v alone is equivalent to -v2)"
where
verboseFlag mb_s t = t { tempVerbose = maybe 2 read mb_s }
verboseFlag mb_s t = t { tempVerbose = fromMaybe deafening $
maybe (Just verbose) (intToVerbosity . read) mb_s}
globalOptions :: [OptDescr (TempFlags -> TempFlags)]
globalOptions =
......
......@@ -15,6 +15,7 @@ module Network.Hackage.CabalInstall.Types where
import Distribution.Setup (CompilerFlavor(..),Compiler)
import Distribution.Package (PackageIdentifier)
import Distribution.Version (Dependency)
import Distribution.Verbosity
import System.IO (Handle)
......@@ -48,7 +49,7 @@ data TempFlags = TempFlags {
tempServers :: [String], -- ^Available Hackage servers.
tempTarPath :: Maybe FilePath,
tempRunHc :: Maybe FilePath,
tempVerbose :: Int, -- ^verbosity level
tempVerbose :: Verbosity, -- ^verbosity level
-- tempUpgradeDeps :: Bool,
tempUserIns :: Bool, -- ^--user-install flag
tempHelp :: Bool
......@@ -64,7 +65,7 @@ data ConfigFlags = ConfigFlags {
configTarPath :: FilePath,
configRunHc :: FilePath,
configOutputGen :: OutputGen,
configVerbose :: Int,
configVerbose :: Verbosity,
-- configUpgradeDeps :: Bool,
configUserIns :: Bool -- ^--user-install flag
}
......@@ -96,7 +97,7 @@ data OutputGen
, cmdStdout :: Maybe Handle
, cmdStderr :: Maybe Handle
, -- | Output a message.
message :: Int -- ^ minimum verbosity needed to output this message
message :: Verbosity -- ^ minimum verbosity needed to output this message
-> String -> IO ()
}
......
......@@ -21,6 +21,7 @@ import Network.Hackage.CabalInstall.Fetch (downloadIndex, packagesDirectory)
import Distribution.Package (PackageIdentifier(..), pkgName, showPackageId)
import Distribution.PackageDescription (PackageDescription(..), readPackageDescription)
import Distribution.Verbosity
import System.FilePath ((</>), joinPath, addExtension)
import Control.Monad (liftM)
......@@ -39,8 +40,10 @@ update cfg =
cabalFiles = [ packageDir </> path
| path <- contents
, ".cabal" `isSuffixOf` path ]
v = configVerbose cfg
v'= if v == verbose then normal else v
packageDescriptions <-
mapM (readPackageDescription (configVerbose cfg - 1)) cabalFiles
mapM (readPackageDescription v') cabalFiles
return $ map (parsePkg server) packageDescriptions
writeKnownPackages cfg packages
where servers = configServers cfg
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment