Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

gitit.hs option improvements #334

Merged
merged 2 commits into from

2 participants

Ben Millwood John MacFarlane
Ben Millwood

It bothered me that I got an error about the gitit configuration file even when I just wanted to run it with --help.

These commits help to guide a user towards prefix-independence:

  • --help, --version, --print-default-config now all avoid reading the configuration file before running (admittedly a bit pointless in the third case),
  • --help now includes a message indicating where gitit will look for default.conf, and how to change that path.
bmillwood added some commits
Ben Millwood bmillwood Don't read config for --help or --version
Also involves a refactor of options into those that make the program
quit immediately, and those that just alter the configuration.
c52180f
Ben Millwood bmillwood Include the default.conf location in --help fbd5af1
John MacFarlane jgm merged commit bee3af6 into from
Ben Millwood bmillwood deleted the branch
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Nov 30, 2012
  1. Ben Millwood

    Don't read config for --help or --version

    bmillwood authored
    Also involves a refactor of options into those that make the program
    quit immediately, and those that just alter the configuration.
Commits on Dec 25, 2012
  1. Ben Millwood
This page is out of date. Refresh to see the latest.
Showing with 41 additions and 24 deletions.
  1. +41 −24 gitit.hs
65 gitit.hs
View
@@ -24,6 +24,7 @@ import Network.Gitit.Server
import Network.Gitit.Util (readFileUTF8)
import System.Directory
import Data.Maybe (isNothing)
+import Control.Monad.Error()
import Control.Monad.Reader
import System.Log.Logger (Priority(..), setLevel, setHandlers,
getLogger, saveGlobalLogger)
@@ -44,7 +45,19 @@ main :: IO ()
main = do
-- parse options to get config file
- opts <- getArgs >>= parseArgs
+ args <- getArgs >>= parseArgs
+
+ -- sequence in Either monad gets first Left or all Rights
+ opts <- case sequence args of
+ Left Help -> putErr ExitSuccess =<< usageMessage
+ Left Version -> do
+ progname <- getProgName
+ putErr ExitSuccess (progname ++ " version " ++
+ showVersion version ++ compileInfo ++ copyrightMessage)
+ Left PrintDefaultConfig -> getDataFileName "data/default.conf" >>=
+ readFileUTF8 >>= B.putStrLn . fromString >> exitWith ExitSuccess
+ Right xs -> return xs
+
defaultConfig <- getDefaultConfig
conf <- foldM handleFlag defaultConfig opts
-- check for external programs that are needed
@@ -91,31 +104,35 @@ main = do
, dir "_reloadTemplates" reloadTemplates
]
-data Opt
+data ExitOpt
= Help
- | ConfigFile FilePath
- | Port Int
- | Listen String
- | Debug
| Version
| PrintDefaultConfig
+
+data ConfigOpt
+ = ConfigFile FilePath
+ | Port Int
+ | Listen String
+ | Debug
deriving (Eq)
+type Opt = Either ExitOpt ConfigOpt
+
flags :: [OptDescr Opt]
flags =
- [ Option ['h'] ["help"] (NoArg Help)
+ [ Option ['h'] ["help"] (NoArg (Left Help))
"Print this help message"
- , Option ['v'] ["version"] (NoArg Version)
+ , Option ['v'] ["version"] (NoArg (Left Version))
"Print version information"
- , Option ['p'] ["port"] (ReqArg (Port . read) "PORT")
+ , Option ['p'] ["port"] (ReqArg (Right . Port . read) "PORT")
"Specify port"
- , Option ['l'] ["listen"] (ReqArg (Listen . checkListen) "INTERFACE")
+ , Option ['l'] ["listen"] (ReqArg (Right . Listen . checkListen) "INTERFACE")
"Specify IP address to listen on"
- , Option [] ["print-default-config"] (NoArg PrintDefaultConfig)
+ , Option [] ["print-default-config"] (NoArg (Left PrintDefaultConfig))
"Print default configuration"
- , Option [] ["debug"] (NoArg Debug)
+ , Option [] ["debug"] (NoArg (Right Debug))
"Print debugging information on each request"
- , Option ['f'] ["config-file"] (ReqArg ConfigFile "FILE")
+ , Option ['f'] ["config-file"] (ReqArg (Right . ConfigFile) "FILE")
"Specify configuration file"
]
@@ -124,20 +141,24 @@ checkListen l | isIPv6address l = l
| isIPv4address l = l
| otherwise = error "Gitit.checkListen: Not a valid interface name"
-getListenOrDefault :: [Opt] -> String
+getListenOrDefault :: [ConfigOpt] -> String
getListenOrDefault [] = "0.0.0.0"
getListenOrDefault ((Listen l):_) = l
getListenOrDefault (_:os) = getListenOrDefault os
parseArgs :: [String] -> IO [Opt]
parseArgs argv = do
- progname <- getProgName
case getOpt Permute flags argv of
(opts,_,[]) -> return opts
- (_,_,errs) -> putErr (ExitFailure 1) (concat errs ++ usageInfo (usageHeader progname) flags)
+ (_,_,errs) -> putErr (ExitFailure 1) . (concat errs ++) =<< usageMessage
-usageHeader :: String -> String
-usageHeader progname = "Usage: " ++ progname ++ " [opts...]"
+usageMessage :: IO String
+usageMessage = do
+ progname <- getProgName
+ confLoc <- getDataFileName "data/default.conf"
+ return $ usageInfo ("Usage: " ++ progname ++ " [opts...]") flags
+ ++ "\nDefault configuration file path:\n " ++ confLoc
+ ++ "\nSet the `gitit_datadir' environment variable to change this."
copyrightMessage :: String
copyrightMessage = "\nCopyright (C) 2008 John MacFarlane\n" ++
@@ -152,13 +173,9 @@ compileInfo =
" -plugins"
#endif
-handleFlag :: Config -> Opt -> IO Config
-handleFlag conf opt = do
- progname <- getProgName
+handleFlag :: Config -> ConfigOpt -> IO Config
+handleFlag conf opt =
case opt of
- Help -> putErr ExitSuccess (usageInfo (usageHeader progname) flags)
- Version -> putErr ExitSuccess (progname ++ " version " ++ showVersion version ++ compileInfo ++ copyrightMessage)
- PrintDefaultConfig -> getDataFileName "data/default.conf" >>= readFileUTF8 >>= B.putStrLn . fromString >> exitWith ExitSuccess
Debug -> return conf{ debugMode = True }
Port p -> return conf{ portNumber = p }
ConfigFile fname -> getConfigFromFile fname
Something went wrong with that request. Please try again.