hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Optparse-applicative

Browse Source
This commit is contained in:
Nikolay Yakimov
2015-12-05 23:55:12 +03:00
parent bff86be69f
commit ad16b739eb
11 changed files with 534 additions and 505 deletions
Download Patch File Download Diff File Expand all files Collapse all files

523
src/GHCMod.hs
View File

@@ -2,14 +2,10 @@
module Main where
import Config (cProjectVersion)
import Control.Category
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.Typeable (Typeable)
import Data.Version (showVersion)
import Data.Label
import Data.List
import Data.List.Split
import Data.Char (isSpace)
@@ -19,261 +15,23 @@ import Language.Haskell.GhcMod
import Language.Haskell.GhcMod.Internal hiding (MonadIO,liftIO)
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad
import Paths_ghc_mod
import System.Console.GetOpt (OptDescr(..), ArgDescr(..), ArgOrder(..))
import qualified System.Console.GetOpt as O
import System.FilePath ((</>))
import System.Directory (setCurrentDirectory, getAppUserDataDirectory,
removeDirectoryRecursive)
import System.Environment (getArgs)
-- import System.Environment (getArgs)
import System.IO
import System.Exit
import Text.PrettyPrint
import Text.PrettyPrint hiding ((<>))
import Prelude hiding ((.))
import GHCMod.Options
import Misc
progVersion :: String -> String
progVersion pf =
"ghc-mod"++pf++" version " ++ showVersion version ++ " compiled by GHC "
++ cProjectVersion ++ "\n"
ghcModVersion :: String
ghcModVersion = progVersion ""
ghcModiVersion :: String
ghcModiVersion = progVersion "i"
optionUsage :: (String -> String) -> [OptDescr a] -> [String]
optionUsage indent opts = concatMap optUsage opts
where
optUsage (Option so lo dsc udsc) =
[ intercalate ", " $ addLabel `map` allFlags
, indent $ udsc
, ""
]
where
allFlags = shortFlags ++ longFlags
shortFlags = (('-':) . return) `map` so :: [String]
longFlags = ("--"++) `map` lo
addLabel f@('-':'-':_) = f ++ flagLabel "="
addLabel f@('-':_) = f ++ flagLabel " "
addLabel _ = undefined
flagLabel s =
case dsc of
NoArg _ -> ""
ReqArg _ label -> s ++ label
OptArg _ label -> s ++ "["++label++"]"
-- TODO: Generate the stuff below automatically
usage :: String
usage =
"Usage: ghc-mod [OPTIONS...] COMMAND [CMD_ARGS...] \n\
\*Global Options (OPTIONS)*\n\
\ Global options can be specified before and after the command and\n\
\ interspersed with command specific options\n\
\\n"
++ (unlines $ indent <$> optionUsage indent globalArgSpec) ++
"*Commands*\n\
\ - version\n\
\ Print the version of the program.\n\
\\n\
\ - help\n\
\ Print this help message.\n\
\\n\
\ - list [FLAGS...] | modules [FLAGS...]\n\
\ List all visible modules.\n\
\ Flags:\n\
\ -d\n\
\ Print package modules belong to.\n\
\\n\
\ - lang\n\
\ List all known GHC language extensions.\n\
\\n\
\ - flag\n\
\ List GHC -f<bla> flags.\n\
\\n\
\ - browse [FLAGS...] [PACKAGE:]MODULE...\n\
\ List symbols in a module.\n\
\ Flags:\n\
\ -o\n\
\ Also print operators.\n\
\ -d\n\
\ Print symbols with accompanying signatures.\n\
\ -q\n\
\ Qualify symbols.\n\
\\n\
\ - check FILE...\n\
\ Load the given files using GHC and report errors/warnings, but\n\
\ don't produce output files.\n\
\\n\
\ - expand FILE...\n\
\ Like `check' but also pass `-ddump-splices' to GHC.\n\
\\n\
\ - info FILE [MODULE] EXPR\n\
\ Look up an identifier in the context of FILE (like ghci's `:info')\n\
\ MODULE is completely ignored and only allowed for backwards\n\
\ compatibility.\n\
\\n\
\ - type FILE [MODULE] LINE COL\n\
\ Get the type of the expression under (LINE,COL).\n\
\\n\
\ - split FILE [MODULE] LINE COL\n\
\ Split a function case by examining a type's constructors.\n\
\\n\
\ For example given the following code snippet:\n\
\\n\
\ f :: [a] -> a\n\
\ f x = _body\n\
\\n\
\ would be replaced by:\n\
\\n\
\ f :: [a] -> a\n\
\ f [] = _body\n\
\ f (x:xs) = _body\n\
\\n\
\ (See https://github.com/kazu-yamamoto/ghc-mod/pull/274)\n\
\\n\
\ - sig FILE MODULE LINE COL\n\
\ Generate initial code given a signature.\n\
\\n\
\ For example when (LINE,COL) is on the signature in the following\n\
\ code snippet:\n\
\\n\
\ func :: [a] -> Maybe b -> (a -> b) -> (a,b)\n\
\\n\
\ ghc-mod would add the following on the next line:\n\
\\n\
\ func x y z f = _func_body\n\
\\n\
\ (See: https://github.com/kazu-yamamoto/ghc-mod/pull/274)\n\
\\n\
\ - refine FILE MODULE LINE COL EXPR\n\
\ Refine the typed hole at (LINE,COL) given EXPR.\n\
\\n\
\ For example if EXPR is `filter', which has type `(a -> Bool) -> [a]\n\
\ -> [a]' and (LINE,COL) is on the hole `_body' in the following\n\
\ code snippet:\n\
\\n\
\ filterNothing :: [Maybe a] -> [a]\n\
\ filterNothing xs = _body\n\
\\n\
\ ghc-mod changes the code to get a value of type `[a]', which\n\
\ results in:\n\
\\n\
\ filterNothing xs = filter _body_1 _body_2\n\
\\n\
\ (See also: https://github.com/kazu-yamamoto/ghc-mod/issues/311)\n\
\\n\
\ - auto FILE MODULE LINE COL\n\
\ Try to automatically fill the contents of a hole.\n\
\\n\
\ - find SYMBOL\n\
\ List all modules that define SYMBOL.\n\
\\n\
\ - lint FILE\n\
\ Check files using `hlint'.\n\
\ Flags:\n\
\ -h\n\
\ Option to be passed to hlint.\n\
\\n\
\ - root\n\
\ Try to find the project directory. For Cabal projects this is the\n\
\ directory containing the cabal file, for projects that use a cabal\n\
\ sandbox but have no cabal file this is the directory containing the\n\
\ cabal.sandbox.config file and otherwise this is the current\n\
\ directory.\n\
\\n\
\ - doc MODULE\n\
\ Try finding the html documentation directory for the given MODULE.\n\
\\n\
\ - debug\n\
\ Print debugging information. Please include the output in any bug\n\
\ reports you submit.\n\
\\n\
\ - debugComponent [MODULE_OR_FILE...]\n\
\ Debugging information related to cabal component resolution.\n\
\\n\
\ - boot\n\
\ Internal command used by the emacs frontend.\n\
\\n\
\ - legacy-interactive\n\
\ ghc-modi compatibility mode.\n"
where
indent = (" "++)
cmdUsage :: String -> String -> String
cmdUsage cmd realUsage =
let
-- Find command head
a = dropWhile (not . isCmdHead) $ lines realUsage
-- Take til the end of the current command block
b = flip takeWhile a $ \l ->
all isSpace l || (isIndented l && (isCmdHead l || isNotCmdHead l))
-- Drop extra newline from the end
c = dropWhileEnd (all isSpace) b
isIndented = (" " `isPrefixOf`)
isNotCmdHead = ( not . (" - " `isPrefixOf`))
containsAnyCmdHead s = ((" - ") `isInfixOf` s)
containsCurrCmdHead s = ((" - " ++ cmd) `isInfixOf` s)
isCmdHead s =
containsAnyCmdHead s &&
or [ containsCurrCmdHead s
, any (cmd `isPrefixOf`) (splitOn " | " s)
]
unindent (' ':' ':' ':' ':l) = l
unindent l = l
in unlines $ unindent <$> c
ghcModStyle :: Style
ghcModStyle = style { lineLength = 80, ribbonsPerLine = 1.2 }
----------------------------------------------------------------
option :: [Char] -> [String] -> String -> ArgDescr a -> OptDescr a
option s l udsc dsc = Option s l dsc udsc
reqArg :: String -> (String -> a) -> ArgDescr a
reqArg udsc dsc = ReqArg dsc udsc
optArg :: String -> (Maybe String -> a) -> ArgDescr a
optArg udsc dsc = OptArg dsc udsc
intToLogLevel :: Int -> GmLogLevel
intToLogLevel = toEnum
globalArgSpec :: [OptDescr (Options -> Either [String] Options)]
globalArgSpec =
[ option "v" ["verbose"] "Increase or set log level. (0-7)" $
optArg "LEVEL" $ \ml o -> Right $ case ml of
Nothing ->
modify (lOoptLogLevel . lOptOutput) increaseLogLevel o
Just l ->
set (lOoptLogLevel . lOptOutput) (toEnum $ min 7 $ read l) o
, option "s" [] "Be silent, set log level to 0" $
NoArg $ \o -> Right $ set (lOoptLogLevel . lOptOutput) (toEnum 0) o
, option "l" ["tolisp"] "Format output as an S-Expression" $
NoArg $ \o -> Right $ set (lOoptStyle . lOptOutput) LispStyle o
, option "b" ["boundary", "line-seperator"] "Output line separator"$
reqArg "SEP" $ \s o -> Right $ set (lOoptLineSeparator . lOptOutput) (LineSeparator s) o
, option "" ["line-prefix"] "Output line separator"$
reqArg "OUT,ERR" $ \s o -> let
[out, err] = splitOn "," s
in Right $ set (lOoptLinePrefix . lOptOutput) (Just (out, err)) o
, option "g" ["ghcOpt", "ghc-option"] "Option to be passed to GHC" $
reqArg "OPT" $ \g o -> Right $
o { optGhcUserOptions = g : optGhcUserOptions o }
{-
File map docs:
@@ -308,59 +66,6 @@ Exposed functions:
first argument, and removes any temporary files created when file was
mapped. Works exactly the same as `unmap-file` interactive command
-}
, option "" ["map-file"] "Redirect one file to another, --map-file \"file1.hs=file2.hs\"" $
reqArg "OPT" $ \g o ->
let m = case second (drop 1) $ span (/='=') g of
(s,"") -> (s, Nothing)
(f,t) -> (f, Just t)
in
Right $ o { optFileMappings = m : optFileMappings o }
, option "" ["with-ghc"] "GHC executable to use" $
reqArg "PATH" $ \p o -> Right $ set (lGhcProgram . lOptPrograms) p o
, option "" ["with-ghc-pkg"] "ghc-pkg executable to use (only needed when guessing from GHC path fails)" $
reqArg "PATH" $ \p o -> Right $ set (lGhcPkgProgram . lOptPrograms) p o
, option "" ["with-cabal"] "cabal-install executable to use" $
reqArg "PATH" $ \p o -> Right $ set (lCabalProgram . lOptPrograms) p o
, option "" ["with-stack"] "stack executable to use" $
reqArg "PATH" $ \p o -> Right $ set (lStackProgram . lOptPrograms) p o
, option "" ["version"] "print version information" $
NoArg $ \_ -> Left ["version"]
, option "" ["help"] "print this help message" $
NoArg $ \_ -> Left ["help"]
]
parseGlobalArgs :: [String] -> Either InvalidCommandLine (Options, [String])
parseGlobalArgs argv
= case O.getOpt' RequireOrder globalArgSpec argv of
(o,r,u,[]) -> case foldr (=<<) (Right defaultOptions) o of
Right o' -> Right (o', u ++ r)
Left c -> Right (defaultOptions, c)
(_,_,u,e) -> Left $ InvalidCommandLine $ Right $
"Parsing command line options failed: "
++ concat (e ++ map errUnrec u)
where
errUnrec :: String -> String
errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n"
parseCommandArgs :: [OptDescr (Options -> Either [String] Options)]
-> [String]
-> Options
-> (Options, [String])
parseCommandArgs spec argv opts
= case O.getOpt RequireOrder (globalArgSpec ++ spec) argv of
(o,r,[]) -> case foldr (=<<) (Right opts) o of
Right o' -> (o', r)
Left c -> (defaultOptions, c)
(_,_,errs) ->
fatalError $ "Parsing command options failed: " ++ concat errs
----------------------------------------------------------------
@@ -381,38 +86,21 @@ handler = flip gcatches $
[ GHandler $ \(FatalError msg) -> exitError msg
, GHandler $ \e@(ExitSuccess) -> throw e
, GHandler $ \e@(ExitFailure _) -> throw e
, GHandler $ \(InvalidCommandLine e) -> do
case e of
Left cmd ->
exitError $ "Usage for `"++cmd++"' command:\n\n"
++ (cmdUsage cmd usage) ++ "\n"
++ "ghc-mod: Invalid command line form."
Right msg -> exitError $ "ghc-mod: " ++ msg
, GHandler $ \(SomeException e) -> exitError $ "ghc-mod: " ++ show e
]
main :: IO ()
main = do
hSetEncoding stdout utf8
args <- getArgs
case parseGlobalArgs args of
Left e -> throw e
Right res@(globalOptions,_) -> catches (progMain res) [
Handler $ \(e :: GhcModError) ->
runGmOutT globalOptions $ exitError $ renderStyle ghcModStyle (gmeDoc e)
]
parseArgs >>= \res@(globalOptions, _) ->
catches (progMain res) [
Handler $ \(e :: GhcModError) ->
runGmOutT globalOptions $ exitError $ renderStyle ghcModStyle (gmeDoc e)
]
progMain :: (Options,[String]) -> IO ()
progMain (globalOptions,cmdArgs) = runGmOutT globalOptions $
case globalCommands cmdArgs of
Just s -> gmPutStr s
Nothing -> wrapGhcCommands globalOptions cmdArgs
globalCommands :: [String] -> Maybe String
globalCommands (cmd:_)
| cmd == "help" = Just usage
| cmd == "version" = Just ghcModVersion
globalCommands _ = Nothing
progMain :: (Options, GhcModCommands) -> IO ()
progMain (globalOptions, commands) = runGmOutT globalOptions $
wrapGhcCommands globalOptions commands
-- ghc-modi
legacyInteractive :: IOish m => GhcModT m ()
@@ -464,22 +152,20 @@ legacyInteractiveLoop symdbreq world = do
args = dropWhileEnd isSpace `map` args'
res <- flip gcatches interactiveHandlers $ case dropWhileEnd isSpace cmd of
"check" -> checkSyntaxCmd [arg]
"lint" -> lintCmd [arg]
"check" -> checkSyntax [arg]
"find" -> do
db <- getDb symdbreq >>= checkDb symdbreq
lookupSymbol arg db
"info" -> infoCmd [head args, concat $ tail args']
"type" -> typesCmd args
"split" -> splitsCmd args
"info" -> info (head args) $ Expression $ concat $ tail args'
"type" -> locArgs types args
"split" -> locArgs splits args
"sig" -> sigCmd args
"auto" -> autoCmd args
"refine" -> refineCmd args
"sig" -> locArgs sig args
"auto" -> locArgs auto args
"refine" -> locArgs' refine args
"boot" -> bootCmd []
"browse" -> browseCmd args
"boot" -> boot
"map-file" -> liftIO getFileSourceFromStdin
>>= loadMappedFileSource arg
@@ -495,12 +181,16 @@ legacyInteractiveLoop symdbreq world = do
gmPutStr res >> gmPutStrLn "OK" >> liftIO (hFlush stdout)
legacyInteractiveLoop symdbreq world'
where
interactiveHandlers =
interactiveHandlers =
[ GHandler $ \e@(FatalError _) -> throw e
, GHandler $ \e@(ExitSuccess) -> throw e
, GHandler $ \e@(ExitFailure _) -> throw e
, GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return ""
]
locArgs a (f:l:c:_) = a f (read l) (read c)
locArgs _ _ = throw $ InvalidCommandLine $ Left "Invalid command line"
locArgs' a (f:l:c:xs) = a f (read l) (read c) (Expression $ concat xs)
locArgs' _ _ = throw $ InvalidCommandLine $ Left "Invalid command line"
getFileSourceFromStdin :: IO String
getFileSourceFromStdin = do
@@ -514,15 +204,14 @@ getFileSourceFromStdin = do
else return []
-- Someone please already rewrite the cmdline parsing code *weep* :'(
wrapGhcCommands :: (IOish m, GmOut m) => Options -> [String] -> m ()
wrapGhcCommands _opts [] = fatalError "No command given (try --help)"
wrapGhcCommands _opts ("root":_) = gmPutStr =<< rootInfo
wrapGhcCommands opts args = do
wrapGhcCommands :: (IOish m, GmOut m) => Options -> GhcModCommands -> m ()
wrapGhcCommands _opts CmdRoot = gmPutStr =<< rootInfo
wrapGhcCommands opts cmd = do
handleGmError $ runGhcModT opts $ handler $ do
forM_ (reverse $ optFileMappings opts) $
uncurry loadMMappedFiles
ghcCommands args
gmPutStr =<< ghcCommands cmd
where
handleGmError action = do
(e, _l) <- liftIO . evaluate =<< action
@@ -538,34 +227,31 @@ wrapGhcCommands opts args = do
loadMappedFileSource from src
ghcCommands :: IOish m => [String] -> GhcModT m ()
ghcCommands [] = fatalError "No command given (try --help)"
ghcCommands (cmd:args) = gmPutStr =<< action args
where
action = case cmd of
_ | cmd == "list" || cmd == "modules" -> modulesCmd
"lang" -> languagesCmd
"flag" -> flagsCmd
"browse" -> browseCmd
"check" -> checkSyntaxCmd
"expand" -> expandTemplateCmd
"debug" -> debugInfoCmd
"debug-component" -> componentInfoCmd
"info" -> infoCmd
"type" -> typesCmd
"split" -> splitsCmd
"sig" -> sigCmd
"refine" -> refineCmd
"auto" -> autoCmd
"find" -> findSymbolCmd
"lint" -> lintCmd
-- "root" -> rootInfoCmd
"doc" -> pkgDocCmd
"dumpsym" -> dumpSymbolCmd
"boot" -> bootCmd
"legacy-interactive" -> legacyInteractiveCmd
-- "nuke-caches" -> nukeCachesCmd
_ -> fatalError $ "unknown command: `" ++ cmd ++ "'"
ghcCommands :: IOish m => GhcModCommands -> GhcModT m String
-- ghcCommands cmd = action args
ghcCommands (CmdLang) = languages
ghcCommands (CmdFlag) = flags
ghcCommands (CmdDebug) = debugInfo
ghcCommands (CmdDebugComponent ts) = componentInfo ts
ghcCommands (CmdBoot) = boot
-- ghcCommands (CmdNukeCaches) = nukeCaches >> return ""
-- ghcCommands (CmdRoot) = undefined -- handled in wrapGhcCommands
ghcCommands (CmdLegacyInteractive) = legacyInteractive >> return ""
ghcCommands (CmdModules detail) = modules detail
ghcCommands (CmdDumpSym tmpdir) = dumpSymbol tmpdir
ghcCommands (CmdFind symb) = findSymbol symb
ghcCommands (CmdDoc m) = pkgDoc m
ghcCommands (CmdLint opts file) = lint opts file
ghcCommands (CmdBrowse opts ms) = concat <$> browse opts `mapM` ms
ghcCommands (CmdCheck files) = checkSyntax files
ghcCommands (CmdExpand files) = expandTemplate files
ghcCommands (CmdInfo file symb) = info file $ Expression symb
ghcCommands (CmdType file (line, col)) = types file line col
ghcCommands (CmdSplit file (line, col)) = splits file line col
ghcCommands (CmdSig file (line, col)) = sig file line col
ghcCommands (CmdAuto file (line, col)) = auto file line col
ghcCommands (CmdRefine file (line, col) expr) = refine file line col $ Expression expr
ghcCommands _ = fatalError "Unknown command"
newtype FatalError = FatalError String deriving (Show, Typeable)
instance Exception FatalError
@@ -580,114 +266,11 @@ exitError msg = gmErrStrLn (dropWhileEnd (=='\n') msg) >> liftIO exitFailure
fatalError :: String -> a
fatalError s = throw $ FatalError $ "ghc-mod: " ++ s
withParseCmd :: IOish m
=> [OptDescr (Options -> Either [String] Options)]
-> ([String] -> GhcModT m a)
-> [String]
-> GhcModT m a
withParseCmd spec action args = do
(opts', rest) <- parseCommandArgs spec args <$> options
withOptions (const opts') $ action rest
withParseCmd' :: (IOish m, ExceptionMonad m)
=> String
-> [OptDescr (Options -> Either [String] Options)]
-> ([String] -> GhcModT m a)
-> [String]
-> GhcModT m a
withParseCmd' cmd spec action args =
catchArgs cmd $ withParseCmd spec action args
catchArgs :: (Monad m, ExceptionMonad m) => String -> m a -> m a
catchArgs cmd action =
action `gcatch` \(PatternMatchFail _) ->
throw $ InvalidCommandLine (Left cmd)
modulesCmd, languagesCmd, flagsCmd, browseCmd, checkSyntaxCmd, expandTemplateCmd,
debugInfoCmd, componentInfoCmd, infoCmd, typesCmd, splitsCmd, sigCmd,
refineCmd, autoCmd, findSymbolCmd, lintCmd, pkgDocCmd,
dumpSymbolCmd, bootCmd, legacyInteractiveCmd, nukeCachesCmd
:: IOish m => [String] -> GhcModT m String
modulesCmd = withParseCmd' "modules" s $ \[] -> modules
where s = modulesArgSpec
languagesCmd = withParseCmd' "lang" [] $ \[] -> languages
flagsCmd = withParseCmd' "flag" [] $ \[] -> flags
debugInfoCmd = withParseCmd' "debug" [] $ \[] -> debugInfo
componentInfoCmd = withParseCmd' "debugComponent" [] $ \ts -> componentInfo ts
-- internal
bootCmd = withParseCmd' "boot" [] $ \[] -> boot
nukeCachesCmd = withParseCmd' "nuke-caches" [] $ \[] -> nukeCaches >> return ""
dumpSymbolCmd = withParseCmd' "dump" [] $ \[tmpdir] -> dumpSymbol tmpdir
findSymbolCmd = withParseCmd' "find" [] $ \[sym] -> findSymbol sym
pkgDocCmd = withParseCmd' "doc" [] $ \[mdl] -> pkgDoc mdl
lintCmd = withParseCmd' "lint" s $ \[file] -> lint file
where s = hlintArgSpec
browseCmd = withParseCmd s $ \mdls -> concat <$> browse `mapM` mdls
where s = browseArgSpec
checkSyntaxCmd = withParseCmd [] $ checkAction checkSyntax
expandTemplateCmd = withParseCmd [] $ checkAction expandTemplate
typesCmd = withParseCmd [] $ locAction "type" types
splitsCmd = withParseCmd [] $ locAction "split" splits
sigCmd = withParseCmd [] $ locAction "sig" sig
autoCmd = withParseCmd [] $ locAction "auto" auto
refineCmd = withParseCmd [] $ locAction' "refine" refine
infoCmd = withParseCmd [] $ action
where action [file,_,expr] = info file $ Expression expr
action [file,expr] = info file $ Expression expr
action _ = throw $ InvalidCommandLine (Left "info")
legacyInteractiveCmd = withParseCmd [] go
where
go [] =
legacyInteractive >> return ""
go ("help":[]) =
return usage
go ("version":[]) =
return ghcModiVersion
go _ = throw $ InvalidCommandLine (Left "legacy-interactive")
checkAction :: ([t] -> a) -> [t] -> a
checkAction _ [] = throw $ InvalidCommandLine (Right "No files given.")
checkAction action files = action files
locAction :: String -> (String -> Int -> Int -> a) -> [String] -> a
locAction _ action [file,_,line,col] = action file (read line) (read col)
locAction _ action [file, line,col] = action file (read line) (read col)
locAction cmd _ _ = throw $ InvalidCommandLine (Left cmd)
locAction' :: String -> (String -> Int -> Int -> Expression -> a) -> [String] -> a
locAction' _ action [f,_,line,col,expr] = action f (read line) (read col) (Expression expr)
locAction' _ action [f, line,col,expr] = action f (read line) (read col) (Expression expr)
locAction' cmd _ _ = throw $ InvalidCommandLine (Left cmd)
modulesArgSpec :: [OptDescr (Options -> Either [String] Options)]
modulesArgSpec =
[ option "d" ["detailed"] "Print package modules belong to." $
NoArg $ \o -> Right $ o { optDetailed = True }
]
hlintArgSpec :: [OptDescr (Options -> Either [String] Options)]
hlintArgSpec =
[ option "h" ["hlintOpt"] "Option to be passed to hlint" $
reqArg "hlintOpt" $ \h o -> Right $ o { optHlintOpts = h : optHlintOpts o }
]
browseArgSpec :: [OptDescr (Options -> Either [String] Options)]
browseArgSpec =
[ option "o" ["operators"] "Also print operators." $
NoArg $ \o -> Right $ o { optOperators = True }
, option "d" ["detailed"] "Print symbols with accompanying signature." $
NoArg $ \o -> Right $ o { optDetailed = True }
, option "q" ["qualified"] "Qualify symbols" $
NoArg $ \o -> Right $ o { optQualified = True }
]
nukeCaches :: IOish m => GhcModT m ()
nukeCaches = do
chdir <- liftIO $ (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod"