On Thu, Feb 23, 2012 at 04:48:55PM +0100, Iustin Pop wrote:
> On Thu, Feb 23, 2012 at 04:29:36PM +0100, Guido Trotter wrote:
> > On Tue, Feb 21, 2012 at 1:21 PM, Iustin Pop <[email protected]> wrote:
> > > +oPort :: Int -> OptType
> > > +oPort def = Option "p" ["--port"]
> > > + (ReqArg (\ p o -> tryRead "reading port" p >>= \p' ->
> > > + return (o { optPort = Just p' })) "PORT")
> > > + ("Network port (default: " ++ show def ++ ")")
> > > +
> >
> > Maybe we can extract something out of the reqArg? Anyway we may have
> > other command line options in the future that have to parse integer
> > arguments, so we can avoid embedding this here.
>
> Sure, absolutely. Although you'd need to pass in the "reading port",
> optPort, and similar, so we might not gain too much. But if we can, by
> all means.
>
> > > +-- | Command line parser, using the 'Options' structure.
> > > +parseOpts :: [String] -- ^ The command line arguments
> > > + -> String -- ^ The program name
> > > + -> [OptType] -- ^ The supported command line
> > > options
> > > + -> IO (DaemonOptions, [String]) -- ^ The resulting options
> > > + -- and leftover arguments
> > > +parseOpts argv progname options =
> > > + case getOpt Permute options argv of
> > > + (o, n, []) ->
> > > + do
> > > + let (pr, args) = (foldM (flip id) defaultOptions o, n)
> > > + po <- (case pr of
> > > + Bad msg -> do
> > > + hPutStrLn stderr "Error while parsing command\
> > > + \line arguments:"
> > > + hPutStrLn stderr msg
> > > + exitWith $ ExitFailure 1
> > > + Ok val -> return val)
> > > + when (optShowHelp po) $ do
> > > + putStr $ usageHelp progname options
> > > + exitWith ExitSuccess
> > > + when (optShowVer po) $ do
> > > + printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
> > > + progname Version.version
> > > + compilerName (Data.Version.showVersion compilerVersion)
> > > + os arch :: IO ()
> > > + exitWith ExitSuccess
> >
> > These two are not "parsing" arguments but are executing variations of
> > the program depending on them.
> > Not sure they belong to a "parseOpts" function. Also, is there really
> > no easier way to parse them? :)
>
> I have no idea :) This is code copied from Ganeti/HTools/CLI.hs, which
> was written before March 2009 :)
>
> We can split the various 'modes', but the basic parsing is the standard
> way to parse (see
> http://hackage.haskell.org/packages/archive/base/latest/doc/html/System-Console-GetOpt.html).
> A better option is switching to the more modern cmdargs module, but I
> haven't looked at that yet.
>
> > > +-- | Writes a PID file and locks it.
> > > +_writePidFile :: FilePath -> IO Fd
> > > +_writePidFile path = do
> > > + fd <- createFile path pidFileMode
> > > + setLock fd (WriteLock, AbsoluteSeek, 0, 0)
> > > + my_pid <- getProcessID
> > > + _ <- fdWrite fd (show my_pid ++ "\n")
> > > + return fd
> > > +
> > > +-- | Nice wrapper over '_writePidFile'.
> >
> > "Nice?" ? Also, this is the public function, so its docstring
> > shouldn't mention a private one but explain what it does.
>
> Sure then :) But I'd still mention the wrapper… Actually I wonder if
> this is not a generic function. It basically makes either an Ok or Bad
> if we got any IO exception. Hmm…
>
> > > +-- | Generic daemon startup.
> > > +genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) ->
> > > IO ()
> > > +genericMain daemon options main = do
> > > + (opts, args) <- parseArgs (daemonName daemon) options
> > > +
> > > + unless (null args) $ do
> > > + hPutStrLn stderr "This program doesn't take any arguments"
> > > + exitWith $ ExitFailure C.exitFailure
> > > +
> >
> > I believe evaluation of "help" and "version" goes here, and not during
> > the parsing.
>
> Agreed. But then we'll need to define a new type, oh noes!
OK, here's the interdiff; not much, but should have improved the
readability, I hope:
diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs
index af8b038..a88ffe8 100644
--- a/htools/Ganeti/Daemon.hs
+++ b/htools/Ganeti/Daemon.hs
@@ -86,6 +86,17 @@ defaultOptions = DaemonOptions
-- | Abrreviation for the option type.
type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
+-- | Helper function for required arguments which need to be converted
+-- as opposed to stored just as string.
+reqWithConversion :: (String -> Result a)
+ -> (a -> DaemonOptions -> Result DaemonOptions)
+ -> String
+ -> ArgDescr (DaemonOptions -> Result DaemonOptions)
+reqWithConversion conversion_fn updater_fn metavar =
+ ReqArg (\string_opt opts -> do
+ parsed_value <- conversion_fn string_opt
+ updater_fn parsed_value opts) metavar
+
-- * Command line options
oShowHelp :: OptType
@@ -115,8 +126,8 @@ oNoUserChecks = Option "" ["no-user-checks"]
oPort :: Int -> OptType
oPort def = Option "p" ["--port"]
- (ReqArg (\ p o -> tryRead "reading port" p >>= \p' ->
- return (o { optPort = Just p' })) "PORT")
+ (reqWithConversion (tryRead "reading port")
+ (\port opts -> Ok opts { optPort = Just port }) "PORT")
("Network port (default: " ++ show def ++ ")")
-- | Usage info.
@@ -133,26 +144,17 @@ parseOpts :: [String] -- ^ The command line
arguments
-- and leftover arguments
parseOpts argv progname options =
case getOpt Permute options argv of
- (o, n, []) ->
+ (opt_list, args, []) ->
do
- let (pr, args) = (foldM (flip id) defaultOptions o, n)
- po <- (case pr of
- Bad msg -> do
- hPutStrLn stderr "Error while parsing command\
- \line arguments:"
- hPutStrLn stderr msg
- exitWith $ ExitFailure 1
- Ok val -> return val)
- when (optShowHelp po) $ do
- putStr $ usageHelp progname options
- exitWith ExitSuccess
- when (optShowVer po) $ do
- printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
- progname Version.version
- compilerName (Data.Version.showVersion compilerVersion)
- os arch :: IO ()
- exitWith ExitSuccess
- return (po, args)
+ parsed_opts <-
+ case foldM (flip id) defaultOptions opt_list of
+ Bad msg -> do
+ hPutStrLn stderr "Error while parsing command\
+ \line arguments:"
+ hPutStrLn stderr msg
+ exitWith $ ExitFailure 1
+ Ok val -> return val
+ return (parsed_opts, args)
(_, _, errs) -> do
hPutStrLn stderr $ "Command line error: " ++ concat errs
hPutStrLn stderr $ usageHelp progname options
@@ -178,7 +180,8 @@ _writePidFile path = do
_ <- fdWrite fd (show my_pid ++ "\n")
return fd
--- | Nice wrapper over '_writePidFile'.
+-- | Wrapper over '_writePidFile' that transforms IO exceptions into a
+-- 'Bad' value.
writePidFile :: FilePath -> IO (Result Fd)
writePidFile path = do
catch (fmap Ok $ _writePidFile path) (return . Bad . show)
@@ -212,8 +215,18 @@ daemonize action = do
-- | Generic daemon startup.
genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
genericMain daemon options main = do
- (opts, args) <- parseArgs (daemonName daemon) options
-
+ let progname = daemonName daemon
+ (opts, args) <- parseArgs progname options
+
+ when (optShowHelp opts) $ do
+ putStr $ usageHelp progname options
+ exitWith ExitSuccess
+ when (optShowVer opts) $ do
+ printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
+ progname Version.version
+ compilerName (Data.Version.showVersion compilerVersion)
+ os arch :: IO ()
+ exitWith ExitSuccess
unless (null args) $ do
hPutStrLn stderr "This program doesn't take any arguments"
exitWith $ ExitFailure C.exitFailure
--
thanks,
iustin
