[Add a generated Config.hs, so we can build with hackage
Don Stewart <dons@cse.unsw.edu.au>**20070213053332] {
addfile ./Config.hs
hunk ./Config.hs 1
+-- |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."])
+
}