Permalink
Browse files

Adding support for different verbosity-levels

  • Loading branch information...
1 parent 056d394 commit 980982ab80693bbbc136b2867033aa1bb4050b96 der_eq@freenet.de committed Sep 21, 2005
Showing with 126 additions and 81 deletions.
  1. +90 −0 HackPort/Config.hs
  2. +2 −0 HackPort/Error.hs
  3. +9 −5 HackPort/GenerateEbuild.hs
  4. +8 −76 HackPort/Main.hs
  5. +17 −0 HackPort/Verbosity.hs
View
@@ -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
+
View
@@ -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"
View
@@ -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
View
@@ -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"))
View
@@ -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

0 comments on commit 980982a

Please sign in to comment.