ghc-mod/Language/Haskell/GhcMod/Options/Commands.hs
Alan Zimmerman 1cc97db24f Move the CLI parser definitions into the lib
So they can be used by library clients to parse and pass in the
appropriate ghc-mod Options.
2016-02-08 22:34:20 +02:00

293 lines
10 KiB
Haskell

-- ghc-mod: Making Haskell development *more* fun
-- Copyright (C) 2015 Nikolay Yakimov <root@livid.pp.ru>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module Language.Haskell.GhcMod.Options.Commands where
import Options.Applicative
import Options.Applicative.Types
import Options.Applicative.Builder.Internal
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Read
import Language.Haskell.GhcMod.Options.DocUtils
import Language.Haskell.GhcMod.Options.Help
type Symbol = String
type Expr = String
type Module = String
type Line = Int
type Col = Int
type Point = (Line, Col)
data GhcModCommands =
CmdLang
| CmdFlag
| CmdDebug
| CmdBoot
| CmdNukeCaches
| CmdRoot
| CmdLegacyInteractive
| CmdModules Bool
| CmdDumpSym
| CmdFind Symbol
| CmdDoc Module
| CmdLint LintOpts FilePath
| CmdBrowse BrowseOpts [Module]
| CmdDebugComponent [String]
| CmdCheck [FilePath]
| CmdExpand [FilePath]
| CmdInfo FilePath Symbol
| CmdType FilePath Point
| CmdSplit FilePath Point
| CmdSig FilePath Point
| CmdAuto FilePath Point
| CmdRefine FilePath Point Expr
| CmdTest FilePath
-- interactive-only commands
| CmdMapFile FilePath
| CmdUnmapFile FilePath
| CmdQuit
deriving (Show)
commandsSpec :: Parser GhcModCommands
commandsSpec =
hsubparser commands
commands :: Mod CommandFields GhcModCommands
commands =
command "lang"
$$ info (pure CmdLang)
$$ progDesc "List all known GHC language extensions"
<> command "flag"
$$ info (pure CmdFlag)
$$ progDesc "List GHC -f<foo> flags"
<> command "debug"
$$ info (pure CmdDebug)
$$ progDesc' $$$ do
"Print debugging information. Please include"
\\ "the output in any bug reports you submit"
<> command "debug-component"
$$ info debugComponentArgSpec
$$ progDesc' $$$ do
"Debugging information related to cabal component"
\\ "resolution"
<> command "boot"
$$ info (pure CmdBoot)
$$ progDesc "Internal command used by the emacs frontend"
-- <> command "nuke-caches"
-- $$ info (pure CmdNukeCaches) idm
<> command "root"
$$ info (pure CmdRoot)
$$ progDesc'
"Try to find the project directory."
<=> desc $$$ do
"For Cabal projects this is the"
\\ "directory containing the cabal file, for projects"
\\ "that use a cabal sandbox but have no cabal file"
\\ "this is the directory containing the cabal.sandbox.config"
\\ "file and otherwise this is the current directory"
<> command "legacy-interactive"
$$ info legacyInteractiveArgSpec
$$ progDesc "ghc-modi compatibility mode"
<> command "list"
$$ info modulesArgSpec
$$ progDesc "List all visible modules"
<> command "modules"
$$ info modulesArgSpec
$$ progDesc "List all visible modules"
<> command "dumpsym"
$$ info (pure CmdDumpSym) idm
<> command "find"
$$ info findArgSpec
$$ progDesc "List all modules that define SYMBOL"
<> command "doc"
$$ info docArgSpec
$$ progDesc' $$$ do
"Try finding the html documentation directory"
\\ "for the given MODULE"
<> command "lint"
$$ info lintArgSpec
$$ progDesc "Check files using `hlint'"
<> command "browse"
$$ info browseArgSpec
$$ progDesc "List symbols in a module"
<> command "check"
$$ info checkArgSpec
$$ progDesc' $$$ do
"Load the given files using GHC and report errors/warnings,"
\\ "but don't produce output files"
<> command "expand"
$$ info expandArgSpec
$$ progDesc "Like `check' but also pass `-ddump-splices' to GHC"
<> command "info"
$$ info infoArgSpec
$$ progDesc' $$$ do
"Look up an identifier in the context"
\\ "of FILE (like ghci's `:info')"
<> command "type"
$$ info typeArgSpec
$$ progDesc "Get the type of the expression under (LINE,COL)"
<> command "split"
$$ info splitArgSpec
$$ progDesc
"Split a function case by examining a type's constructors"
<=> desc $$$ do
"For example given the following code snippet:"
code $ do
"f :: [a] -> a"
"f x = _body"
"would be replaced by:"
code $ do
"f :: [a] -> a"
"f [] = _body"
"f (x:xs) = _body"
"(See https://github.com/kazu-yamamoto/ghc-mod/pull/274)"
<> command "sig"
$$ info sigArgSpec
$$ progDesc "Generate initial code given a signature"
<=> desc $$$ do
"For example when (LINE,COL) is on the"
\\ "signature in the following code snippet:"
code "func :: [a] -> Maybe b -> (a -> b) -> (a,b)"
"ghc-mod would add the following on the next line:"
code "func x y z f = _func_body"
"(See: https://github.com/kazu-yamamoto/ghc-mod/pull/274)"
<> command "auto"
$$ info autoArgSpec
$$ progDesc "Try to automatically fill the contents of a hole"
<> command "refine"
$$ info refineArgSpec
$$ progDesc "Refine the typed hole at (LINE,COL) given EXPR"
<=> desc $$$ do
"For example if EXPR is `filter', which has type"
\\ "`(a -> Bool) -> [a] -> [a]' and (LINE,COL) is on"
\\ " the hole `_body' in the following code snippet:"
code $ do
"filterNothing :: [Maybe a] -> [a]"
"filterNothing xs = _body"
"ghc-mod changes the code to get a value of type"
\\ " `[a]', which results in:"
code "filterNothing xs = filter _body_1 _body_2"
"(See also: https://github.com/kazu-yamamoto/ghc-mod/issues/311)"
<> command "test"
$$ info (CmdTest <$> strArg "FILE")
$$ progDesc ""
interactiveCommandsSpec :: Parser GhcModCommands
interactiveCommandsSpec =
hsubparser'
$ commands
<> command "map-file"
$$ info mapArgSpec
$$ progDesc "tells ghc-modi to read `file.hs` source from stdin"
<=> desc $$$ do
"Works the same as second form of"
\\ "`--map-file` CLI option."
<> command "unmap-file"
$$ info unmapArgSpec
$$ progDesc' $$$ do
"unloads previously mapped file,"
\\ "so that it's no longer mapped."
<=> desc $$$ do
"`file.hs` can be full path or relative"
\\ "to project root, either will work."
<> command "quit"
$$ info (pure CmdQuit)
$$ progDesc "Exit interactive mode"
<> command ""
$$ info (pure CmdQuit) idm
strArg :: String -> Parser String
strArg = argument str . metavar
filesArgsSpec :: ([String] -> b) -> Parser b
filesArgsSpec x = x <$> some (strArg "FILES..")
locArgSpec :: (String -> (Int, Int) -> b) -> Parser b
locArgSpec x = x
<$> strArg "FILE"
<*> ( (,)
<$> argument int (metavar "LINE")
<*> argument int (metavar "COL")
)
modulesArgSpec, docArgSpec, findArgSpec,
lintArgSpec, browseArgSpec, checkArgSpec, expandArgSpec,
infoArgSpec, typeArgSpec, autoArgSpec, splitArgSpec,
sigArgSpec, refineArgSpec, debugComponentArgSpec,
mapArgSpec, unmapArgSpec, legacyInteractiveArgSpec :: Parser GhcModCommands
modulesArgSpec = CmdModules
<$> switch
$$ long "detailed"
<=> short 'd'
<=> help "Print package modules belong to"
findArgSpec = CmdFind <$> strArg "SYMBOL"
docArgSpec = CmdDoc <$> strArg "MODULE"
lintArgSpec = CmdLint
<$> LintOpts <$$> many $$ strOption
$$ long "hlintOpt"
<=> short 'h'
<=> help "Option to be passed to hlint"
<*> strArg "FILE"
browseArgSpec = CmdBrowse
<$> (BrowseOpts
<$> switch
$$ long "operators"
<=> short 'o'
<=> help "Also print operators"
<*> switch
$$ long "detailed"
<=> short 'd'
<=> help "Print symbols with accompanying signature"
<*> switch
$$ long "qualified"
<=> short 'q'
<=> help "Qualify symbols"
)
<*> some (strArg "MODULE")
debugComponentArgSpec = filesArgsSpec CmdDebugComponent
checkArgSpec = filesArgsSpec CmdCheck
expandArgSpec = filesArgsSpec CmdExpand
infoArgSpec = CmdInfo
<$> strArg "FILE"
<*> strArg "SYMBOL"
typeArgSpec = locArgSpec CmdType
autoArgSpec = locArgSpec CmdAuto
splitArgSpec = locArgSpec CmdSplit
sigArgSpec = locArgSpec CmdSig
refineArgSpec = locArgSpec CmdRefine <*> strArg "SYMBOL"
mapArgSpec = CmdMapFile <$> strArg "FILE"
unmapArgSpec = CmdUnmapFile <$> strArg "FILE"
legacyInteractiveArgSpec = const CmdLegacyInteractive <$>
optional interactiveCommandsSpec
hsubparser' :: Mod CommandFields a -> Parser a
hsubparser' m = mkParser d g rdr
where
Mod _ d g = m `mappend` metavar ""
(cmds, subs) = mkCommand m
rdr = CmdReader cmds (fmap add_helper . subs)
add_helper pinfo = pinfo
{ infoParser = infoParser pinfo <**> helper }
int :: ReadM Int
int = do
v <- readerAsk
maybe (readerError $ "Not a number \"" ++ v ++ "\"") return $ readMaybe v