From d255da0c89040a4d534f48a91a53e0bbd11a53f5 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Sun, 6 Dec 2015 19:22:21 +0300 Subject: [PATCH] Formatting --- src/GHCMod/Options.hs | 168 +++++++++---------- src/GHCMod/Options/Commands.hs | 290 ++++++++++++++++----------------- src/GHCMod/Options/DocUtils.hs | 25 ++- 3 files changed, 244 insertions(+), 239 deletions(-) diff --git a/src/GHCMod/Options.hs b/src/GHCMod/Options.hs index 4f84a57..4b7d159 100644 --- a/src/GHCMod/Options.hs +++ b/src/GHCMod/Options.hs @@ -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) diff --git a/src/GHCMod/Options/Commands.hs b/src/GHCMod/Options/Commands.hs index 007ddec..0d44d63 100644 --- a/src/GHCMod/Options/Commands.hs +++ b/src/GHCMod/Options/Commands.hs @@ -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 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 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 diff --git a/src/GHCMod/Options/DocUtils.hs b/src/GHCMod/Options/DocUtils.hs index d23e7b3..644995e 100644 --- a/src/GHCMod/Options/DocUtils.hs +++ b/src/GHCMod/Options/DocUtils.hs @@ -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 +(<$$>) = (<$>)