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.
This commit is contained in:
Alan Zimmerman
292
Language/Haskell/GhcMod/Options/Commands.hs
Normal file
292
Language/Haskell/GhcMod/Options/Commands.hs
Normal file
@@ -0,0 +1,292 @@
|
||||
-- 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
|
||||
48
Language/Haskell/GhcMod/Options/DocUtils.hs
Normal file
48
Language/Haskell/GhcMod/Options/DocUtils.hs
Normal file
@@ -0,0 +1,48 @@
|
||||
-- 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/>.
|
||||
|
||||
module Language.Haskell.GhcMod.Options.DocUtils (
|
||||
($$),
|
||||
($$$),
|
||||
(<=>),
|
||||
(<$$>),
|
||||
(<||>)
|
||||
) where
|
||||
|
||||
import Options.Applicative
|
||||
import Data.Monoid
|
||||
import Prelude
|
||||
|
||||
infixl 6 <||>
|
||||
infixr 7 <$$>
|
||||
infixr 7 $$
|
||||
infixr 8 <=>
|
||||
infixr 9 $$$
|
||||
|
||||
($$) :: (a -> b) -> a -> b
|
||||
($$) = ($)
|
||||
|
||||
($$$) :: (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
|
||||
(<$$>) = (<$>)
|
||||
79
Language/Haskell/GhcMod/Options/Help.hs
Normal file
79
Language/Haskell/GhcMod/Options/Help.hs
Normal file
@@ -0,0 +1,79 @@
|
||||
-- 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, FlexibleInstances, GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Language.Haskell.GhcMod.Options.Help where
|
||||
|
||||
import Options.Applicative
|
||||
import Options.Applicative.Help.Pretty (Doc)
|
||||
import qualified Options.Applicative.Help.Pretty as PP
|
||||
import Control.Monad.State
|
||||
import GHC.Exts( IsString(..) )
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import Prelude
|
||||
|
||||
newtype MyDocM s a = MyDoc {unwrapState :: State s a}
|
||||
deriving (Monad, Functor, Applicative, MonadState s)
|
||||
type MyDoc = MyDocM (Maybe Doc) ()
|
||||
|
||||
instance IsString (MyDocM (Maybe Doc) a) where
|
||||
fromString = append . para
|
||||
|
||||
instance Monoid (MyDocM (Maybe Doc) ()) where
|
||||
mappend a b = append $ doc a <> doc b
|
||||
mempty = append PP.empty
|
||||
|
||||
para :: String -> Doc
|
||||
para = PP.fillSep . map PP.text . words
|
||||
|
||||
append :: Doc -> MyDocM (Maybe Doc) a
|
||||
append s = modify m >> return undefined
|
||||
where
|
||||
m :: Maybe Doc -> Maybe Doc
|
||||
m Nothing = Just s
|
||||
m (Just old) = Just $ old PP..$. s
|
||||
|
||||
infixr 7 \\
|
||||
(\\) :: MyDoc -> MyDoc -> MyDoc
|
||||
(\\) a b = append $ doc a PP.<+> doc b
|
||||
|
||||
doc :: MyDoc -> Doc
|
||||
doc = fromMaybe PP.empty . flip execState Nothing . unwrapState
|
||||
|
||||
help' :: MyDoc -> Mod f a
|
||||
help' = helpDoc . Just . doc
|
||||
|
||||
desc :: MyDoc -> InfoMod a
|
||||
desc = footerDoc . Just . doc . indent 2
|
||||
|
||||
code :: MyDoc -> MyDoc
|
||||
code x = do
|
||||
_ <- " "
|
||||
indent 4 x
|
||||
" "
|
||||
|
||||
progDesc' :: MyDoc -> InfoMod a
|
||||
progDesc' = progDescDoc . Just . doc
|
||||
|
||||
indent :: Int -> MyDoc -> MyDoc
|
||||
indent n = append . PP.indent n . doc
|
||||
|
||||
int' :: Int -> MyDoc
|
||||
int' = append . PP.int
|
||||
|
||||
para' :: String -> MyDoc
|
||||
para' = append . para
|
||||
201
Language/Haskell/GhcMod/Options/Options.hs
Normal file
201
Language/Haskell/GhcMod/Options/Options.hs
Normal file
@@ -0,0 +1,201 @@
|
||||
-- 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.Options (
|
||||
parseArgs,
|
||||
parseArgsInteractive,
|
||||
GhcModCommands(..)
|
||||
) where
|
||||
|
||||
import Options.Applicative
|
||||
import Options.Applicative.Types
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Control.Arrow
|
||||
import Data.Char (toUpper, toLower)
|
||||
import Data.List (intercalate)
|
||||
import Language.Haskell.GhcMod.Read
|
||||
import Language.Haskell.GhcMod.Options.Commands
|
||||
import Language.Haskell.GhcMod.Options.Version
|
||||
import Language.Haskell.GhcMod.Options.DocUtils
|
||||
import Language.Haskell.GhcMod.Options.Help
|
||||
import Language.Haskell.GhcMod.Options.ShellParse
|
||||
|
||||
parseArgs :: IO (Options, GhcModCommands)
|
||||
parseArgs =
|
||||
execParser opts
|
||||
where
|
||||
opts = info (argAndCmdSpec <**> helpVersion)
|
||||
$$ fullDesc
|
||||
<=> header "ghc-mod: Happy Haskell Programming"
|
||||
|
||||
parseArgsInteractive :: String -> Either String GhcModCommands
|
||||
parseArgsInteractive args =
|
||||
handle $ execParserPure (prefs idm) opts $ parseCmdLine args
|
||||
where
|
||||
opts = info interactiveCommandsSpec $$ fullDesc
|
||||
handle (Success a) = Right a
|
||||
handle (Failure failure) =
|
||||
Left $ fst $ renderFailure failure ""
|
||||
handle _ = Left "Completion invoked"
|
||||
|
||||
helpVersion :: Parser (a -> a)
|
||||
helpVersion =
|
||||
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
|
||||
v <- readerAsk
|
||||
case v of
|
||||
"help" -> readerAbort ShowHelpText
|
||||
"version" -> readerAbort $ InfoMsg ghcModVersion
|
||||
_ -> return id
|
||||
|
||||
argAndCmdSpec :: Parser (Options, GhcModCommands)
|
||||
argAndCmdSpec = (,) <$> globalArgSpec <*> commandsSpec
|
||||
|
||||
splitOn :: Eq a => a -> [a] -> ([a], [a])
|
||||
splitOn c = second (drop 1) . break (==c)
|
||||
|
||||
logLevelParser :: Parser GmLogLevel
|
||||
logLevelParser =
|
||||
logLevelSwitch <*>
|
||||
logLevelOption
|
||||
<||> silentSwitch
|
||||
where
|
||||
logLevelOption =
|
||||
option parseLL
|
||||
$$ long "verbose"
|
||||
<=> metavar "LEVEL"
|
||||
<=> value GmWarning
|
||||
<=> showDefaultWith showLL
|
||||
<=> help' $$$ do
|
||||
"Set log level ("
|
||||
<> int' (fromEnum (minBound :: GmLogLevel))
|
||||
<> "-"
|
||||
<> int' (fromEnum (maxBound :: GmLogLevel))
|
||||
<> ")"
|
||||
"You can also use strings (case-insensitive):"
|
||||
para'
|
||||
$ intercalate ", "
|
||||
$ map showLL ([minBound..maxBound] :: [GmLogLevel])
|
||||
logLevelSwitch =
|
||||
repeatAp succ' . length <$> many $$ flag' ()
|
||||
$$ short 'v'
|
||||
<=> help "Increase log level"
|
||||
silentSwitch = flag' GmSilent
|
||||
$$ long "silent"
|
||||
<=> short 's'
|
||||
<=> help "Be silent, set log level to 'silent'"
|
||||
showLL = drop 2 . map toLower . show
|
||||
repeatAp f n = foldr (.) id (replicate n f)
|
||||
succ' x | x == maxBound = x
|
||||
| otherwise = succ x
|
||||
parseLL = do
|
||||
v <- readerAsk
|
||||
let
|
||||
il'= toEnum . min maxBound <$> readMaybe v
|
||||
ll' = readMaybe ("Gm" ++ capFirst v)
|
||||
maybe (readerError $ "Not a log level \"" ++ v ++ "\"") return $ ll' <|> il'
|
||||
capFirst (h:t) = toUpper h : map toLower t
|
||||
capFirst [] = []
|
||||
|
||||
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"
|
||||
|
||||
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"
|
||||
|
||||
globalArgSpec :: Parser Options
|
||||
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
|
||||
fileMappingSpec =
|
||||
getFileMapping . splitOn '=' <$> strOption
|
||||
$$ long "map-file"
|
||||
<=> metavar "MAPPING"
|
||||
<=> fileMappingHelp
|
||||
fileMappingHelp = help' $ do
|
||||
"Redirect one file to another"
|
||||
"--map-file \"file1.hs=file2.hs\""
|
||||
indent 4 $ do
|
||||
"can be used to tell ghc-mod"
|
||||
\\ "that it should take source code"
|
||||
\\ "for `file1.hs` from `file2.hs`."
|
||||
"`file1.hs` can be either full path,"
|
||||
\\ "or path relative to project root."
|
||||
"`file2.hs` has to be either relative to project root,"
|
||||
\\ "or full path (preferred)"
|
||||
"--map-file \"file.hs\""
|
||||
indent 4 $ do
|
||||
"can be used to tell ghc-mod that it should take"
|
||||
\\ "source code for `file.hs` from stdin. File end"
|
||||
\\ "marker is `\\n\\EOT\\n`, i.e. `\\x0A\\x04\\x0A`."
|
||||
\\ "`file.hs` may or may not exist, and should be"
|
||||
\\ "either full path, or relative to project root."
|
||||
getFileMapping = second (\i -> if null i then Nothing else Just i)
|
||||
44
Language/Haskell/GhcMod/Options/ShellParse.hs
Normal file
44
Language/Haskell/GhcMod/Options/ShellParse.hs
Normal file
@@ -0,0 +1,44 @@
|
||||
-- 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/>.
|
||||
module Language.Haskell.GhcMod.Options.ShellParse (parseCmdLine) where
|
||||
|
||||
import Data.Char
|
||||
import Data.List
|
||||
|
||||
go :: String -> String -> [String] -> Bool -> [String]
|
||||
-- result
|
||||
go [] curarg accargs _ = reverse $ reverse curarg : accargs
|
||||
go (c:cl) curarg accargs quotes
|
||||
-- open quotes
|
||||
| c == '\STX', not quotes
|
||||
= go cl curarg accargs True
|
||||
-- close quotes
|
||||
| c == '\ETX', quotes
|
||||
= go cl curarg accargs False
|
||||
-- space separates arguments outside quotes
|
||||
| isSpace c, not quotes
|
||||
= if null curarg
|
||||
then go cl curarg accargs quotes
|
||||
else go cl [] (reverse curarg : accargs) quotes
|
||||
-- general character
|
||||
| otherwise = go cl (c:curarg) accargs quotes
|
||||
|
||||
parseCmdLine :: String -> [String]
|
||||
parseCmdLine comline'
|
||||
| Just comline <- stripPrefix "ascii-escape " $ dropWhile isSpace comline'
|
||||
= go (dropWhile isSpace comline) [] [] False
|
||||
parseCmdLine [] = [""]
|
||||
parseCmdLine comline = words comline
|
||||
32
Language/Haskell/GhcMod/Options/Version.hs
Normal file
32
Language/Haskell/GhcMod/Options/Version.hs
Normal file
@@ -0,0 +1,32 @@
|
||||
-- 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/>.
|
||||
|
||||
module Language.Haskell.GhcMod.Options.Version where
|
||||
|
||||
import Paths_ghc_mod
|
||||
import Data.Version (showVersion)
|
||||
import Config (cProjectVersion)
|
||||
|
||||
progVersion :: String -> String
|
||||
progVersion pf =
|
||||
"ghc-mod"++pf++" version " ++ showVersion version ++ " compiled by GHC "
|
||||
++ cProjectVersion
|
||||
|
||||
ghcModVersion :: String
|
||||
ghcModVersion = progVersion ""
|
||||
|
||||
ghcModiVersion :: String
|
||||
ghcModiVersion = progVersion "i"
|
||||
Reference in New Issue
Block a user