ghc-mod/GHCMod.hs

137 lines
4.5 KiB
Haskell
Raw Normal View History

2010-06-14 06:38:56 +00:00
{-# LANGUAGE DeriveDataTypeable #-}
2010-01-06 05:38:06 +00:00
module Main where
2010-03-11 10:03:17 +00:00
import Browse
2011-12-26 08:08:00 +00:00
import CabalDev (modifyOptions)
2010-03-11 10:03:17 +00:00
import Check
2010-04-30 07:27:10 +00:00
import Control.Applicative
2010-06-14 06:38:56 +00:00
import Control.Exception
import Data.Typeable
2011-12-26 08:08:00 +00:00
import Data.Version
2010-11-12 07:27:50 +00:00
import Info
2010-04-30 07:27:10 +00:00
import Lang
2010-05-06 06:29:55 +00:00
import Lint
2010-06-14 05:42:17 +00:00
import List
2011-12-26 08:08:00 +00:00
import Paths_ghc_mod
2010-06-14 06:38:56 +00:00
import Prelude
2010-01-06 05:38:06 +00:00
import System.Console.GetOpt
2010-05-06 04:14:17 +00:00
import System.Directory
2010-03-11 10:03:17 +00:00
import System.Environment (getArgs)
2010-06-14 06:38:56 +00:00
import System.IO (hPutStr, hPutStrLn, stderr)
2010-04-30 09:36:31 +00:00
import Types
2010-01-06 05:38:06 +00:00
----------------------------------------------------------------
ghcOptHelp :: String
ghcOptHelp = " [-g GHC_opt1 -g GHC_opt2 ...] "
2010-01-06 05:38:06 +00:00
usage :: String
2011-12-26 08:08:00 +00:00
usage = "ghc-mod version " ++ showVersion version ++ "\n"
2010-01-06 05:38:06 +00:00
++ "Usage:\n"
++ "\t ghc-mod list" ++ ghcOptHelp ++ "[-l]\n"
2011-01-27 05:29:39 +00:00
++ "\t ghc-mod lang [-l]\n"
++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] <module> [<module> ...]\n"
++ "\t ghc-mod check" ++ ghcOptHelp ++ "<HaskellFile>\n"
++ "\t ghc-mod type" ++ ghcOptHelp ++ "<HaskellFile> <module> <expression>\n"
++ "\t ghc-mod info" ++ ghcOptHelp ++ "<HaskellFile> <module> <expression>\n"
2011-01-27 05:29:39 +00:00
++ "\t ghc-mod lint [-h opt] <HaskellFile>\n"
2010-05-04 03:47:55 +00:00
++ "\t ghc-mod boot\n"
2010-01-06 05:38:06 +00:00
++ "\t ghc-mod help\n"
----------------------------------------------------------------
defaultOptions :: Options
2010-05-06 06:29:55 +00:00
defaultOptions = Options {
convert = toPlain
, hlintOpts = []
, ghcOpts = []
2011-01-27 05:29:39 +00:00
, operators = False
2010-05-06 06:29:55 +00:00
}
2010-01-06 05:38:06 +00:00
argspec :: [OptDescr (Options -> Options)]
2010-04-23 09:09:38 +00:00
argspec = [ Option "l" ["tolisp"]
2010-03-11 13:39:07 +00:00
(NoArg (\opts -> opts { convert = toLisp }))
2010-01-06 05:38:06 +00:00
"print as a list of Lisp"
, Option "h" ["hlintOpt"]
(ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt")
2011-10-20 02:24:25 +00:00
"hlint options"
, Option "g" ["ghcOpt"]
(ReqArg (\g opts -> opts { ghcOpts = g : ghcOpts opts }) "ghcOpt")
2011-10-20 02:24:25 +00:00
"GHC options"
2011-01-27 05:29:39 +00:00
, Option "o" ["operators"]
(NoArg (\opts -> opts { operators = True }))
"print operators, too"
2010-01-06 05:38:06 +00:00
]
parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
parseArgs spec argv
= case getOpt Permute spec argv of
(o,n,[] ) -> (foldl (flip id) defaultOptions o, n)
2010-06-14 06:38:56 +00:00
(_,_,errs) -> throw (CmdArg errs)
----------------------------------------------------------------
data GHCModError = SafeList
| NoSuchCommand String
| CmdArg [String]
| FileNotExist String deriving (Show, Typeable)
instance Exception GHCModError
2010-01-06 05:38:06 +00:00
----------------------------------------------------------------
main :: IO ()
2010-06-14 05:42:17 +00:00
main = flip catches handlers $ do
2010-01-06 05:38:06 +00:00
args <- getArgs
let (opt',cmdArg) = parseArgs argspec args
res <- modifyOptions opt' >>= \opt -> case safelist cmdArg 0 of
2010-04-30 07:27:10 +00:00
"browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
2010-03-11 13:39:07 +00:00
"list" -> listModules opt
2010-06-14 06:38:56 +00:00
"check" -> withFile (checkSyntax opt) (safelist cmdArg 1)
"type" -> withFile (typeExpr opt (safelist cmdArg 2) (safelist cmdArg 3)) (safelist cmdArg 1)
"info" -> withFile (infoExpr opt (safelist cmdArg 2) (safelist cmdArg 3)) (safelist cmdArg 1)
2010-06-14 06:38:56 +00:00
"lint" -> withFile (lintSyntax opt) (safelist cmdArg 1)
2010-04-02 05:40:06 +00:00
"lang" -> listLanguages opt
2010-05-04 03:47:55 +00:00
"boot" -> do
mods <- listModules opt
langs <- listLanguages opt
pre <- browseModule opt "Prelude"
return $ mods ++ langs ++ pre
2010-06-14 06:38:56 +00:00
cmd -> throw (NoSuchCommand cmd)
2010-03-11 13:39:07 +00:00
putStr res
2010-01-06 05:38:06 +00:00
where
2010-06-14 06:38:56 +00:00
handlers = [Handler handler1, Handler handler2]
handler1 :: ErrorCall -> IO ()
2011-08-24 06:58:12 +00:00
handler1 = print -- for debug
2010-06-14 06:38:56 +00:00
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
2011-08-24 06:58:12 +00:00
printUsage = hPutStrLn stderr $ '\n' : usageInfo usage argspec
2010-05-06 06:29:55 +00:00
withFile cmd file = do
exist <- doesFileExist file
if exist
then cmd file
2010-06-14 06:38:56 +00:00
else throw (FileNotExist file)
safelist xs idx
| length xs <= idx = throw SafeList
| otherwise = xs !! idx
2010-01-06 05:38:06 +00:00
----------------------------------------------------------------
toLisp :: [String] -> String
toLisp ms = "(" ++ unwords quoted ++ ")\n"
where
quote x = "\"" ++ x ++ "\""
quoted = map quote ms
toPlain :: [String] -> String
toPlain = unlines