{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StandaloneDeriving #-}
module Plugin.GhcTags.Options
( Options (..)
, ParserResult (..)
, runOptionParser
) where
import Data.Bool (bool)
import Data.Monoid (Last (..))
import Data.Functor.Identity (Identity (..))
import Options.Applicative
etagsParser :: Parser Bool
etagsParser :: Parser Bool
etagsParser = Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'e'
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"etags"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"produce emacs etags file"
filePathParser :: Parser (FilePath)
filePathParser :: Parser String
filePathParser =
Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (Mod ArgumentFields String -> Parser String)
-> Mod ArgumentFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"tags file: default tags or TAGS (when --etags is specified)"
Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"file_path"
debugParser :: Parser Bool
debugParser :: Parser Bool
debugParser = Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"debug"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"debug"
data Options f = Options
{ Options f -> Bool
etags :: Bool
, Options f -> f String
filePath :: f FilePath
, Options f -> Bool
debug :: Bool
}
deriving instance Show (Options Identity)
parseOtions :: Parser (Options Last)
parseOtions :: Parser (Options Last)
parseOtions = Bool -> Last String -> Bool -> Options Last
forall (f :: * -> *). Bool -> f String -> Bool -> Options f
Options
(Bool -> Last String -> Bool -> Options Last)
-> Parser Bool -> Parser (Last String -> Bool -> Options Last)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
etagsParser
Parser (Last String -> Bool -> Options Last)
-> Parser (Last String) -> Parser (Bool -> Options Last)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((String -> Last String) -> [String] -> Last String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe String -> Last String
forall a. Maybe a -> Last a
Last (Maybe String -> Last String)
-> (String -> Maybe String) -> String -> Last String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just) ([String] -> Last String)
-> Parser [String] -> Parser (Last String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser String
filePathParser)
Parser (Bool -> Options Last)
-> Parser Bool -> Parser (Options Last)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
debugParser
parserInfo :: ParserInfo (Options Last)
parserInfo :: ParserInfo (Options Last)
parserInfo = Parser (Options Last)
-> InfoMod (Options Last) -> ParserInfo (Options Last)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (Options Last)
parseOtions Parser (Options Last)
-> Parser (Options Last -> Options Last) -> Parser (Options Last)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Options Last -> Options Last)
forall a. Parser (a -> a)
helper) (InfoMod (Options Last) -> ParserInfo (Options Last))
-> InfoMod (Options Last) -> ParserInfo (Options Last)
forall a b. (a -> b) -> a -> b
$
String -> InfoMod (Options Last)
forall a. String -> InfoMod a
progDesc String
"write tags from ghc abstract syntax tree"
InfoMod (Options Last)
-> InfoMod (Options Last) -> InfoMod (Options Last)
forall a. Semigroup a => a -> a -> a
<> InfoMod (Options Last)
forall a. InfoMod a
fullDesc
runOptionParser :: [String]
-> ParserResult (Options Identity)
runOptionParser :: [String] -> ParserResult (Options Identity)
runOptionParser = (Options Last -> Options Identity)
-> ParserResult (Options Last) -> ParserResult (Options Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Options Last -> Options Identity
defaultOptions (ParserResult (Options Last) -> ParserResult (Options Identity))
-> ([String] -> ParserResult (Options Last))
-> [String]
-> ParserResult (Options Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs
-> ParserInfo (Options Last)
-> [String]
-> ParserResult (Options Last)
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure ParserPrefs
defaultPrefs ParserInfo (Options Last)
parserInfo
where
defaultOptions :: Options Last -> Options Identity
defaultOptions :: Options Last -> Options Identity
defaultOptions Options { Bool
etags :: Bool
etags :: forall (f :: * -> *). Options f -> Bool
etags, Last String
filePath :: Last String
filePath :: forall (f :: * -> *). Options f -> f String
filePath, Bool
debug :: Bool
debug :: forall (f :: * -> *). Options f -> Bool
debug } =
Options :: forall (f :: * -> *). Bool -> f String -> Bool -> Options f
Options {
Bool
etags :: Bool
etags :: Bool
etags,
filePath :: Identity String
filePath = String -> Identity String
forall a. a -> Identity a
Identity String
filePath',
Bool
debug :: Bool
debug :: Bool
debug
}
where
filePath' :: String
filePath' =
case Last String
filePath of
Last Maybe String
Nothing -> String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
"tags" String
"TAGS" Bool
etags
Last (Just String
fp) -> String
fp