-- |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."])