usage hack.
This commit is contained in:
parent
91859329ae
commit
48b54d2fcd
56
GHCMod.hs
56
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
|
||||
|
Loading…
Reference in New Issue
Block a user