content: 
  module DDC.War.Option
          (parseOptions)
  where
  import DDC.War.Create.Way
  import DDC.War.Config
  import Data.Char
  import DDC.War.Task.Test                as T
  import DDC.War.Task.Nightly             as N
  import qualified BuildBox.Command.Mail  as B
  import qualified BuildBox.Data.Schedule as B
  
  
  parseOptions :: [String] -> Config -> IO Config
  parseOptions [] _       
   = do   printUsage Nothing
          error "Nothing to do..."
  
  parseOptions args _
   | elem "-help" args || elem "--help" args
   = do   printUsage Nothing
          error "Nothing to do..."
  
  parseOptions args0 config0
   = return $ eat args0 config0
   where
    eat [] config = config
    eat args@(arg : rest) config
          | elem arg ["-d", "-debug"]
          = eat rest $ config { configDebug = True }
  
          | "-nightly" : dir : more     <- args
          = case eatn more defaultNightlySpec of
             Left  badArg  -> error $ "Invalid argument " ++ show badArg
             Right nspec   -> config { configNightly = Just (nspec { specLocalBuildDir = Just dir }) }
  
          | otherwise
          = case eatt args defaultTestSpec of
             Left  badArg  -> error $ "Invalid argument " ++ show badArg
             Right tspec   -> config { configTest    = Just tspec }
  
  
    -- Parse options for test mode
    eatt [] spec = Right spec
    eatt args@(arg : rest) spec
          | elem arg ["-b", "-batch"]
          = eatt rest $ spec { T.specInteractive = False }
  
          | "-j" : sThreads : more     <- args
          , all isDigit sThreads
          = eatt more $ spec { T.specThreads       = read sThreads}
  
          | "-results" : file : more <- args
          = eatt more $ spec { T.specResultsFileAll    = Just file }
  
          | "-results-failed" : file : more <- args
          = eatt more $ spec { T.specResultsFileFailed = Just file }
  
          | "+compway" : name : flags  <- args
          , (wayFlags, more)           <- break (\x -> take 1 x == "+") flags
          = eatt more $ spec { T.specWays = T.specWays spec ++ [Way name wayFlags []] }
  
          | "+runway"  : name : flags  <- args
          , (wayFlags, more)           <- break (\x -> take 1 x == "+") flags
          = eatt more $ spec { T.specWays = T.specWays spec ++ [Way name [] wayFlags] }
  
          | '-' : _       <- arg
          = Left arg
  
          -- Accept dirs for test mode
          | otherwise
          = eatt rest  $ spec { specTestDirs  = specTestDirs spec ++ [arg]}
  
  
    -- Parse options for nightly mode.
    eatn [] spec = Right spec
    eatn args@(_arg:_rest) spec
          | "-build-dir" : dir : more     <- args
          = eatn more $ spec { N.specLocalBuildDir = Just dir }
  
          | "-daily" : time : more   <- args
          = eatn more $ spec { N.specContinuous = Just $ B.Daily $ read time }
  
          | "-now" : more                 <- args
          = eatn more $ spec { N.specNow = True }
  
          | "-cleanup" : more             <- args
          = eatn more $ spec { N.specCleanup = True }
  
          | "-sendmail" : more            <- args
          = eatn more $ spec { N.specMailer   = Just $ B.MailerSendmail "sendmail" [] }
  
          | "-msmtp" : port : more        <- args
          = eatn more $ spec { N.specMailer   = Just $ B.MailerMSMTP "msmtp" (Just $ read port) }
  
          | "-mail-from" : addr : more    <- args
          = eatn more $ spec { N.specMailFrom = Just addr }
  
          | "-mail-to" : addr : more      <- args
          = eatn more $ spec { N.specMailTo   = Just addr }
  
          | "-log-userhost" : str : more  <- args
          = eatn more $ spec { N.specLogUserHost = Just str }
  
          | "-log-remote-dir" : dir : more <- args
          = eatn more $ spec { N.specLogRemoteDir = Just dir }
  
          | "-log-remote-url" : url : more <- args
          = eatn more $ spec { N.specLogRemoteURL = Just url }
  
          | "-build-threads" : threads : more <- args
          , all isDigit threads
          , t     <- read threads
          , t > 0
          = eatn more $ spec { N.specBuildThreads = t}
  
          | "-build-flavour" : flavour : more <- args
          = eatn more $ spec { N.specBuildFlavour = flavour }
  
    eatn (arg : _) _
          = Left arg
  
  
  printUsage :: Maybe String -> IO ()
  printUsage badArg
     = putStr 
     $ unlines
     $ maybe [] (\arg -> ["invalid argument " ++ arg]) badArg
     ++   [ "Usage: war [flags]"
          , "  -help                         Display this help."
          , "  -debug, -d                    Emit debugging info for the war test driver."
          , "  -nightly <DIR>                Become the nightly buildbot in this directory."
          , ""
          , " Test mode:     war <TESTDIR> ..."
          , "  -batch, -b                    Don't interactively ask what to do if a test fails."
          , "  -j <INT>                      Set number of threads (jobs) to use." 
          , "  -results        <FILE>        Log test results to this file."
          , "  -results-failed <FILE>        Log failed tests to this file."
          , "  +compway <NAME> [OPTIONS]     Also compile with these DDC options."
          , "  +runway  <NAME> [OPTIONS]     Also run executables with these RTS options."
          , ""
          , " Buildbot mode: war -nightly <DIR> [flags] ..."
          , "  -cleanup                      Delete build dir after a successful build."
          , "  -daily          <HH:MM:SS>    Build every day at this time (in UTC)"
          , "  -now                           ... and also do a build right now."
          , ""
          , "  -sendmail                     (*) Use   sendmail to report build results"
          , "  -msmtp          <PORT>           (or) msmtp instead"
          , "  -mail-from      <ADDRESS>     (*) ... and send from this address"
          , "  -mail-to        <ADDRESS>     (*) ... to this address."
          , ""
          , "  -log-userhost <USER@HOSTNAME> (*) Use 'scp' to copy logs to this server"
          , "  -log-remote-dir <DIR>         (*) ... to this remote directory"
          , "  -log-remote-url <URL>         (*) ... with the logs appearing at this public URL."
          , ""
          , "  -ddc-snapshot   <URL>         (*) Download DDC snapshot from this URL."
          , "  -ddc-repository <URL>         (*) Update snapshot with this repository."
          , "  -build-threads  <INT>         (*) Threads to use when building DDC."
          , ""
          , "  (*) Defaults are:"
          , "   -sendmail"
          , "   -mail-from      \"DDC Buildbot <overlord@ouroborus.net>\""
          , "   -mail-to        disciple-cafe@googlegroups.com"
          , "   -log-userhost   overlord@ouroborus.net"
          , "   -log-remote-dir log/desire/ddc/head"
          , "   -log-remote-url http://log.ouroborus.net/desire/ddc/head"
          , "   -ddc-snapshot   http://code.ouroborus.net/ddc/snapshot/ddc-head-latest.tgz"
          , "   -ddc-repository http://code.ouroborus.net/ddc/ddc-head"
          , "   -build-threads   1"
          , ""
          ]
  
  