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
|
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
|
||||||
|
Loading…
Reference in New Issue
Block a user