Make logging and verboisty a bit more consistent

Use the Distribution.Simple.Utils functions and eliminate use of printf

Hackage/Config.hs

@@ -15,7 +15,6 @@ module Hackage.Config
     , packageFile
     , packageDir
     , listInstalledPackages
-    , message
     , pkgURL
     , defaultConfigFile
     , loadConfig
@@ -24,14 +23,13 @@ module Hackage.Config
     ) where
 
 import Prelude hiding (catch)
-import Control.Monad (when)
 import Data.Char (isAlphaNum, toLower)
 import Data.List (intersperse)
 import Data.Maybe (fromMaybe)
-import Data.Monoid (mempty)
+import Control.Monad (when)
+import Data.Monoid (Monoid(mempty))
 import System.Directory (createDirectoryIfMissing, getAppUserDataDirectory)
 import System.FilePath ((</>), takeDirectory, (<.>))
-import System.IO (hPutStrLn, stderr)
 import Text.PrettyPrint.HughesPJ (text)
 
 import Distribution.Compat.ReadP (ReadP, char, munch1, readS_to_P)
@@ -46,10 +44,11 @@ import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplate, toPathTem
 import Distribution.Simple.Program (ProgramConfiguration, defaultProgramConfiguration)
 import Distribution.Simple.Setup (toFlag, fromFlagOrDefault)
 import Distribution.Version (showVersion)
-import Distribution.Verbosity (Verbosity, normal)
+import Distribution.Verbosity (normal)
 
 import Hackage.Types (ConfigFlags (..), PkgInfo (..), Repo(..))
 import Hackage.Utils
+import Distribution.Simple.Utils (notice, warn)
 
 
 -- | Full path to the local cache directory for a repository.
@@ -80,9 +79,6 @@ listInstalledPackages cfg comp conf =
                          conf
        return ipkgs
 
-message :: ConfigFlags -> Verbosity -> String -> IO ()
-message cfg v s = when (configVerbose cfg >= v) (putStrLn s)
-
 -- | Generate the URL of the tarball for a given package.
 pkgURL :: PkgInfo -> String
 pkgURL pkg = joinWith "/" [repoURL (pkgRepo pkg), pkgName p, showVersion (pkgVersion p), 
@@ -155,20 +151,22 @@ defaultConfigFlags =
 loadConfig :: FilePath -> IO ConfigFlags
 loadConfig configFile = 
     do defaultConf <- defaultConfigFlags
+       let verbosity = configVerbose defaultConf
        minp <- readFileIfExists configFile
        case minp of
-         Nothing -> do hPutStrLn stderr $ "Config file " ++ configFile ++ " not found."
-                       hPutStrLn stderr $ "Writing default configuration to " ++ configFile
+         Nothing -> do notice verbosity $ "Config file " ++ configFile ++ " not found."
+                       notice verbosity $ "Writing default configuration to " ++ configFile
                        writeDefaultConfigFile configFile defaultConf
                        return defaultConf
          Just inp -> case parseBasicStanza configFieldDescrs defaultConf inp of
                        ParseOk ws conf -> 
-                           do mapM_ (hPutStrLn stderr . ("Config file warning: " ++)) ws
+                           do when (not $ null ws) $
+                                warn verbosity $ "Config file: " ++ unlines ws
                               return conf
                        ParseFailed err -> 
-                           do hPutStrLn stderr $ "Error parsing config file " 
+                           do warn verbosity $ "Error parsing config file " 
                                             ++ configFile ++ ": " ++ showPError err
-                              hPutStrLn stderr $ "Using default configuration."
+                              warn verbosity $ "Using default configuration."
                               return defaultConf
 
 writeDefaultConfigFile :: FilePath -> ConfigFlags -> IO ()

Hackage/Fetch.hs

@@ -27,18 +27,17 @@ import Network.HTTP (ConnError(..), Request (..), simpleHTTP
 
 import Control.Exception (bracket)
 import Control.Monad (filterM)
-import Text.Printf (printf)
 import System.Directory (doesFileExist, createDirectoryIfMissing)
 
 import Hackage.Types (ConfigFlags (..), UnresolvedDependency (..), Repo(..), PkgInfo, pkgInfoId)
-import Hackage.Config (repoCacheDir, packageFile, packageDir, pkgURL, message)
+import Hackage.Config (repoCacheDir, packageFile, packageDir, pkgURL)
 import Hackage.Dependency (resolveDependencies, packagesToInstall)
 import Hackage.Utils
 
 import Distribution.Package (showPackageId)
 import Distribution.Simple.Compiler (Compiler)
 import Distribution.Simple.Program (ProgramConfiguration)
-import Distribution.Verbosity
+import Distribution.Simple.Utils (die, notice, debug)
 import System.FilePath ((</>), (<.>))
 import System.Directory (copyFile)
 import System.IO (IOMode(..), hPutStr, Handle, hClose, openBinaryFile)
@@ -50,10 +49,10 @@ readURI uri
     | otherwise = do
         eitherResult <- simpleHTTP (Request uri GET [] "")
         case eitherResult of
-           Left err -> fail $ printf "Failed to download '%s': %s" (show uri) (show err)
+           Left err -> die $ "Failed to download '" ++ show uri ++ "': " ++ show err
            Right rsp
                | rspCode rsp == (2,0,0) -> return (rspBody rsp)
-               | otherwise -> fail $ "Failed to download '" ++ show uri ++ "': Invalid HTTP code: " ++ show (rspCode rsp)
+               | otherwise -> die $ "Failed to download '" ++ show uri ++ "': Invalid HTTP code: " ++ show (rspCode rsp)
 
 downloadURI :: FilePath -- ^ Where to put it
             -> URI      -- ^ What to download
@@ -89,12 +88,13 @@ downloadPackage cfg pkg
     = do let url = pkgURL pkg
              dir = packageDir cfg pkg
              path = packageFile cfg pkg
-         message cfg verbose $ "GET " ++ show url
+         debug verbosity $ "GET " ++ show url
          createDirectoryIfMissing True dir
          mbError <- downloadFile path url
          case mbError of
-           Just err -> fail $ printf "Failed to download '%s': %s" (showPackageId (pkgInfoId pkg)) (show err)
+           Just err -> die $ "Failed to download '" ++ showPackageId (pkgInfoId pkg) ++ "': " ++ show err
            Nothing -> return path
+  where verbosity = configVerbose cfg
 
 -- Downloads an index file to [config-dir/packages/serv-id].
 downloadIndex :: ConfigFlags -> Repo -> IO FilePath
@@ -105,7 +105,7 @@ downloadIndex cfg repo
          createDirectoryIfMissing True dir
          mbError <- downloadFile path url
          case mbError of
-           Just err -> fail $ printf "Failed to download index '%s'" (show err)
+           Just err -> die $ "Failed to download index '" ++ show err ++ "'"
            Nothing  -> return path
 
 -- |Returns @True@ if the package has already been fetched.
@@ -117,17 +117,18 @@ fetchPackage :: ConfigFlags -> PkgInfo -> IO String
 fetchPackage cfg pkg
     = do fetched <- isFetched cfg pkg
          if fetched
-            then do printf "'%s' is cached.\n" (showPackageId (pkgInfoId pkg))
+            then do notice verbosity $ "'" ++ showPackageId (pkgInfoId pkg) ++ "' is cached."
                     return (packageFile cfg pkg)
-            else do printf "Downloading '%s'...\n" (showPackageId (pkgInfoId pkg))
+            else do notice verbosity $ "Downloading '" ++ showPackageId (pkgInfoId pkg) ++ "'..."
                     downloadPackage cfg pkg
+  where verbosity = configVerbose cfg
 
 -- |Fetch a list of packages and their dependencies.
 fetch :: ConfigFlags -> Compiler -> ProgramConfiguration -> [UnresolvedDependency] -> IO ()
 fetch cfg comp conf deps
     = do depTree <- resolveDependencies cfg comp conf deps
          case packagesToInstall depTree of
-           Left missing -> fail $ "Unresolved dependencies: " ++ showDependencies missing
+           Left missing -> die $ "Unresolved dependencies: " ++ showDependencies missing
            Right pkgs   -> do ps <- filterM (fmap not . isFetched cfg) $ map fst pkgs
                               mapM_ (fetchPackage cfg) ps
 

Hackage/Index.hs

@@ -28,6 +28,7 @@ import System.IO.Error (isDoesNotExistError)
 import Distribution.PackageDescription (parsePackageDescription, ParseResult(..))
 import Distribution.Package (PackageIdentifier(..))
 import Distribution.Version (readVersion)
+import Distribution.Simple.Utils (warn)
 
 getKnownPackages :: ConfigFlags -> IO [PkgInfo]
 getKnownPackages cfg
@@ -39,9 +40,10 @@ readRepoIndex cfg repo =
        fmap (parseRepoIndex repo) (BS.readFile indexFile)
           `catch` (\e -> do case e of
                               IOException ioe | isDoesNotExistError ioe ->
-                                hPutStrLn stderr "The package list does not exist. Run 'cabal update' to download it."
-                              _ -> hPutStrLn stderr ("Error: " ++ show e)
+                                warn verbosity "The package list does not exist. Run 'cabal update' to download it."
+                              _ -> warn verbosity (show e)
                             return [])
+  where verbosity = configVerbose cfg
 
 parseRepoIndex :: Repo -> ByteString -> [PkgInfo]
 parseRepoIndex repo s =

Hackage/Info.hs

@@ -22,44 +22,48 @@ import Distribution.Package (showPackageId)
 import Distribution.ParseUtils (showDependency)
 import Distribution.Simple.Compiler (Compiler)
 import Distribution.Simple.Program (ProgramConfiguration)
+import Distribution.Simple.Utils as Utils (notice, info)
 
-import Data.List (intersperse, nubBy)
-import Text.Printf (printf)
+import Data.List (nubBy)
 
 info :: ConfigFlags -> Compiler -> ProgramConfiguration -> [UnresolvedDependency] -> IO ()
 info cfg comp conf deps
     = do apkgs <- resolveDependencies cfg comp conf deps
-         mapM_ (infoPkg cfg) $ flattenResolvedPackages apkgs
+         details <- mapM (infoPkg cfg) (flattenResolvedPackages apkgs)
+         Utils.info verbosity $ unlines (map ("  "++) (concat details))
          case packagesToInstall apkgs of
-           Left missing -> 
-               do putStrLn "The requested packages cannot be installed, because of missing dependencies:"
-                  putStrLn $ showDependencies missing
-           Right pkgs  ->
-               do putStrLn "These packages would be installed:"
-                  putStrLn $ concat $ intersperse ", " [showPackageId (pkgInfoId pkg) | (pkg,_) <- pkgs]
-
+           Left missing -> notice verbosity $
+                "The requested packages cannot be installed, because of missing dependencies:\n"
+             ++ showDependencies missing
+
+           Right pkgs -> notice verbosity $
+               "These packages would be installed:\n"
+             ++ unlines [showPackageId (pkgInfoId pkg) | (pkg,_) <- pkgs]
+  where verbosity = configVerbose cfg
 
 flattenResolvedPackages :: [ResolvedPackage] -> [ResolvedPackage]
 flattenResolvedPackages = nubBy fulfillSame. concatMap flatten
     where flatten p@(Available _ _ _ deps) = p : flattenResolvedPackages deps
           flatten p = [p]
           fulfillSame a b = fulfills a == fulfills b
 
-infoPkg :: ConfigFlags -> ResolvedPackage -> IO ()
+infoPkg :: ConfigFlags -> ResolvedPackage -> IO [String]
 infoPkg _ (Installed dep p)
-    = do printf "  Requested:    %s\n" (show $ showDependency dep)
-         printf "    Installed:  %s\n\n" (showPackageId p)
+    = return ["Requested:    " ++ show (showDependency dep)
+             ,"  Installed:  " ++ showPackageId p]
 infoPkg cfg (Available dep pkg flags deps)
     = do fetched <- isFetched cfg pkg
-         let pkgFile = if fetched then packageFile cfg pkg
-                                  else  "*Not downloaded"
-         printf "  Requested:    %s\n" (show $ showDependency dep)
-         printf "    Using:      %s\n" (showPackageId (pkgInfoId pkg))
-         printf "    Depends:    %s\n" (showDependencies $ map fulfills deps)
-         printf "    Options:    %s\n" (unwords [ if set then flag else '-':flag
-                                                | (flag, set) <- flags ])
-         printf "    Location:   %s\n" (pkgURL pkg)
-         printf "    Local:      %s\n\n" pkgFile
+         return ["Requested:    " ++ show (showDependency dep)
+                ,"  Using:      " ++ showPackageId (pkgInfoId pkg)
+                ,"  Depends:    " ++ showDependencies (map fulfills deps)
+                ,"  Options:    " ++ unwords [ if set then flag else '-':flag
+                                             | (flag, set) <- flags ]
+                ,"  Location:   " ++ pkgURL pkg
+                ,"  Local:      " ++ if fetched
+                                        then packageFile cfg pkg
+                                        else  "*Not downloaded"
+                ]
 infoPkg _ (Unavailable dep)
-    = do printf "  Requested:    %s\n" (show $ showDependency dep)
-         printf "    Not available!\n\n"
+    = return ["Requested:    " ++ show (showDependency dep)
+             ,"  Not available!"
+             ]

Hackage/Install.hs

@@ -21,10 +21,6 @@ import System.Directory (getTemporaryDirectory, createDirectoryIfMissing
                         ,removeDirectoryRecursive, doesFileExist)
 import System.FilePath ((</>),(<.>))
 
-import Text.Printf (printf)
-
-
-import Hackage.Config (message)
 import Hackage.Dependency (resolveDependencies, resolveDependenciesLocal, packagesToInstall)
 import Hackage.Fetch (fetchPackage)
 import Hackage.Tar (extractTarGzFile)
@@ -41,9 +37,7 @@ import qualified Distribution.Simple.Setup as Cabal
 import Distribution.Simple.Utils (defaultPackageDesc)
 import Distribution.Package (showPackageId, PackageIdentifier(..))
 import Distribution.PackageDescription (readPackageDescription)
-import Distribution.Verbosity
-
-
+import Distribution.Simple.Utils as Utils (notice, info, debug, die)
 
 
 -- |Installs the packages needed to satisfy a list of dependencies.
@@ -60,17 +54,18 @@ installLocalPackage cfg comp conf configFlags =
       resolvedDeps <- resolveDependenciesLocal cfg comp conf desc
                         (Cabal.configConfigurationsFlags configFlags)
       case packagesToInstall resolvedDeps of
-        Left missing -> fail $ "Unresolved dependencies: " ++ showDependencies missing
+        Left missing -> die $ "Unresolved dependencies: " ++ showDependencies missing
         Right pkgs   -> installPackages cfg configFlags pkgs
       installUnpackedPkg cfg configFlags Nothing
 
 installRepoPackages :: ConfigFlags -> Compiler -> ProgramConfiguration -> Cabal.ConfigFlags -> [UnresolvedDependency] -> IO ()
 installRepoPackages cfg comp conf configFlags deps =
     do resolvedDeps <- resolveDependencies cfg comp conf deps
        case packagesToInstall resolvedDeps of
-         Left missing -> fail $ "Unresolved dependencies: " ++ showDependencies missing
-         Right []     -> message cfg normal "All requested packages already installed. Nothing to do."
+         Left missing -> die $ "Unresolved dependencies: " ++ showDependencies missing
+         Right []     -> notice verbosity "All requested packages already installed. Nothing to do."
          Right pkgs   -> installPackages cfg configFlags pkgs
+  where verbosity = configVerbose cfg
 
 installPackages :: ConfigFlags
                 -> Cabal.ConfigFlags -- ^Options which will be passed to every package.
@@ -107,19 +102,20 @@ installPkg cfg configFlags (pkg,flags)
     = do pkgPath <- fetchPackage cfg pkg
          tmp <- getTemporaryDirectory
          let p = pkgInfoId pkg
-             tmpDirPath = tmp </> printf "TMP%sTMP" (showPackageId p)
+             tmpDirPath = tmp </> ("TMP" ++ showPackageId p)
              path = tmpDirPath </> showPackageId p
          bracket_ (createDirectoryIfMissing True tmpDirPath)
                   (removeDirectoryRecursive tmpDirPath)
-                  (do message cfg verbose (printf "Extracting %s to %s..." pkgPath tmpDirPath)
+                  (do info verbosity $ "Extracting " ++ pkgPath ++ " to " ++ tmpDirPath ++ "..."
                       extractTarGzFile (Just tmpDirPath) pkgPath
                       let descFilePath = tmpDirPath </> showPackageId p </> pkgName p <.> "cabal"
                       e <- doesFileExist descFilePath
-                      when (not e) $ fail $ "Package .cabal file not found: " ++ show descFilePath
+                      when (not e) $ die $ "Package .cabal file not found: " ++ show descFilePath
                       let configFlags' = configFlags {
                             Cabal.configConfigurationsFlags =
                               Cabal.configConfigurationsFlags configFlags ++ flags }
                       installUnpackedPkg cfg configFlags' (Just path))
+  where verbosity = configVerbose cfg
 
 installUnpackedPkg :: ConfigFlags
                    -> Cabal.ConfigFlags -- ^ Arguments for this package
@@ -132,7 +128,7 @@ installUnpackedPkg cfg configFlags mpath
   where
     configureOptions = mkPkgOps cfg configFlags
     setup cmds
-        = do message cfg verbose $
+        = do debug (configVerbose cfg) $
                "setupWrapper in " ++ show mpath ++ " :\n " ++ show cmds
              setupWrapper cmds mpath
 

Hackage/Update.hs

@@ -18,9 +18,10 @@ import Hackage.Types
 import Hackage.Fetch
 import Hackage.Tar
 
+import Distribution.Simple.Utils (notice)
+
 import qualified Data.ByteString.Lazy as BS
 import System.FilePath (dropExtension)
-import Text.Printf
 
 -- | 'update' downloads the package list from all known servers
 update :: ConfigFlags -> IO ()
@@ -30,6 +31,7 @@ updateRepo :: ConfigFlags
            -> Repo
            -> IO ()
 updateRepo cfg repo =
-    do printf "Downloading package list from server '%s'\n" (repoURL repo)
+    do notice verbosity $ "Downloading package list from server '" ++ repoURL repo ++ "'"
        indexPath <- downloadIndex cfg repo
        BS.readFile indexPath >>= BS.writeFile (dropExtension indexPath) . gunzip
+  where verbosity = configVerbose cfg