Formatting

This commit is contained in:
Nikolay Yakimov 2015-12-06 19:22:21 +03:00
parent c8440a5c4d
commit d255da0c89
3 changed files with 244 additions and 239 deletions

View File

@ -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)

View File

@ -39,79 +39,78 @@ 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
\ 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 [
## desc [
text "For example given the following code snippet:"
, code [
"f :: [a] -> a"
@ -124,12 +123,11 @@ commandsSpec =
, "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 [
]
<> 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)"]
@ -137,15 +135,13 @@ commandsSpec =
, 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 [
<> 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:"
@ -158,8 +154,6 @@ commandsSpec =
, 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,11 +162,11 @@ 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,
@ -180,44 +174,42 @@ modulesArgSpec, dumpSymArgSpec, docArgSpec, findArgSpec,
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

View File

@ -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
(<$$>) = (<$>)