{-# LANGUAGE ScopedTypeVariables, CPP #-}
module System.Console.CmdArgs.Explicit(
process, processArgs, processValue, processValueIO,
module System.Console.CmdArgs.Explicit.Type,
flagHelpSimple, flagHelpFormat, flagVersion, flagNumericVersion, flagsVerbosity,
module System.Console.CmdArgs.Explicit.Help,
module System.Console.CmdArgs.Explicit.ExpandArgsAt,
module System.Console.CmdArgs.Explicit.SplitJoin,
Complete(..), complete
) where
import System.Console.CmdArgs.Explicit.Type
import System.Console.CmdArgs.Explicit.Process
import System.Console.CmdArgs.Explicit.Help
import System.Console.CmdArgs.Explicit.ExpandArgsAt
import System.Console.CmdArgs.Explicit.SplitJoin
import System.Console.CmdArgs.Explicit.Complete
import System.Console.CmdArgs.Default
import System.Console.CmdArgs.Helper
import System.Console.CmdArgs.Text
import System.Console.CmdArgs.Verbosity
import Control.Monad
import Data.Char
import Data.Maybe
import System.Environment
import System.Exit
import System.IO
processArgs :: Mode a -> IO a
processArgs :: Mode a -> IO a
processArgs m :: Mode a
m = do
[(String, String)]
env <- IO [(String, String)]
getEnvironment
case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "CMDARGS_COMPLETE" [(String, String)]
env of
Just x :: String
x -> do
[String]
args <- IO [String]
getArgs
let argInd :: Int
argInd = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
args Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay String
x
argPos :: Int
argPos = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (if Int
argInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
argInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
args then String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String]
args [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
argInd) else 0) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int) -> Maybe String -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "CMDARGS_COMPLETE_POS" [(String, String)]
env
[Complete] -> IO ()
forall a. Show a => a -> IO ()
print ([Complete] -> IO ()) -> [Complete] -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode a -> [String] -> (Int, Int) -> [Complete]
forall a. Mode a -> [String] -> (Int, Int) -> [Complete]
complete Mode a
m ((String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
words [String]
args) (Int
argInd,Int
argPos)
ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess
Nothing -> do
String
nam <- IO String
getProgName
let var :: Maybe String
var = Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ("CMDARGS_HELPER_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
m [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
nam])) [(String, String)]
env)
(String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "CMDARGS_HELPER" [(String, String)]
env)
case Maybe String
var of
Nothing -> Mode a -> [String] -> IO a
forall a. Mode a -> [String] -> IO a
processValueIO Mode a
m ([String] -> IO a) -> IO [String] -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (if Mode a -> Bool
forall a. Mode a -> Bool
modeExpandAt Mode a
m then [String] -> IO [String]
expandArgsAt else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return) ([String] -> IO [String]) -> IO [String] -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
getArgs
Just cmd :: String
cmd -> do
Either String [String]
res <- String -> Mode a -> [String] -> IO (Either String [String])
forall a.
String -> Mode a -> [String] -> IO (Either String [String])
execute String
cmd Mode a
m []
case Either String [String]
res of
Left err :: String
err -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error when running helper " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmd
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err
IO a
forall a. IO a
exitFailure
Right args :: [String]
args -> Mode a -> [String] -> IO a
forall a. Mode a -> [String] -> IO a
processValueIO Mode a
m [String]
args
readMay :: Read a => String -> Maybe a
readMay :: String -> Maybe a
readMay s :: String
s = case [a
x | (x :: a
x,t :: String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
s, ("","") <- ReadS String
lex String
t] of
[x :: a
x] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
_ -> Maybe a
forall a. Maybe a
Nothing
#if __GLASGOW_HASKELL__ < 800
errorWithoutStackTrace :: String -> a
errorWithoutStackTrace = error
#endif
processValue :: Mode a -> [String] -> a
processValue :: Mode a -> [String] -> a
processValue m :: Mode a
m xs :: [String]
xs = case Mode a -> [String] -> Either String a
forall a. Mode a -> [String] -> Either String a
process Mode a
m [String]
xs of
Left x :: String
x -> String -> a
forall a. String -> a
errorWithoutStackTrace String
x
Right x :: a
x -> a
x
processValueIO :: Mode a -> [String] -> IO a
processValueIO :: Mode a -> [String] -> IO a
processValueIO m :: Mode a
m xs :: [String]
xs = case Mode a -> [String] -> Either String a
forall a. Mode a -> [String] -> Either String a
process Mode a
m [String]
xs of
Left x :: String
x -> do Handle -> String -> IO ()
hPutStrLn Handle
stderr String
x; IO a
forall a. IO a
exitFailure
Right x :: a
x -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
flagHelpSimple :: (a -> a) -> Flag a
flagHelpSimple :: (a -> a) -> Flag a
flagHelpSimple f :: a -> a
f = [String] -> (a -> a) -> String -> Flag a
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone ["help","?"] a -> a
f "Display help message"
flagHelpFormat :: (HelpFormat -> TextFormat -> a -> a) -> Flag a
flagHelpFormat :: (HelpFormat -> TextFormat -> a -> a) -> Flag a
flagHelpFormat f :: HelpFormat -> TextFormat -> a -> a
f = (String -> [String] -> Update a -> String -> String -> Flag a
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt "" ["help","?"] Update a
upd "" "Display help message"){flagInfo :: FlagInfo
flagInfo = String -> FlagInfo
FlagOptRare ""}
where
upd :: Update a
upd s :: String
s v :: a
v = case String -> Either String (HelpFormat, TextFormat)
format String
s of
Left e :: String
e -> String -> Either String a
forall a b. a -> Either a b
Left String
e
Right (a :: HelpFormat
a,b :: TextFormat
b) -> a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ HelpFormat -> TextFormat -> a -> a
f HelpFormat
a TextFormat
b a
v
format :: String -> Either String (HelpFormat,TextFormat)
format :: String -> Either String (HelpFormat, TextFormat)
format xs :: String
xs = (Either String (HelpFormat, TextFormat)
-> String -> Either String (HelpFormat, TextFormat))
-> Either String (HelpFormat, TextFormat)
-> [String]
-> Either String (HelpFormat, TextFormat)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\acc :: Either String (HelpFormat, TextFormat)
acc x :: String
x -> (String -> Either String (HelpFormat, TextFormat))
-> ((HelpFormat, TextFormat)
-> Either String (HelpFormat, TextFormat))
-> Either String (HelpFormat, TextFormat)
-> Either String (HelpFormat, TextFormat)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String (HelpFormat, TextFormat)
forall a b. a -> Either a b
Left (String
-> (HelpFormat, TextFormat)
-> Either String (HelpFormat, TextFormat)
f String
x) Either String (HelpFormat, TextFormat)
acc) ((HelpFormat, TextFormat) -> Either String (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat, TextFormat)
forall a. Default a => a
def) (String -> [String]
sep String
xs)
where
sep :: String -> [String]
sep = String -> [String]
words (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Char
x -> if Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ":," then ' ' else Char -> Char
toLower Char
x)
f :: String
-> (HelpFormat, TextFormat)
-> Either String (HelpFormat, TextFormat)
f x :: String
x (a :: HelpFormat
a,b :: TextFormat
b) = case String
x of
"all" -> (HelpFormat, TextFormat) -> Either String (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatAll,TextFormat
b)
"one" -> (HelpFormat, TextFormat) -> Either String (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatOne,TextFormat
b)
"def" -> (HelpFormat, TextFormat) -> Either String (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatDefault,TextFormat
b)
"html" -> (HelpFormat, TextFormat) -> Either String (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
a,TextFormat
HTML)
"text" -> (HelpFormat, TextFormat) -> Either String (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
a,TextFormat
defaultWrap)
"bash" -> (HelpFormat, TextFormat) -> Either String (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatBash,Int -> TextFormat
Wrap 1000000)
"zsh" -> (HelpFormat, TextFormat) -> Either String (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatZsh ,Int -> TextFormat
Wrap 1000000)
_ | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
x -> (HelpFormat, TextFormat) -> Either String (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
a,Int -> TextFormat
Wrap (Int -> TextFormat) -> Int -> TextFormat
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read String
x)
_ -> String -> Either String (HelpFormat, TextFormat)
forall a b. a -> Either a b
Left "unrecognised help format, expected one of: all one def html text <NUMBER>"
flagVersion :: (a -> a) -> Flag a
flagVersion :: (a -> a) -> Flag a
flagVersion f :: a -> a
f = [String] -> (a -> a) -> String -> Flag a
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone ["version","V"] a -> a
f "Print version information"
flagNumericVersion :: (a -> a) -> Flag a
flagNumericVersion :: (a -> a) -> Flag a
flagNumericVersion f :: a -> a
f = [String] -> (a -> a) -> String -> Flag a
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone ["numeric-version"] a -> a
f "Print just the version number"
flagsVerbosity :: (Verbosity -> a -> a) -> [Flag a]
flagsVerbosity :: (Verbosity -> a -> a) -> [Flag a]
flagsVerbosity f :: Verbosity -> a -> a
f =
[[String] -> (a -> a) -> String -> Flag a
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone ["verbose","v"] (Verbosity -> a -> a
f Verbosity
Loud) "Loud verbosity"
,[String] -> (a -> a) -> String -> Flag a
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone ["quiet","q"] (Verbosity -> a -> a
f Verbosity
Quiet) "Quiet verbosity"]