From 48b54d2fcd912ab0acc620a6b724bf6008a46622 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 14 Jun 2010 15:38:56 +0900
Subject: [PATCH] usage hack.

---
 GHCMod.hs | 56 +++++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 42 insertions(+), 14 deletions(-)

diff --git a/GHCMod.hs b/GHCMod.hs
index d4adb9f..43de34d 100644
--- a/GHCMod.hs
+++ b/GHCMod.hs
@@ -1,16 +1,20 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
 module Main where
 
 import Browse
 import Check
 import Control.Applicative
-import Control.Exception hiding (try)
+import Control.Exception
+import Data.Typeable
 import Lang
 import Lint
 import List
-import Prelude hiding (catch)
+import Prelude
 import System.Console.GetOpt
 import System.Directory
 import System.Environment (getArgs)
+import System.IO (hPutStr, hPutStrLn, stderr)
 import Types
 
 ----------------------------------------------------------------
@@ -18,9 +22,9 @@ import Types
 usage :: String
 usage =    "ghc-mod version 0.4.2\n"
         ++ "Usage:\n"
-        ++ "\t ghc-mod list\n"
-        ++ "\t ghc-mod lang\n"
-        ++ "\t ghc-mod browse <module> [<module> ...]\n"
+        ++ "\t ghc-mod [-l] list\n"
+        ++ "\t ghc-mod [-l] lang\n"
+        ++ "\t ghc-mod [-l] browse <module> [<module> ...]\n"
         ++ "\t ghc-mod check <HaskellFile>\n"
         ++ "\t ghc-mod [-h opt] lint <HaskellFile>\n"
         ++ "\t ghc-mod boot\n"
@@ -47,7 +51,16 @@ parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
 parseArgs spec argv
     = case getOpt Permute spec argv of
         (o,n,[]  ) -> (foldl (flip id) defaultOptions o, n)
-        (_,_,errs) -> error $ concat errs ++ usageInfo usage argspec
+        (_,_,errs) -> throw (CmdArg errs)
+
+----------------------------------------------------------------
+
+data GHCModError = SafeList
+                 | NoSuchCommand String
+                 | CmdArg [String]
+                 | FileNotExist String deriving (Show, Typeable)
+
+instance Exception GHCModError
 
 ----------------------------------------------------------------
 
@@ -55,28 +68,43 @@ main :: IO ()
 main = flip catches handlers $ do
     args <- getArgs
     let (opt,cmdArg) = parseArgs argspec args
-    res <- case head cmdArg of
+    res <- case safelist cmdArg 0 of
       "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
       "list"   -> listModules opt
-      "check"  -> withFile (checkSyntax opt) (cmdArg !! 1)
-      "lint"   -> withFile (lintSyntax opt) (cmdArg !! 1)
+      "check"  -> withFile (checkSyntax opt) (safelist cmdArg 1)
+      "lint"   -> withFile (lintSyntax opt)  (safelist cmdArg 1)
       "lang"   -> listLanguages opt
       "boot"   -> do
          mods  <- listModules opt
          langs <- listLanguages opt
          pre   <- browseModule opt "Prelude"
          return $ mods ++ langs ++ pre
-      _        -> error usage
+      cmd      -> throw (NoSuchCommand cmd)
     putStr res
   where
-    handlers = [handler]
-    handler :: ErrorCall -> IO ()
-    handler _ = putStr usage
+    handlers = [Handler handler1, Handler handler2]
+    handler1 :: ErrorCall -> IO ()
+    handler1 e = print e -- for debug
+    handler2 :: GHCModError -> IO ()
+    handler2 SafeList = printUsage
+    handler2 (NoSuchCommand cmd) = do
+        hPutStrLn stderr $ "\"" ++ cmd ++ "\" not supported"
+        printUsage
+    handler2 (CmdArg errs) = do
+        mapM_ (hPutStr stderr) errs
+        printUsage
+    handler2 (FileNotExist file) = do
+        hPutStrLn stderr $ "\"" ++ file ++ "\" not found"
+        printUsage
+    printUsage = hPutStrLn stderr $ "\n" ++ usageInfo usage argspec
     withFile cmd file = do
         exist <- doesFileExist file
         if exist
             then cmd file
-            else error $ file ++ " not found"
+            else throw (FileNotExist file)
+    safelist xs idx
+      | length xs <= idx = throw SafeList
+      | otherwise = xs !! idx
 
 ----------------------------------------------------------------
 toLisp :: [String] -> String