Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Moved option parsing code into Gitit.Config.

  • Loading branch information...
commit 7e0b5e010b3fe736a05e4182463f425057dbbffd 1 parent 42cab8c
@jgm authored
Showing with 78 additions and 52 deletions.
  1. +3 −51 Gitit.hs
  2. +74 −0 Gitit/Config.hs
  3. +1 −1  gitit.cabal
View
54 Gitit.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, Rank2Types, FlexibleContexts #-}
+{-# LANGUAGE Rank2Types, FlexibleContexts #-}
{-
Copyright (C) 2008 John MacFarlane <jgm@berkeley.edu>
@@ -23,7 +23,6 @@ import HAppS.Server hiding (look, lookRead, lookCookieValue, mkCookie)
import Gitit.HAppS (look, lookRead, lookCookieValue, mkCookie)
import Gitit.Util (withTempDir, orIfNull, consolidateHeads)
import Gitit.Initialize (createStaticIfMissing, createRepoIfMissing)
-import System.Environment
import System.IO.UTF8
import System.IO (stderr)
import Control.Exception (throwIO, catch, try)
@@ -33,6 +32,7 @@ import System.Time
import Control.Concurrent
import System.FilePath
import Gitit.State
+import Gitit.Config (getConfigFromOpts)
import Text.XHtml hiding ( (</>), dir, method, password, rev )
import qualified Text.XHtml as X ( password, method )
import Data.List (intersect, intersperse, intercalate, sort, nub, sortBy, isSuffixOf, find, isPrefixOf)
@@ -51,8 +51,6 @@ import Control.Monad.Reader
import qualified Data.ByteString.Lazy as B
import Codec.Compression.GZip (compress)
import Network.HTTP (urlEncodeVars, urlEncode)
-import System.Console.GetOpt
-import System.Exit
import Text.Highlighting.Kate
import qualified Text.StringTemplate as T
import Data.DateTime (getCurrentTime, addMinutes, parseDateTime, DateTime, formatDateTime)
@@ -65,7 +63,7 @@ main :: IO ()
main = do
-- parse options to get config file
- conf <- getArgs >>= parseArgs >>= foldM handleFlag defaultConfig
+ conf <- getConfigFromOpts
-- check for external programs that are needed
let prereqs = "grep" : case repository conf of
@@ -114,52 +112,6 @@ main = do
killThread tid
putStrLn "Shutdown complete"
----------------------------
------ Option parsing ------
----------------------------
-
-data Opt
- = Help
- | ConfigFile FilePath
- | Version
- deriving (Eq)
-
-flags :: [OptDescr Opt]
-flags =
- [ Option ['h'] [] (NoArg Help)
- "Print this help message"
- , Option ['v'] [] (NoArg Version)
- "Print version information"
- , Option ['f'] [] (ReqArg ConfigFile "FILE")
- "Specify configuration file"
- ]
-
-parseArgs :: [String] -> IO [Opt]
-parseArgs argv = do
- progname <- getProgName
- case getOpt Permute flags argv of
- (opts,_,[]) -> return opts
- (_,_,errs) -> hPutStrLn stderr (concat errs ++ usageInfo (usageHeader progname) flags) >>
- exitWith (ExitFailure 1)
-
-usageHeader :: String -> String
-usageHeader progname = "Usage: " ++ progname ++ " [opts...]"
-
-copyrightMessage :: String
-copyrightMessage = "\nCopyright (C) 2008 John MacFarlane\n" ++
- "This is free software; see the source for copying conditions. There is no\n" ++
- "warranty, not even for merchantability or fitness for a particular purpose."
-
-handleFlag :: Config -> Opt -> IO Config
-handleFlag _ opt = do
- progname <- getProgName
- case opt of
- Help -> hPutStrLn stderr (usageInfo (usageHeader progname) flags) >> exitWith ExitSuccess
- Version -> hPutStrLn stderr (progname ++ " version " ++ _VERSION ++ copyrightMessage) >> exitWith ExitSuccess
- ConfigFile f -> liftM read (readFile f)
-
-------
-
filterIf :: (Request -> Bool) -> (Response -> Response) -> ServerPart Response -> ServerPart Response
filterIf test filt sp =
View
74 Gitit/Config.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE CPP #-}
+{-
+Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- Functions for parsing command line options and reading the config file.
+-}
+
+module Gitit.Config ( getConfigFromOpts )
+where
+import Gitit.State (Config(..), defaultConfig)
+import System.Environment
+import System.Exit
+import System.IO (stderr, hPutStrLn)
+import System.Console.GetOpt
+import Control.Monad (liftM, foldM)
+
+data Opt
+ = Help
+ | ConfigFile FilePath
+ | Version
+ deriving (Eq)
+
+flags :: [OptDescr Opt]
+flags =
+ [ Option ['h'] [] (NoArg Help)
+ "Print this help message"
+ , Option ['v'] [] (NoArg Version)
+ "Print version information"
+ , Option ['f'] [] (ReqArg ConfigFile "FILE")
+ "Specify configuration file"
+ ]
+
+parseArgs :: [String] -> IO [Opt]
+parseArgs argv = do
+ progname <- getProgName
+ case getOpt Permute flags argv of
+ (opts,_,[]) -> return opts
+ (_,_,errs) -> hPutStrLn stderr (concat errs ++ usageInfo (usageHeader progname) flags) >>
+ exitWith (ExitFailure 1)
+
+usageHeader :: String -> String
+usageHeader progname = "Usage: " ++ progname ++ " [opts...]"
+
+copyrightMessage :: String
+copyrightMessage = "\nCopyright (C) 2008 John MacFarlane\n" ++
+ "This is free software; see the source for copying conditions. There is no\n" ++
+ "warranty, not even for merchantability or fitness for a particular purpose."
+
+handleFlag :: Config -> Opt -> IO Config
+handleFlag _ opt = do
+ progname <- getProgName
+ case opt of
+ Help -> hPutStrLn stderr (usageInfo (usageHeader progname) flags) >> exitWith ExitSuccess
+ Version -> hPutStrLn stderr (progname ++ " version " ++ _VERSION ++ copyrightMessage) >> exitWith ExitSuccess
+ ConfigFile f -> liftM read (readFile f)
+
+getConfigFromOpts :: IO Config
+getConfigFromOpts = getArgs >>= parseArgs >>= foldM handleFlag defaultConfig
+
View
2  gitit.cabal
@@ -43,7 +43,7 @@ Executable gitit
hs-source-dirs: .
main-is: Gitit.hs
other-modules: Gitit.State, Gitit.HAppS, Gitit.MimeTypes, Gitit.Util,
- Gitit.Initialize, Paths_gitit
+ Gitit.Initialize, Gitit.Config, Paths_gitit
build-depends: base >=3, parsec < 3, pretty, xhtml, containers, pandoc
>= 1.1, process, filepath, directory, mtl, cgi,
network, old-time, highlighting-kate, bytestring,
Please sign in to comment.
Something went wrong with that request. Please try again.