Adding support for different verbosity-levels

HackPort/Config.hs

@@ -0,0 +1,90 @@
+module Config where
+
+import System.Console.GetOpt
+import Control.Exception
+import Error
+import Verbosity
+
+data HackPortOptions
+	= TarCommand String
+	| PortageTree String
+	| Category String
+	| Server String
+	| TempDir String
+	| Verify
+	| Verbosity String
+
+data OperationMode
+	= Query String
+	| Merge String String
+	| ListAll
+	| ShowHelp
+
+data Config = Config
+	{ tarCommand		::String
+	, portageTree		::Maybe String
+	, portageCategory	::String
+	, server		::String
+	, tmp			::String
+	, verify		::Bool
+	, verbosity		::Verbosity
+	}
+
+defaultConfig :: Config
+defaultConfig = Config
+	{ tarCommand = "/bin/tar"
+	, portageTree = Nothing
+	, portageCategory = "dev-haskell"
+	, server = "http://hackage.haskell.org/ModHackage/Hackage.hs?action=xmlrpc"
+	, tmp = "/tmp"
+	, verify = False
+	, verbosity = Normal
+	}
+
+hackageOptions :: [OptDescr HackPortOptions]
+hackageOptions = [Option ['p'] ["portage-tree"] (ReqArg PortageTree "PATH") "The portage tree to merge to"
+	  ,Option ['c'] ["portage-category"] (ReqArg Category "CATEGORY") "The cateory the program belongs to"
+	  ,Option ['s'] ["server"] (ReqArg Server "URL") "The Hackage server to query"
+	  ,Option ['t'] ["temp-dir"] (ReqArg TempDir "PATH") "A temp directory where tarballs can be stored"
+          ,Option [] ["tar"] (ReqArg TarCommand "PATH") "Path to the \"tar\" executable"
+	  ,Option [] ["verify"] (NoArg Verify) "Verify downloaded tarballs using GnuPG"
+	  ,Option ['v'] ["verbosity"] (ReqArg Verbosity "debug|normal|silent") "Set verbosity level(default is 'normal')"
+	  ]
+
+optionsToConfig :: Config -> [HackPortOptions] -> Config
+optionsToConfig cfg [] = cfg
+optionsToConfig cfg (x:xs) = optionsToConfig (case x of
+	TarCommand str -> cfg { tarCommand = str }
+	PortageTree str -> cfg { portageTree = Just str }
+	Category str -> cfg { portageCategory = str }
+	Server str -> cfg { server = str }
+	TempDir str -> cfg { tmp = str }
+	Verify -> cfg { verify = True }
+	Verbosity str -> cfg { verbosity=maybe (throwDyn (UnknownVerbosityLevel str)) id (parseVerbosity str) }) xs
+
+parseConfig :: [String] -> Either String (Config,OperationMode)
+parseConfig opts = case getOpt Permute hackageOptions opts of
+	(popts,"query":[],[]) -> Left "Need a package name to query.\n"
+	(popts,"query":package:[],[]) -> Right (ropts popts,Query package)
+	(popts,"query":package:rest,[]) -> Left ("'query' takes one argument("++show ((length rest)+1)++" given).\n")
+	(popts,"merge":[],[]) -> Left "Need a package's name and version to merge it.\n"
+	(popts,"merge":package:[],[]) -> Left ("Need version of '"++package++"' to merge. Find available versions using 'hackport query package-name.\n")
+	(popts,"merge":package:version:[],[]) -> Right (ropts popts,Merge package version)
+	(popts,"merge":_:_:rest,[]) -> Left ("'merge' takes 2 arguments("++show ((length rest)+2)++" given).\n")
+	(popts,"list":[],[]) -> Right (ropts popts,ListAll)
+	(popts,"list":rest,[]) -> Left ("'list' takes zero arguments("++show (length rest)++" given).\n")
+	(popts,[],[]) -> Right (ropts popts,ShowHelp)
+	(_,_,[]) -> Left "Unknown opertation mode\n"
+	(_,_,errs) -> Left ("Error parsing flags:\n"++concat errs)
+	where
+	ropts op = optionsToConfig defaultConfig op
+
+hackageUsage :: IO ()
+hackageUsage = putStr (usageInfo "Usage:\t\"hackport [OPTION] MODE [MODETARGET]\"\n\t\"hackport [OPTION] list\" lists all available packages\n\t\"hackport [OPTION] query PKG\" shows all versions of a package\n\t\"hackport [OPTION] merge PKG VERSION\" merges a package into the portage tree\nOptions:" hackageOptions)
+
+parseVerbosity :: String -> Maybe Verbosity
+parseVerbosity "debug" = Just Debug
+parseVerbosity "normal" = Just Normal
+parseVerbosity "silent" = Just Silent
+parseVerbosity _ = Nothing
+

HackPort/Error.hs

@@ -20,6 +20,7 @@ data HackPortError
 	| BashError String
 	| NoOverlay
 	| MultipleOverlays [String]
+	| UnknownVerbosityLevel String
 	deriving (Typeable)
 
 type HackPortResult a = Either
@@ -41,3 +42,4 @@ hackPortShowError server package err = case err of
 	BashError str -> "Error while guessing your portage-overlay. Either set PORTDIR_OVERLAY in /etc/make.conf or use '-p path-to-overlay'.\nThe error was: \""++str++"\""
 	MultipleOverlays overlays -> "You have the following overlays available: '"++unwords overlays++"'. Please choose one by using '-p path-to-overlay'"
 	NoOverlay -> "You don't have PORTDIR_OVERLAY set in '/etc/make.conf'. Please set it or use '-p path-to-overlay'"
+	UnknownVerbosityLevel str -> "The verbosity level '"++str++"' is invalid. Please use debug,normal or silent"

HackPort/GenerateEbuild.hs

@@ -4,6 +4,7 @@ import Cabal2Ebuild
 import Fetch
 import TarUtils
 import Error
+import Verbosity
 
 import Prelude hiding (catch)
 import Control.Exception
@@ -12,11 +13,14 @@ import Distribution.PackageDescription
 import Distribution.Package
 import System.Directory
 
-mergeEbuild :: FilePath -> String -> EBuild -> IO ()
-mergeEbuild target category ebuild = do
-	let epath = target++"/"++category++"/"++(name ebuild)
-	createDirectoryIfMissing True epath
-	writeFile (epath++"/"++(name ebuild)++"-"++(version ebuild)++".ebuild") (showEBuild ebuild)
+mergeEbuild :: Verbosity -> FilePath -> String -> EBuild -> IO ()
+mergeEbuild verb target category ebuild = do
+	let edir = target++"/"++category++"/"++(name ebuild)
+	let epath = edir++"/"++(name ebuild)++"-"++(version ebuild)++".ebuild"
+	createDirectoryIfMissing True edir
+	writeFile epath (showEBuild ebuild) `sayNormal` ("Merging to '"++epath++"'\n")
+	where
+	sayNormal = verboseNormal verb
 
 hackage2ebuild :: 
 	FilePath ->		-- ^ the tar executable

HackPort/Main.hs

@@ -1,6 +1,5 @@
 module Main where
 
-import System.Console.GetOpt
 import System.Environment
 import System.Exit
 import Distribution.Package
@@ -12,84 +11,14 @@ import Query
 import GenerateEbuild
 import Cabal2Ebuild
 import Bash
-
-data HackPortOptions
-	= TarCommand String
-	| PortageTree String
-	| Category String
-	| Server String
-	| TempDir String
-	| Verify
-
-data OperationMode
-	= Query String
-	| Merge String String
-	| ListAll
-	| ShowHelp
-
-data Config = Config
-	{ tarCommand		::String
-	, portageTree		::Maybe String
-	, portageCategory	::String
-	, server		::String
-	, tmp			::String
-	, verify		::Bool
-	}
-
-defaultConfig :: Config
-defaultConfig = Config
-	{ tarCommand = "/bin/tar"
-	, portageTree = Nothing
-	, portageCategory = "dev-haskell"
-	, server = "http://hackage.haskell.org/ModHackage/Hackage.hs?action=xmlrpc"
-	, tmp = "/tmp"
-	, verify = False
-	}
-
-options :: [OptDescr HackPortOptions]
-options = [Option ['p'] ["portage-tree"] (ReqArg PortageTree "PATH") "The portage tree to merge to"
-	  ,Option ['c'] ["portage-category"] (ReqArg Category "CATEGORY") "The cateory the program belongs to"
-	  ,Option ['s'] ["server"] (ReqArg Server "URL") "The Hackage server to query"
-	  ,Option ['t'] ["temp-dir"] (ReqArg TempDir "PATH") "A temp directory where tarballs can be stored"
-          ,Option [] ["tar"] (ReqArg TarCommand "PATH") "Path to the \"tar\" executable"
-	  ,Option [] ["verify"] (NoArg Verify) "Verify downloaded tarballs using GnuPG"
-	  ]
-
-optionsToConfig :: Config -> [HackPortOptions] -> Config
-optionsToConfig cfg [] = cfg
-optionsToConfig cfg (x:xs) = optionsToConfig (case x of
-	TarCommand str -> cfg { tarCommand = str }
-	PortageTree str -> cfg { portageTree = Just str }
-	Category str -> cfg { portageCategory = str }
-	Server str -> cfg { server = str }
-	TempDir str -> cfg { tmp = str }
-	Verify -> cfg { verify = True }) xs
-
-parseConfig :: [String] -> Either String (Config,OperationMode)
-parseConfig opts = case getOpt Permute options opts of
-	(popts,"query":[],[]) -> Left "Need a package name to query.\n"
-	(popts,"query":package:[],[]) -> Right (ropts popts,Query package)
-	(popts,"query":package:rest,[]) -> Left ("'query' takes one argument("++show ((length rest)+1)++" given).\n")
-	(popts,"merge":[],[]) -> Left "Need a package's name and version to merge it.\n"
-	(popts,"merge":package:[],[]) -> Left ("Need version of '"++package++"' to merge. Find available versions using 'hackport query package-name.\n")
-	(popts,"merge":package:version:[],[]) -> Right (ropts popts,Merge package version)
-	(popts,"merge":_:_:rest,[]) -> Left ("'merge' takes 2 arguments("++show ((length rest)+2)++" given).\n")
-	(popts,"list":[],[]) -> Right (ropts popts,ListAll)
-	(popts,"list":rest,[]) -> Left ("'list' takes zero arguments("++show (length rest)++" given).\n")
-	(popts,[],[]) -> Right (ropts popts,ShowHelp)
-	(_,_,[]) -> Left "Unknown opertation mode\n"
-	(_,_,errs) -> Left ("Error parsing flags:\n"++concat errs)
-	where
-	ropts op = optionsToConfig defaultConfig op
+import Config
+import Verbosity
 
 listAll :: Config -> IO ()
 listAll cfg = do
 	pkgs <- getPackages (server cfg)
 	putStr (unlines pkgs)
 
-usage :: IO ()
-usage = putStr (usageInfo "Usage:\t\"hackport [OPTION] MODE [MODETARGET]\"\n\t\"hackport [OPTION] list\" lists all available packages\n\t\"hackport [OPTION] query PKG\" shows all versions of a package\n\t\"hackport [OPTION] merge PKG VERSION\" merges a package into the portage tree\nOptions:" options)
-
 query :: Config -> String -> IO ()
 query cfg name = do
 	pkgvers <- getPackageVersions (server cfg) name
@@ -98,13 +27,16 @@ query cfg name = do
 merge :: Config -> String -> String -> IO ()
 merge cfg name vers = do
 	portTree <- case portageTree cfg of
-		Nothing -> getOverlay
+		Nothing -> getOverlay `sayDebug` "Guessing overlay from /etc/make.conf...\n"
 		Just tree -> return tree
 	case parseVersion' vers of
 		Nothing -> putStr ("Error: couldn't parse version number '"++vers++"'\n")
 		Just realvers -> do
 			ebuild <- hackage2ebuild (tarCommand cfg) (server cfg) (tmp cfg) (verify cfg) (PackageIdentifier {pkgName=name,pkgVersion=realvers})
-			mergeEbuild portTree (portageCategory cfg) ebuild
+			mergeEbuild (verbosity cfg) portTree (portageCategory cfg) ebuild
+	where
+	sayDebug = verboseDebug (verbosity cfg)
+	sayNormal = verboseNormal (verbosity cfg)
 
 main :: IO ()
 main = do
@@ -114,7 +46,7 @@ main = do
 			putStr err
 			exitWith (ExitFailure 1)
 		Right (config,mode) -> (case mode of
-			ShowHelp -> usage
+			ShowHelp -> hackageUsage
 			ListAll -> listAll config
 			Query pkg -> query config pkg
 			Merge pkg vers -> merge config pkg vers) `catchDyn` (\x->putStr ((hackPortShowError (server config) Nothing x)++"\n"))

HackPort/Verbosity.hs

@@ -0,0 +1,17 @@
+module Verbosity where
+
+data Verbosity
+	= Debug
+	| Normal
+	| Silent
+
+verboseNormal :: Verbosity -> IO a -> String -> IO a
+verboseNormal verb action msg = case verb of
+	Silent -> action
+	_ -> putStr msg >> action
+
+verboseDebug :: Verbosity -> IO a -> String -> IO a
+verboseDebug verb action msg = case verb of
+	Silent -> action
+	Normal -> action
+	_ -> putStr msg >> action