-- |A simple feed generator: Configuration management and command line parsing
--
-- Copyright (c) 2006 Manuel M T Chakravarty
--
-- License: <http://www.gnu.org/licenses/gpl.html>
--
--- Description ---------------------------------------------------------------
--
-- Language: Haskell 98
--
module Config (
-- * Identity
version, exactvers, copyright, disclaimer,
-- * File suffixes
chanSuffix, itemSuffix, htmlSuffix, rssSuffix,
-- * Configuration record
Config(..),
-- * Command line argument parsing
processArgs
) where
-- hierachical libraries
--
import Control.Monad (
when, unless, foldM)
import Data.Char (
isDigit)
import System.Console.GetOpt (
ArgOrder(..), OptDescr(..), ArgDescr(..), getOpt, usageInfo)
import System.Environment (
getArgs, getProgName)
-- lambdaFeed
import Error (
abortWithIO, exitSuccess)
-- Version information
-- -------------------
name = "lambdaFeed"
versnum = "0.3.1"
versnick = "'Lambdas are food for thought'"
versdate = "18 Jun 2006"
patchlevel = "pl0"
context = "[TAG version 0.3.1\nManuel M T Chakravarty <chak@cse.unsw.edu.au>**20060619163411] \n"
confdate = "13 Feb 2007"
version = name ++ ", version " ++ versnum ++ " (" ++ patchlevel ++ ") " ++
versnick ++ ", " ++ versdate
exactvers = version ++ "\nConfigured " ++ confdate ++ " in context:\n" ++
context
copyright = "Copyright (c) 2006 Manuel M T Chakravarty"
disclaimer = "This software is distributed under the \
\terms of the GNU Public Licence.\n\
\NO WARRANTY WHATSOEVER IS PROVIDED. \
\See <http://www.gnu.org/licenses/gpl.html>."
-- Constants
-- ---------
-- Suffixes
--
chanSuffix = "lfc"
itemSuffix = "lfi"
htmlSuffix = "html"
rssSuffix = "xml"
-- Dynamic configuration
-- ---------------------
-- Configuration
--
-- * Strictly speaking we should use `Maybe Int' for `maxItems', but I doubt
-- that this will be an issue any time soon.
--
data Config = Config {
debugCfg :: Int,
feedDirCfg :: FilePath,
htmlDirCfg :: FilePath,
maxItemsOpt :: Int, -- truncate any further channels items
rssDirCfg :: FilePath,
verboseCfg :: Bool,
quietCfg :: Bool
}
-- Default configuration
--
dftConfig = Config {
debugCfg = 0,
feedDirCfg = ".",
htmlDirCfg = "",
maxItemsOpt = maxBound,
rssDirCfg = "",
verboseCfg = False,
quietCfg = False
}
-- Available options
--
data Option = Debug
| FeedDirOpt FilePath
| Help
| HTMLDirOpt FilePath
| MaxItemsOpt String
| RSSDirOpt FilePath
| OutputOpt FilePath
| Verbose
| Version Bool
| Quiet
deriving Eq
-- Option description
--
options :: [OptDescr Option]
options = [ Option ['d'] ["debug"] (NoArg Debug)
"produces extra diagnostic output; repeat for more"
, Option ['f'] ["feed"] (ReqArg FeedDirOpt "DIR")
"directory with channel descriptions (default: .)"
, Option ['h', '?'] ["help"] (NoArg Help)
"this help message"
, Option [] ["htmldir"] (ReqArg HTMLDirOpt "DIR")
"target directory for generated HTML files"
, Option ['m'] ["max-items"] (ReqArg MaxItemsOpt "N")
"number of items after which to drop further items per channel"
, Option [] ["rssdir"] (ReqArg RSSDirOpt "DIR")
"target directory for generated RSS 2.0 files"
, Option ['o'] ["output"] (ReqArg OutputOpt "DIR")
"sets target directory for both HTML and RSS 2.0 files"
, Option ['v'] ["verbose"] (NoArg Verbose)
"print summary information (default: off)"
, Option ['V'] ["version"] (NoArg $ Version False)
"version information"
, Option [] ["exact-version"] (NoArg $ Version True)
"more detailed version information (use for bug reports!)"
, Option ['q'] ["quiet"] (NoArg Quiet)
"suppress all output, including parser warnings"
]
-- Option processing
--
processArgs :: IO Config
processArgs =
do
args <- getArgs
case getOpt RequireOrder options args of
(opts, [] , [] ) -> do
processVersion opts
processHelp opts
processConfig dftConfig opts
(opts, args, [] ) -> abort [unrecErr ++ unwords args]
(_ , _ , errs) -> abort errs
where
unrecErr = "Unrecognised arguments: "
-- Print version information if `Help' or `Version' requested and remove any
-- `Version' options.
--
processVersion :: [Option] -> IO ()
processVersion opts =
do
when (Version False `elem` opts ||
Version True `elem` opts ||
Help `elem` opts ) $ do
if Version True `elem` opts
then
putStrLn exactvers
else
putStrLn version
putStrLn copyright
putStrLn disclaimer
unless (Help `elem` opts) $
exitSuccess
return ()
-- Print help information if `Help' requested and terminate successfully.
--
processHelp :: [Option] -> IO ()
processHelp opts =
do
name <- getProgName
let header = "\nUsage: " ++ name ++ " [ option... ]\n"
when (Help `elem` opts) $ do
putStrLn $ usageInfo header options
exitSuccess
return ()
-- Process configuration options.
--
processConfig :: Config -> [Option] -> IO Config
processConfig = foldM processOneOption
where
processOneOption config Debug =
return $ config {debugCfg = debugCfg config + 1}
processOneOption config (FeedDirOpt dir) =
return $ config {feedDirCfg = dir}
processOneOption config (HTMLDirOpt dir) =
return $ config {htmlDirCfg = dir}
processOneOption config (MaxItemsOpt nStr) =
do
when (not . all isDigit $ nStr) $
abort ["`" ++ nStr ++ "': not a number (--max-items)"]
return $ config {maxItemsOpt = read nStr}
processOneOption config (RSSDirOpt dir) =
return $ config {rssDirCfg = dir}
processOneOption config (OutputOpt dir) =
return $ config {htmlDirCfg = dir, rssDirCfg = dir}
processOneOption config Verbose =
return $ config {verboseCfg = True}
processOneOption config Quiet =
return $ config {quietCfg = True}
-- Error during parsing command line options
--
abort :: [String] -> IO a
abort =
abortWithIO . (++ ["Try the option `--help' on its own for more \
\information."])