hsdip-0.1: src/Main.hs

-- hsdip -- a diplomacy parser/renderer.
-- Copyright (C) 2006 Evan Martin <martine@danga.com>

module Main(main) where

import Data.List
import System.IO
import System.Environment
import System.Exit
import Text.ParserCombinators.Parsec.Pos (SourceName)

import Conf
-- import Diplomacy
import JudgeParser
import qualified Render

die :: String -> IO a
die str = do putStrLn str; exitFailure; error "notreached"

okOrDie :: IO (Either String a) -> IO a
okOrDie cmd = cmd >>= either die return

data SubCommand = SubCommand {
  cmdName :: String,
  cmdHelp :: String,
  cmdRun  :: [String] -> IO ()
}
instance Show SubCommand where
  show s = cmdName s

subcommands :: [SubCommand]
subcommands = [
  SubCommand "parse" "rulesfile" doParse,
  SubCommand "render" "rulesfile output.png" doRender
  ]

doParse :: [Text.ParserCombinators.Parsec.Pos.SourceName]
                                       -> IO ()
doParse args = do
  infile <- case args of
              [x] -> return x
              _   -> die "parse expects on argument"
  turn <- okOrDie $ JudgeParser.parseFileTurns infile
  print turn

doRender :: [Text.ParserCombinators.Parsec.Pos.SourceName]
                                        -> IO ()
doRender args = do
  conf <- okOrDie $ Conf.parseFile "data/conf"
  (infile, outfile) <- case args of
                         [x,y] -> return (x,y)
                         _     -> die "render expects two arguments"
  turn <- okOrDie $ JudgeParser.parseFileTurn infile
  print turn
  Render.renderTurnToFile conf turn outfile

usage :: String
usage =
  "usage: render mode [modeargs]\n" ++
  "modes are:\n" ++
    concatMap (\sc -> "  " ++ cmdName sc ++ " " ++
                      cmdHelp sc ++ "\n") subcommands

main :: IO ()
main = do
  args <- getArgs
  (mode, ags) <- case args of
                    (m:a) -> return (m, a)
                    _     -> die usage
  command <- case find (\s -> cmdName s == mode) subcommands of
               Just c  -> return c
               Nothing -> die usage
  cmdRun command ags

-- vim: set ts=2 sw=2 et :