Rework option parsing a little.

This makes the error messages nicer (rather than abusing (ioError .
userError)), adds a --help option, and flattens the choice of operations
into a case statement.

1 files changed, 36 insertions, 23 deletions

diff --git a/tt.hs b/tt.hs
index 81fe469..f4c95dc 100755
--- a/tt.hs
+++ b/tt.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE PatternGuards #-}
 {- Helper script to run Twisted tests -}
 module Main where
 
@@ -7,11 +8,12 @@ import System.Directory ( doesFileExist
                         , getDirectoryContents
                         )
 import Data.List (intercalate, stripPrefix, isSuffixOf)
-import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Maybe (fromMaybe, listToMaybe, isNothing, fromJust)
 import Control.Applicative ((<$>), (<*>))
 import Control.Monad (when, filterM, forever, replicateM_)
 import System.Environment (getArgs)
 import System.FilePath ((</>))
+import System.IO (hPutStr, hPutStrLn, stderr)
 import System.Process
 import System.Exit
 
@@ -21,7 +23,12 @@ data Repetitions = Forever
   deriving Show
 
 {- Command line argument definitions and parsing -}
-data Options = Options { printTestDirectory :: Bool
+data Command = RunTests
+             | PrintTestDirectory
+             | ShowHelp
+  deriving (Show, Eq, Ord)
+
+data Options = Options { command :: Command
                        , makeFlags :: [Flag]
                        , repetitions :: Repetitions
                        }
@@ -29,13 +36,13 @@ data Options = Options { printTestDirectory :: Bool
 type OptionTransformer = Options -> Options
 
 defaultOptions :: Options
-defaultOptions = Options { printTestDirectory = False
+defaultOptions = Options { command = RunTests
                          , makeFlags = []
                          , repetitions = Times 1
                          }
 
-setPrintTestDirectory :: OptionTransformer
-setPrintTestDirectory opts = opts { printTestDirectory = True }
+setCommand :: Command -> OptionTransformer
+setCommand c opts = opts { command = max (command opts) c }
 
 addFlag :: Flag -> OptionTransformer
 addFlag f opts = opts { makeFlags = makeFlags opts ++ [f] }
@@ -56,21 +63,26 @@ optionDefinitions =
     , Option ['d'] ["dialects"] (ReqArg dialects "DIALECTS")
              "set JINGLE_DIALECTS to DIALECTS"
     , Option ['p'] ["print-test-directory"]
-             (NoArg setPrintTestDirectory)
+             (NoArg (setCommand PrintTestDirectory))
              "Print the path to the directory containing tests"
     , Option ['r'] ["repetitions"]
              (OptArg setRepetitions "N")
              "Run specified tests N times, or forever"
+    , Option ['h'] ["help"]
+             (NoArg (setCommand ShowHelp))
+             "Print this usage information"
     ]
 
 parseOptions :: [String] -> (Options, [String], [String])
-parseOptions args = (options, tests, errors)
+parseOptions args = (options, tests , errors)
   where
     (transformers, tests, errors) = getOpt RequireOrder optionDefinitions args
     options = foldr (.) id transformers defaultOptions
 
-header :: String
-header = "Usage: tt [-v] [-V] [-d DIALECTS] [-r[N]] [tests...]"
+usage :: String
+usage = usageInfo header optionDefinitions
+  where
+    header = "Usage: tt [-v] [-V] [-d DIALECTS] [-r[N]] [tests...]"
 
 {- Building and execution of a `make check-twisted` invocation -}
 runTests :: FilePath -> String -> Bool -> [String] -> [Flag] -> Repetitions
@@ -128,18 +140,19 @@ main = do
     args <- getArgs
     let (options, tests, errors) = parseOptions args
 
-    when (not $ null errors) $ do
-        ioError (userError (concat errors ++
-                            usageInfo header optionDefinitions))
-
     inTree <- doesFileExist "configure"
-    iReallyDo <- iFuckingHateMissionControl
-
-    case iReallyDo of
-        Just testVar -> do
-            if printTestDirectory options
-              then putStrLn $ (if inTree then "." else "..") </> "tests/twisted"
-              else runTests "tests/twisted/" testVar inTree tests
-                            (makeFlags options)
-                            (repetitions options)
-        Nothing      -> ioError (userError "no tests here :'(")
+    testVar <- iFuckingHateMissionControl
+
+    case command options of
+        _ | not (null errors) -> do
+                mapM_ (hPutStr stderr) $ errors ++ [usage]
+                exitFailure
+        ShowHelp -> putStr usage
+        _ | isNothing testVar -> do
+                hPutStrLn stderr "no tests here :'("
+                exitFailure
+        PrintTestDirectory ->
+            putStrLn $ (if inTree then "." else "..") </> "tests/twisted"
+        RunTests ->
+            runTests "tests/twisted/" (fromJust testVar) inTree tests
+                     (makeFlags options) (repetitions options)