Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge pull request #334 from benmachine/options

gitit.hs option improvements
  • Loading branch information...
commit bee3af6470271d1b32fb09c1c8c284c86da6ca77 2 parents 251febd + fbd5af1
@jgm authored
Showing with 41 additions and 24 deletions.
  1. +41 −24 gitit.hs
View
65 gitit.hs
@@ -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
Please sign in to comment.
Something went wrong with that request. Please try again.