2010-01-06 05:38:06 +00:00
|
|
|
module Main where
|
|
|
|
|
2010-03-11 10:03:17 +00:00
|
|
|
import Browse
|
|
|
|
import Check
|
2010-04-30 07:27:10 +00:00
|
|
|
import Control.Applicative
|
2010-01-06 05:38:06 +00:00
|
|
|
import Control.Exception hiding (try)
|
2010-04-30 07:27:10 +00:00
|
|
|
import Lang
|
2010-05-06 06:29:55 +00:00
|
|
|
import Lint
|
2010-06-14 05:30:56 +00:00
|
|
|
import Data.List
|
2010-01-06 05:38:06 +00:00
|
|
|
import Prelude hiding (catch)
|
|
|
|
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-04-30 09:36:31 +00:00
|
|
|
import Types
|
2010-01-06 05:38:06 +00:00
|
|
|
|
|
|
|
----------------------------------------------------------------
|
|
|
|
|
|
|
|
usage :: String
|
2010-06-08 02:23:43 +00:00
|
|
|
usage = "ghc-mod version 0.4.2\n"
|
2010-01-06 05:38:06 +00:00
|
|
|
++ "Usage:\n"
|
|
|
|
++ "\t ghc-mod list\n"
|
2010-04-11 03:25:28 +00:00
|
|
|
++ "\t ghc-mod lang\n"
|
2010-05-04 03:47:55 +00:00
|
|
|
++ "\t ghc-mod browse <module> [<module> ...]\n"
|
2010-03-11 10:03:17 +00:00
|
|
|
++ "\t ghc-mod check <HaskellFile>\n"
|
2010-06-14 02:56:35 +00:00
|
|
|
++ "\t ghc-mod [-h opt] lint <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
|
2010-06-14 02:56:35 +00:00
|
|
|
, hlintOpts = []
|
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"
|
2010-06-14 02:56:35 +00:00
|
|
|
, Option "h" ["hlintOpt"]
|
|
|
|
(ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt")
|
|
|
|
"hint to be ignored"
|
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-03-11 10:03:17 +00:00
|
|
|
(_,_,errs) -> error $ concat errs ++ usageInfo usage argspec
|
2010-01-06 05:38:06 +00:00
|
|
|
|
|
|
|
----------------------------------------------------------------
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
main = flip catch handler $ do
|
|
|
|
args <- getArgs
|
|
|
|
let (opt,cmdArg) = parseArgs argspec args
|
2010-04-23 09:09:38 +00:00
|
|
|
res <- case head cmdArg 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-05-06 06:29:55 +00:00
|
|
|
"check" -> withFile (checkSyntax opt) (cmdArg !! 1)
|
|
|
|
"lint" -> withFile (lintSyntax opt) (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-03-11 13:39:07 +00:00
|
|
|
_ -> error usage
|
|
|
|
putStr res
|
2010-01-06 05:38:06 +00:00
|
|
|
where
|
|
|
|
handler :: ErrorCall -> IO ()
|
2010-03-10 09:31:07 +00:00
|
|
|
handler _ = putStr usage
|
2010-05-06 06:29:55 +00:00
|
|
|
withFile cmd file = do
|
|
|
|
exist <- doesFileExist file
|
|
|
|
if exist
|
|
|
|
then cmd file
|
|
|
|
else return ""
|
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
|