usage hack.

This commit is contained in:
Kazu Yamamoto 2010-06-14 15:38:56 +09:00
parent 91859329ae
commit 48b54d2fcd
1 changed files with 42 additions and 14 deletions

View File

@ -1,16 +1,20 @@
{-# LANGUAGE DeriveDataTypeable #-}
module Main where module Main where
import Browse import Browse
import Check import Check
import Control.Applicative import Control.Applicative
import Control.Exception hiding (try) import Control.Exception
import Data.Typeable
import Lang import Lang
import Lint import Lint
import List import List
import Prelude hiding (catch) import Prelude
import System.Console.GetOpt import System.Console.GetOpt
import System.Directory import System.Directory
import System.Environment (getArgs) import System.Environment (getArgs)
import System.IO (hPutStr, hPutStrLn, stderr)
import Types import Types
---------------------------------------------------------------- ----------------------------------------------------------------
@ -18,9 +22,9 @@ import Types
usage :: String usage :: String
usage = "ghc-mod version 0.4.2\n" usage = "ghc-mod version 0.4.2\n"
++ "Usage:\n" ++ "Usage:\n"
++ "\t ghc-mod list\n" ++ "\t ghc-mod [-l] list\n"
++ "\t ghc-mod lang\n" ++ "\t ghc-mod [-l] lang\n"
++ "\t ghc-mod browse <module> [<module> ...]\n" ++ "\t ghc-mod [-l] browse <module> [<module> ...]\n"
++ "\t ghc-mod check <HaskellFile>\n" ++ "\t ghc-mod check <HaskellFile>\n"
++ "\t ghc-mod [-h opt] lint <HaskellFile>\n" ++ "\t ghc-mod [-h opt] lint <HaskellFile>\n"
++ "\t ghc-mod boot\n" ++ "\t ghc-mod boot\n"
@ -47,7 +51,16 @@ parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
parseArgs spec argv parseArgs spec argv
= case getOpt Permute spec argv of = case getOpt Permute spec argv of
(o,n,[] ) -> (foldl (flip id) defaultOptions o, n) (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 main = flip catches handlers $ do
args <- getArgs args <- getArgs
let (opt,cmdArg) = parseArgs argspec args let (opt,cmdArg) = parseArgs argspec args
res <- case head cmdArg of res <- case safelist cmdArg 0 of
"browse" -> concat <$> mapM (browseModule opt) (tail cmdArg) "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
"list" -> listModules opt "list" -> listModules opt
"check" -> withFile (checkSyntax opt) (cmdArg !! 1) "check" -> withFile (checkSyntax opt) (safelist cmdArg 1)
"lint" -> withFile (lintSyntax opt) (cmdArg !! 1) "lint" -> withFile (lintSyntax opt) (safelist cmdArg 1)
"lang" -> listLanguages opt "lang" -> listLanguages opt
"boot" -> do "boot" -> do
mods <- listModules opt mods <- listModules opt
langs <- listLanguages opt langs <- listLanguages opt
pre <- browseModule opt "Prelude" pre <- browseModule opt "Prelude"
return $ mods ++ langs ++ pre return $ mods ++ langs ++ pre
_ -> error usage cmd -> throw (NoSuchCommand cmd)
putStr res putStr res
where where
handlers = [handler] handlers = [Handler handler1, Handler handler2]
handler :: ErrorCall -> IO () handler1 :: ErrorCall -> IO ()
handler _ = putStr usage 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 withFile cmd file = do
exist <- doesFileExist file exist <- doesFileExist file
if exist if exist
then cmd file 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 toLisp :: [String] -> String