Formatting
This commit is contained in:
Nikolay Yakimov
parent
c8440a5c4d
commit
d255da0c89
|
|
@ -9,21 +9,25 @@ import Language.Haskell.GhcMod.Types
|
|||
import Control.Arrow
|
||||
import GHCMod.Options.Commands
|
||||
import GHCMod.Version
|
||||
import GHCMod.Options.DocUtils
|
||||
|
||||
parseArgs :: IO (Options, GhcModCommands)
|
||||
parseArgs =
|
||||
execParser opts
|
||||
where
|
||||
opts = info (argAndCmdSpec <**> helpVersion)
|
||||
( fullDesc
|
||||
<> header "ghc-mod: Happy Haskell Programming" )
|
||||
$$ fullDesc
|
||||
## header "ghc-mod: Happy Haskell Programming"
|
||||
|
||||
helpVersion :: Parser (a -> a)
|
||||
helpVersion =
|
||||
helper <*>
|
||||
abortOption (InfoMsg ghcModVersion)
|
||||
(long "version" <> help "Print the version of the program.") <*>
|
||||
argument r (value id <> metavar "")
|
||||
helper
|
||||
<*> abortOption (InfoMsg ghcModVersion)
|
||||
$$ long "version"
|
||||
## help "Print the version of the program."
|
||||
<*> argument r
|
||||
$$ value id
|
||||
## metavar ""
|
||||
where
|
||||
r :: ReadM (a -> a)
|
||||
r = do
|
||||
|
|
@ -44,92 +48,81 @@ getLogLevel = toEnum . min 7
|
|||
|
||||
logLevelParser :: Parser GmLogLevel
|
||||
logLevelParser =
|
||||
getLogLevel <$>
|
||||
(
|
||||
silentSwitch <|> logLevelSwitch <|> logLevelOption
|
||||
)
|
||||
getLogLevel
|
||||
<$> silentSwitch
|
||||
<||> logLevelSwitch
|
||||
<||> logLevelOption
|
||||
where
|
||||
logLevelOption =
|
||||
option int (
|
||||
long "verbose" <>
|
||||
metavar "LEVEL" <>
|
||||
value 4 <>
|
||||
showDefault <>
|
||||
help "Set log level. (0-7)"
|
||||
)
|
||||
option int
|
||||
$$ long "verbose"
|
||||
## metavar "LEVEL"
|
||||
## value 4
|
||||
## showDefault
|
||||
## help "Set log level. (0-7)"
|
||||
logLevelSwitch =
|
||||
(4+) . length <$> many (flag' () (
|
||||
short 'v' <>
|
||||
help "Increase log level"
|
||||
))
|
||||
silentSwitch = flag' 0 (
|
||||
long "silent" <>
|
||||
short 's' <>
|
||||
help "Be silent, set log level to 0"
|
||||
)
|
||||
(4+) . length <$> many $$ flag' ()
|
||||
$$ short 'v'
|
||||
## help "Increase log level"
|
||||
silentSwitch = flag' 0
|
||||
$$ long "silent"
|
||||
## short 's'
|
||||
## help "Be silent, set log level to 0"
|
||||
|
||||
outputOptsSpec :: Parser OutputOpts
|
||||
outputOptsSpec = OutputOpts <$>
|
||||
logLevelParser <*>
|
||||
flag PlainStyle LispStyle (
|
||||
long "tolisp" <>
|
||||
short 'l' <>
|
||||
help "Format output as an S-Expression"
|
||||
) <*>
|
||||
(LineSeparator <$> strOption (
|
||||
long "boundary" <>
|
||||
long "line-separator" <>
|
||||
short 'b' <>
|
||||
metavar "SEP" <>
|
||||
value "\0" <>
|
||||
showDefault <>
|
||||
help "Output line separator"
|
||||
)) <*>
|
||||
optional (splitOn ',' <$> strOption (
|
||||
long "line-prefix" <>
|
||||
metavar "OUT,ERR" <>
|
||||
help "Output prefixes"
|
||||
))
|
||||
outputOptsSpec = OutputOpts
|
||||
<$> logLevelParser
|
||||
<*> flag PlainStyle LispStyle
|
||||
$$ long "tolisp"
|
||||
## short 'l'
|
||||
## help "Format output as an S-Expression"
|
||||
<*> LineSeparator <$$> strOption
|
||||
$$ long "boundary"
|
||||
## long "line-separator"
|
||||
## short 'b'
|
||||
## metavar "SEP"
|
||||
## value "\0"
|
||||
## showDefault
|
||||
## help "Output line separator"
|
||||
<*> optional $$ splitOn ',' <$$> strOption
|
||||
$$ long "line-prefix"
|
||||
## metavar "OUT,ERR"
|
||||
## help "Output prefixes"
|
||||
|
||||
programsArgSpec :: Parser Programs
|
||||
programsArgSpec = Programs <$>
|
||||
strOption (
|
||||
long "with-ghc" <>
|
||||
value "ghc" <>
|
||||
showDefault <>
|
||||
help "GHC executable to use"
|
||||
) <*>
|
||||
strOption (
|
||||
long "with-ghc-pkg" <>
|
||||
value "ghc-pkg" <>
|
||||
showDefault <>
|
||||
help "ghc-pkg executable to use (only needed when guessing from GHC path fails)"
|
||||
) <*>
|
||||
strOption (
|
||||
long "with-cabal" <>
|
||||
value "cabal" <>
|
||||
showDefault <>
|
||||
help "cabal-install executable to use"
|
||||
) <*>
|
||||
strOption (
|
||||
long "with-stack" <>
|
||||
value "stack" <>
|
||||
showDefault <>
|
||||
help "stack executable to use"
|
||||
)
|
||||
programsArgSpec = Programs
|
||||
<$> strOption
|
||||
$$ long "with-ghc"
|
||||
## value "ghc"
|
||||
## showDefault
|
||||
## help "GHC executable to use"
|
||||
<*> strOption
|
||||
$$ long "with-ghc-pkg"
|
||||
## value "ghc-pkg"
|
||||
## showDefault
|
||||
## help "ghc-pkg executable to use (only needed when guessing from GHC path fails)"
|
||||
<*> strOption
|
||||
$$ long "with-cabal"
|
||||
## value "cabal"
|
||||
## showDefault
|
||||
## help "cabal-install executable to use"
|
||||
<*> strOption
|
||||
$$ long "with-stack"
|
||||
## value "stack"
|
||||
## showDefault
|
||||
## help "stack executable to use"
|
||||
|
||||
globalArgSpec :: Parser Options
|
||||
globalArgSpec = Options <$>
|
||||
outputOptsSpec <*> -- optOutput
|
||||
programsArgSpec <*> -- optPrograms
|
||||
many (strOption ( -- optGhcUserOptions
|
||||
long "ghcOpt" <>
|
||||
long "ghc-option" <>
|
||||
short 'g' <>
|
||||
metavar "OPT" <>
|
||||
help "Option to be passed to GHC"
|
||||
)) <*>
|
||||
many fileMappingSpec -- optFileMappings = []
|
||||
globalArgSpec = Options
|
||||
<$> outputOptsSpec
|
||||
<*> programsArgSpec
|
||||
<*> many $$ strOption
|
||||
$$ long "ghcOpt"
|
||||
## long "ghc-option"
|
||||
## short 'g'
|
||||
## metavar "OPT"
|
||||
## help "Option to be passed to GHC"
|
||||
<*> many fileMappingSpec
|
||||
where
|
||||
{-
|
||||
File map docs:
|
||||
|
|
@ -166,9 +159,8 @@ globalArgSpec = Options <$>
|
|||
mapped. Works exactly the same as `unmap-file` interactive command
|
||||
-}
|
||||
fileMappingSpec =
|
||||
getFileMapping . splitOn '=' <$> strOption (
|
||||
long "map-file" <>
|
||||
metavar "MAPPING" <>
|
||||
help "Redirect one file to another, --map-file \"file1.hs=file2.hs\""
|
||||
)
|
||||
getFileMapping . splitOn '=' <$> strOption
|
||||
$$ long "map-file"
|
||||
## metavar "MAPPING"
|
||||
## help "Redirect one file to another, --map-file \"file1.hs=file2.hs\""
|
||||
getFileMapping = second (\i -> if null i then Nothing else Just i)
|
||||
|
|
|
|||
|
|
@ -39,127 +39,121 @@ data GhcModCommands =
|
|||
|
||||
commandsSpec :: Parser GhcModCommands
|
||||
commandsSpec =
|
||||
hsubparser (
|
||||
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
|
||||
hsubparser
|
||||
$ 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
|
||||
"Print debugging information. Please include the output in any bug\
|
||||
\ reports you submit"))
|
||||
<> command "debug-component" (
|
||||
info debugComponentArgSpec
|
||||
(progDesc "Debugging information related to cabal component resolution"))
|
||||
<> command "boot" (
|
||||
info (pure CmdBoot)
|
||||
(progDesc "Internal command used by the emacs frontend"))
|
||||
\ reports you submit"
|
||||
<> command "debug-component"
|
||||
$$ info debugComponentArgSpec
|
||||
$$ progDesc "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
|
||||
<> command "root"
|
||||
$$ info (pure CmdRoot)
|
||||
$$ progDesc
|
||||
"Try to find the project directory. 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 (pure CmdLegacyInteractive)
|
||||
(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 dumpSymArgSpec idm)
|
||||
<> command "find" (
|
||||
info findArgSpec
|
||||
(progDesc "List all modules that define SYMBOL"))
|
||||
<> command "doc" (
|
||||
info docArgSpec
|
||||
(progDesc "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 "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
|
||||
<> command "legacy-interactive"
|
||||
$$ info (pure CmdLegacyInteractive)
|
||||
$$ 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 dumpSymArgSpec idm
|
||||
<> command "find"
|
||||
$$ info findArgSpec
|
||||
$$ progDesc "List all modules that define SYMBOL"
|
||||
<> command "doc"
|
||||
$$ info docArgSpec
|
||||
$$ progDesc "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 "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
|
||||
"Look up an identifier in the context of FILE (like ghci's `:info')\
|
||||
\ MODULE is completely ignored and only allowed for backwards\
|
||||
\ compatibility"))
|
||||
<> 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 [
|
||||
text "For example given the following code snippet:"
|
||||
, code [
|
||||
"f :: [a] -> a"
|
||||
, "f x = _body"
|
||||
]
|
||||
, text "would be replaced by:"
|
||||
, code [
|
||||
"f :: [a] -> a"
|
||||
, "f [] = _body"
|
||||
, "f (x:xs) = _body"
|
||||
]
|
||||
, text "(See https://github.com/kazu-yamamoto/ghc-mod/pull/274)"
|
||||
]))
|
||||
<> command "sig" (
|
||||
info sigArgSpec
|
||||
(progDesc
|
||||
"Generate initial code given a signature"
|
||||
<> desc [
|
||||
text "For example when (LINE,COL) is on the signature in the following\
|
||||
\ code snippet:"
|
||||
, code ["func :: [a] -> Maybe b -> (a -> b) -> (a,b)"]
|
||||
, text "ghc-mod would add the following on the next line:"
|
||||
, code ["func x y z f = _func_body"]
|
||||
, text "(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 [
|
||||
text "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 [
|
||||
"filterNothing :: [Maybe a] -> [a]"
|
||||
, "filterNothing xs = _body"
|
||||
]
|
||||
, text "ghc-mod changes the code to get a value of type `[a]', which\
|
||||
\ results in:"
|
||||
, code [ "filterNothing xs = filter _body_1 _body_2" ]
|
||||
, text "(See also: https://github.com/kazu-yamamoto/ghc-mod/issues/311)"
|
||||
]
|
||||
))
|
||||
)
|
||||
\ compatibility"
|
||||
<> 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 [
|
||||
text "For example given the following code snippet:"
|
||||
, code [
|
||||
"f :: [a] -> a"
|
||||
, "f x = _body"
|
||||
]
|
||||
, text "would be replaced by:"
|
||||
, code [
|
||||
"f :: [a] -> a"
|
||||
, "f [] = _body"
|
||||
, "f (x:xs) = _body"
|
||||
]
|
||||
, text "(See https://github.com/kazu-yamamoto/ghc-mod/pull/274)"
|
||||
]
|
||||
<> command "sig"
|
||||
$$ info sigArgSpec
|
||||
$$ progDesc "Generate initial code given a signature"
|
||||
## desc [
|
||||
text "For example when (LINE,COL) is on the signature in the following\
|
||||
\ code snippet:"
|
||||
, code ["func :: [a] -> Maybe b -> (a -> b) -> (a,b)"]
|
||||
, text "ghc-mod would add the following on the next line:"
|
||||
, code ["func x y z f = _func_body"]
|
||||
, text "(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 [
|
||||
text "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 [
|
||||
"filterNothing :: [Maybe a] -> [a]"
|
||||
, "filterNothing xs = _body"
|
||||
]
|
||||
, text "ghc-mod changes the code to get a value of type `[a]', which\
|
||||
\ results in:"
|
||||
, code [ "filterNothing xs = filter _body_1 _body_2" ]
|
||||
, text "(See also: https://github.com/kazu-yamamoto/ghc-mod/issues/311)"
|
||||
]
|
||||
|
||||
strArg :: String -> Parser String
|
||||
strArg = argument str . metavar
|
||||
|
|
@ -168,56 +162,54 @@ 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")
|
||||
)
|
||||
locArgSpec x = x
|
||||
<$> strArg "FILE"
|
||||
<*> ( (,)
|
||||
<$> argument int (metavar "LINE")
|
||||
<*> argument int (metavar "COL")
|
||||
)
|
||||
|
||||
modulesArgSpec, dumpSymArgSpec, docArgSpec, findArgSpec,
|
||||
lintArgSpec, browseArgSpec, checkArgSpec, expandArgSpec,
|
||||
infoArgSpec, typeArgSpec, autoArgSpec, splitArgSpec,
|
||||
sigArgSpec, refineArgSpec, debugComponentArgSpec :: Parser GhcModCommands
|
||||
|
||||
modulesArgSpec = CmdModules <$>
|
||||
switch (
|
||||
long "detailed" <>
|
||||
short 'd' <>
|
||||
help "Print package modules belong to"
|
||||
)
|
||||
modulesArgSpec = CmdModules
|
||||
<$> switch
|
||||
$$ long "detailed"
|
||||
## short 'd'
|
||||
## help "Print package modules belong to"
|
||||
dumpSymArgSpec = CmdDumpSym <$> strArg "TMPDIR"
|
||||
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"
|
||||
) <*> -- optOperators = False
|
||||
switch (
|
||||
long "detailed" <>
|
||||
short 'd' <>
|
||||
help "Print symbols with accompanying signature"
|
||||
) <*> -- optDetailed = False
|
||||
switch (
|
||||
long "qualified" <>
|
||||
short 'q' <>
|
||||
help "Qualify symbols"
|
||||
)) <*> some (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"
|
||||
infoArgSpec = CmdInfo
|
||||
<$> strArg "FILE"
|
||||
<*> strArg "SYMBOL"
|
||||
typeArgSpec = locArgSpec CmdType
|
||||
autoArgSpec = locArgSpec CmdAuto
|
||||
splitArgSpec = locArgSpec CmdSplit
|
||||
|
|
|
|||
|
|
@ -1,14 +1,35 @@
|
|||
module GHCMod.Options.DocUtils (
|
||||
module PP,
|
||||
desc,
|
||||
code
|
||||
code,
|
||||
($$),
|
||||
(##),
|
||||
(<$$>),
|
||||
(<||>)
|
||||
) where
|
||||
|
||||
import Options.Applicative
|
||||
import Text.PrettyPrint.ANSI.Leijen as PP hiding ((<>), (<$>), int)
|
||||
import Text.PrettyPrint.ANSI.Leijen as PP hiding ((<>), (<$>), (<$$>), int)
|
||||
|
||||
desc :: [Doc] -> InfoMod a
|
||||
desc = footerDoc . Just . indent 2 . vsep
|
||||
|
||||
code :: [String] -> Doc
|
||||
code x = vsep [line, indent 4 $ vsep $ map text x, line]
|
||||
|
||||
infixl 7 <||>
|
||||
infixr 8 <$$>
|
||||
infixr 8 $$
|
||||
infixr 9 ##
|
||||
|
||||
($$) :: (a -> b) -> a -> b
|
||||
($$) = ($)
|
||||
|
||||
(<||>) :: Alternative a => a b -> a b -> a b
|
||||
(<||>) = (<|>)
|
||||
|
||||
(##) :: Monoid m => m -> m -> m
|
||||
(##) = (<>)
|
||||
|
||||
(<$$>) :: Functor f => (a -> b) -> f a -> f b
|
||||
(<$$>) = (<$>)
|
||||
|
|
|
|||
Loading…
Reference in New Issue