171 lines
5.7 KiB
Haskell
171 lines
5.7 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable #-}
|
|
|
|
module Main where
|
|
|
|
import Browse
|
|
import CabalApi
|
|
import Check
|
|
import Control.Applicative
|
|
import Control.Exception
|
|
import Cradle
|
|
import Data.Typeable
|
|
import Data.Version
|
|
import Debug
|
|
import Flag
|
|
import Info
|
|
import Lang
|
|
import Lint
|
|
import List
|
|
import Paths_ghc_mod
|
|
import Prelude
|
|
import System.Console.GetOpt
|
|
import System.Directory
|
|
import System.Environment (getArgs)
|
|
import System.IO (hPutStr, hPutStrLn, stdout, stderr, hSetEncoding, utf8)
|
|
import Types
|
|
|
|
----------------------------------------------------------------
|
|
|
|
ghcOptHelp :: String
|
|
ghcOptHelp = " [-g GHC_opt1 -g GHC_opt2 ...] "
|
|
|
|
usage :: String
|
|
usage = "ghc-mod version " ++ showVersion version ++ "\n"
|
|
++ "Usage:\n"
|
|
++ "\t ghc-mod list" ++ ghcOptHelp ++ "[-l]\n"
|
|
++ "\t ghc-mod lang [-l]\n"
|
|
++ "\t ghc-mod flag [-l]\n"
|
|
++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] <module> [<module> ...]\n"
|
|
++ "\t ghc-mod check" ++ ghcOptHelp ++ "<HaskellFile>\n"
|
|
++ "\t ghc-mod expand" ++ ghcOptHelp ++ "<HaskellFile>\n"
|
|
++ "\t ghc-mod debug" ++ ghcOptHelp ++ "<HaskellFile>\n"
|
|
++ "\t ghc-mod info" ++ ghcOptHelp ++ "<HaskellFile> <module> <expression>\n"
|
|
++ "\t ghc-mod type" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n"
|
|
++ "\t ghc-mod lint [-h opt] <HaskellFile>\n"
|
|
++ "\t ghc-mod boot\n"
|
|
++ "\t ghc-mod help\n"
|
|
|
|
----------------------------------------------------------------
|
|
|
|
argspec :: [OptDescr (Options -> Options)]
|
|
argspec = [ Option "l" ["tolisp"]
|
|
(NoArg (\opts -> opts { outputStyle = LispStyle }))
|
|
"print as a list of Lisp"
|
|
, Option "h" ["hlintOpt"]
|
|
(ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt")
|
|
"hlint options"
|
|
, Option "g" ["ghcOpt"]
|
|
(ReqArg (\g opts -> opts { ghcOpts = g : ghcOpts opts }) "ghcOpt")
|
|
"GHC options"
|
|
, Option "o" ["operators"]
|
|
(NoArg (\opts -> opts { operators = True }))
|
|
"print operators, too"
|
|
, Option "d" ["detailed"]
|
|
(NoArg (\opts -> opts { detailed = True }))
|
|
"print detailed info"
|
|
, Option "s" ["sandbox"]
|
|
(ReqArg (\s opts -> opts { sandbox = Just s }) "path")
|
|
"specify cabal-dev sandbox (default 'cabal-dev`)"
|
|
]
|
|
|
|
parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
|
|
parseArgs spec argv
|
|
= case getOpt Permute spec argv of
|
|
(o,n,[] ) -> (foldr id defaultOptions o, n)
|
|
(_,_,errs) -> throw (CmdArg errs)
|
|
|
|
----------------------------------------------------------------
|
|
|
|
data GHCModError = SafeList
|
|
| NoSuchCommand String
|
|
| CmdArg [String]
|
|
| FileNotExist String deriving (Show, Typeable)
|
|
|
|
instance Exception GHCModError
|
|
|
|
----------------------------------------------------------------
|
|
|
|
main :: IO ()
|
|
main = flip catches handlers $ do
|
|
hSetEncoding stdout utf8
|
|
args <- getArgs
|
|
let (opt',cmdArg) = parseArgs argspec args
|
|
(strVer,ver) <- getGHCVersion
|
|
cradle <- findCradle (sandbox opt') strVer
|
|
let opt = adjustOpts opt' cradle ver
|
|
cmdArg0 = cmdArg !. 0
|
|
cmdArg1 = cmdArg !. 1
|
|
cmdArg2 = cmdArg !. 2
|
|
cmdArg3 = cmdArg !. 3
|
|
cmdArg4 = cmdArg !. 4
|
|
res <- case cmdArg0 of
|
|
"browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
|
|
"list" -> listModules opt
|
|
"check" -> withFile (checkSyntax opt cradle) cmdArg1
|
|
"expand" -> withFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1
|
|
"debug" -> withFile (debugInfo opt cradle strVer) cmdArg1
|
|
"type" -> withFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1
|
|
"info" -> withFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1
|
|
"lint" -> withFile (lintSyntax opt) cmdArg1
|
|
"lang" -> listLanguages opt
|
|
"flag" -> listFlags opt
|
|
"boot" -> do
|
|
mods <- listModules opt
|
|
langs <- listLanguages opt
|
|
flags <- listFlags opt
|
|
pre <- concat <$> mapM (browseModule opt) preBrowsedModules
|
|
return $ mods ++ langs ++ flags ++ pre
|
|
cmd -> throw (NoSuchCommand cmd)
|
|
putStr res
|
|
where
|
|
handlers = [Handler handler1, Handler handler2]
|
|
handler1 :: ErrorCall -> IO ()
|
|
handler1 = print -- 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 throw (FileNotExist file)
|
|
xs !. idx
|
|
| length xs <= idx = throw SafeList
|
|
| otherwise = xs !! idx
|
|
adjustOpts opt cradle ver = case mPkgConf of
|
|
Nothing -> opt
|
|
Just pkgConf -> opt {
|
|
ghcOpts = ghcPackageConfOptions ver pkgConf ++ ghcOpts opt
|
|
}
|
|
where
|
|
mPkgConf = cradlePackageConf cradle
|
|
|
|
----------------------------------------------------------------
|
|
|
|
preBrowsedModules :: [String]
|
|
preBrowsedModules = [
|
|
"Prelude"
|
|
, "Control.Applicative"
|
|
, "Control.Monad"
|
|
, "Control.Exception"
|
|
, "Data.Char"
|
|
, "Data.List"
|
|
, "Data.Maybe"
|
|
, "System.IO"
|
|
]
|
|
|
|
|
|
ghcPackageConfOptions :: Int -> String -> [String]
|
|
ghcPackageConfOptions ver file
|
|
| ver >= 706 = ["-package-db", file, "-no-user-package-conf"]
|
|
| otherwise = ["-package-conf", file, "-no-user-package-conf"]
|