{-# LANGUAGE FlexibleContexts, CPP #-}
module Jukebox.Options where
import Data.Char
import Data.List
import System.Environment
import System.Exit
import System.IO
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Monoid
#endif
import Data.Semigroup(Semigroup(..))
import Control.Monad
data Annotated d p a = Annotated
{ forall d (p :: * -> *) a. Annotated d p a -> d
descr :: d,
forall d (p :: * -> *) a. Annotated d p a -> p a
parser :: p a }
instance Functor p => Functor (Annotated d p) where
fmap :: forall a b. (a -> b) -> Annotated d p a -> Annotated d p b
fmap a -> b
f (Annotated d
d p a
x) = d -> p b -> Annotated d p b
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated d
d ((a -> b) -> p a -> p b
forall a b. (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f p a
x)
instance (Monoid d, Applicative p) => Applicative (Annotated d p) where
pure :: forall a. a -> Annotated d p a
pure = d -> p a -> Annotated d p a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated d
forall a. Monoid a => a
mempty (p a -> Annotated d p a) -> (a -> p a) -> a -> Annotated d p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> p a
forall a. a -> p a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Annotated d
d p (a -> b)
f <*> :: forall a b.
Annotated d p (a -> b) -> Annotated d p a -> Annotated d p b
<*> Annotated d
d' p a
x =
d -> p b -> Annotated d p b
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated (d
d d -> d -> d
forall a. Monoid a => a -> a -> a
`mappend` d
d') (p (a -> b)
f p (a -> b) -> p a -> p b
forall a b. p (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p a
x)
instance (Semigroup d, Monoid d, Semigroup (p a), Monoid (p a)) => Monoid (Annotated d p a) where
mempty :: Annotated d p a
mempty = d -> p a -> Annotated d p a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated d
forall a. Monoid a => a
mempty p a
forall a. Monoid a => a
mempty
mappend :: Annotated d p a -> Annotated d p a -> Annotated d p a
mappend = Annotated d p a -> Annotated d p a -> Annotated d p a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Semigroup d, Semigroup (p a)) => Semigroup (Annotated d p a) where
Annotated d
d p a
p <> :: Annotated d p a -> Annotated d p a -> Annotated d p a
<> Annotated d
d' p a
p' =
d -> p a -> Annotated d p a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated (d
d d -> d -> d
forall a. Semigroup a => a -> a -> a
<> d
d') (p a
p p a -> p a -> p a
forall a. Semigroup a => a -> a -> a
<> p a
p')
type ArgParser = Annotated [String] SeqParser
data SeqParser a = SeqParser
{ forall a. SeqParser a -> Int
args :: Int,
forall a. SeqParser a -> [String] -> Either Error a
consume :: [String] -> Either Error a }
instance Functor SeqParser where
fmap :: forall a b. (a -> b) -> SeqParser a -> SeqParser b
fmap a -> b
f (SeqParser Int
a [String] -> Either Error a
c) = Int -> ([String] -> Either Error b) -> SeqParser b
forall a. Int -> ([String] -> Either Error a) -> SeqParser a
SeqParser Int
a ((a -> b) -> Either Error a -> Either Error b
forall a b. (a -> b) -> Either Error a -> Either Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either Error a -> Either Error b)
-> ([String] -> Either Error a) -> [String] -> Either Error b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Either Error a
c)
instance Applicative SeqParser where
pure :: forall a. a -> SeqParser a
pure = Int -> ([String] -> Either Error a) -> SeqParser a
forall a. Int -> ([String] -> Either Error a) -> SeqParser a
SeqParser Int
0 (([String] -> Either Error a) -> SeqParser a)
-> (a -> [String] -> Either Error a) -> a -> SeqParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Error a -> [String] -> Either Error a
forall a b. a -> b -> a
const (Either Error a -> [String] -> Either Error a)
-> (a -> Either Error a) -> a -> [String] -> Either Error a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either Error a
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
SeqParser Int
a [String] -> Either Error (a -> b)
c <*> :: forall a b. SeqParser (a -> b) -> SeqParser a -> SeqParser b
<*> SeqParser Int
a' [String] -> Either Error a
c' = Int -> ([String] -> Either Error b) -> SeqParser b
forall a. Int -> ([String] -> Either Error a) -> SeqParser a
SeqParser (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a') [String] -> Either Error b
f
where f :: [String] -> Either Error b
f [String]
xs = [String] -> Either Error (a -> b)
c [String]
xs Either Error (a -> b) -> Either Error a -> Either Error b
forall a b.
Either Error (a -> b) -> Either Error a -> Either Error b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Either Error a
c' (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
a [String]
xs)
arg :: String -> String -> (String -> Maybe a) -> ArgParser a
arg :: forall a. String -> String -> (String -> Maybe a) -> ArgParser a
arg String
desc String
err String -> Maybe a
f = [String] -> SeqParser a -> Annotated [String] SeqParser a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated [String
desc] (Int -> ([String] -> Either Error a) -> SeqParser a
forall a. Int -> ([String] -> Either Error a) -> SeqParser a
SeqParser Int
1 [String] -> Either Error a
c)
where c :: [String] -> Either Error a
c [] = Error -> Either Error a
forall a b. a -> Either a b
Left (String -> Error
Mistake String
err)
c (String
x:[String]
_) | String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = Error -> Either Error a
forall a b. a -> Either a b
Left (String -> Error
Mistake String
err)
c (String
x:[String]
_) =
case String -> Maybe a
f String
x of
Maybe a
Nothing -> Error -> Either Error a
forall a b. a -> Either a b
Left (String -> Error
Mistake String
err)
Just a
ok -> a -> Either Error a
forall a b. b -> Either a b
Right a
ok
argNum :: (Read a, Num a) => ArgParser a
argNum :: forall a. (Read a, Num a) => ArgParser a
argNum = String -> String -> (String -> Maybe a) -> ArgParser a
forall a. String -> String -> (String -> Maybe a) -> ArgParser a
arg String
"<num>" String
"expected a number" String -> Maybe a
forall {a}. Read a => String -> Maybe a
f
where f :: String -> Maybe a
f String
x =
case ReadS a
forall a. Read a => ReadS a
reads String
x of
[(a
y, String
"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
y
[(a, String)]
_ -> Maybe a
forall a. Maybe a
Nothing
argFile :: ArgParser FilePath
argFile :: ArgParser String
argFile = String -> String -> (String -> Maybe String) -> ArgParser String
forall a. String -> String -> (String -> Maybe a) -> ArgParser a
arg String
"<file>" String
"expected a file" String -> Maybe String
forall a. a -> Maybe a
Just
argFiles :: ArgParser [FilePath]
argFiles :: ArgParser [String]
argFiles = String
-> String -> (String -> Maybe [String]) -> ArgParser [String]
forall a. String -> String -> (String -> Maybe a) -> ArgParser a
arg String
"<files>" String
"expected a list of files" ((String -> Maybe [String]) -> ArgParser [String])
-> (String -> Maybe [String]) -> ArgParser [String]
forall a b. (a -> b) -> a -> b
$ \String
x ->
[String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
elts (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
","
where
elts :: String -> [String]
elts [] = []
elts String
s = String
wString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String -> [String]
elts String
r
where
w :: String
w = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') String
s
r :: String
r = String -> String
forall a. HasCallStack => [a] -> [a]
tail ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') String
s)
argName :: ArgParser String
argName :: ArgParser String
argName = String -> String -> (String -> Maybe String) -> ArgParser String
forall a. String -> String -> (String -> Maybe a) -> ArgParser a
arg String
"<name>" String
"expected a name" String -> Maybe String
forall a. a -> Maybe a
Just
argNums :: ArgParser [Int]
argNums :: ArgParser [Int]
argNums = String -> String -> (String -> Maybe [Int]) -> ArgParser [Int]
forall a. String -> String -> (String -> Maybe a) -> ArgParser a
arg String
"<nums>" String
"expected a number list" ((String -> Maybe [Int]) -> ArgParser [Int])
-> (String -> Maybe [Int]) -> ArgParser [Int]
forall a b. (a -> b) -> a -> b
$ \String
x ->
[String] -> Maybe [Int]
forall {a}. (Read a, Enum a) => [String] -> Maybe [a]
nums ([String] -> Maybe [Int])
-> (String -> [String]) -> String -> Maybe [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> String -> [String]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Char
x Char
y -> Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Bool
isDigit Char
y) (String -> Maybe [Int]) -> String -> Maybe [Int]
forall a b. (a -> b) -> a -> b
$ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
","
where
nums :: [String] -> Maybe [a]
nums [] = [a] -> Maybe [a]
forall a. a -> Maybe a
Just []
nums (String
n:String
",":[String]
ns) = (String -> a
forall a. Read a => String -> a
read String
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [String] -> Maybe [a]
nums [String]
ns
nums (String
n:String
"..":String
m:String
",":[String]
ns) = ([String -> a
forall a. Read a => String -> a
read String
n .. String -> a
forall a. Read a => String -> a
read String
m] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [String] -> Maybe [a]
nums [String]
ns
nums [String]
_ = Maybe [a]
forall a. Maybe a
Nothing
argOption :: [(String, a)] -> ArgParser a
argOption :: forall a. [(String, a)] -> ArgParser a
argOption [(String, a)]
as =
String
-> String
-> String
-> [String]
-> (String -> Maybe a)
-> ArgParser a
forall a.
String
-> String
-> String
-> [String]
-> (String -> Maybe a)
-> ArgParser a
argOptionWith String
"one" String
"or" String
"" (((String, a) -> String) -> [(String, a)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, a) -> String
forall a b. (a, b) -> a
fst [(String, a)]
as) (String -> [(String, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, a)]
as)
argList :: [String] -> ArgParser [String]
argList :: [String] -> ArgParser [String]
argList [String]
as =
String
-> String
-> String
-> [String]
-> (String -> Maybe [String])
-> ArgParser [String]
forall a.
String
-> String
-> String
-> [String]
-> (String -> Maybe a)
-> ArgParser a
argOptionWith String
"several" String
"and" String
"*" [String]
as ((String -> Maybe [String]) -> ArgParser [String])
-> (String -> Maybe [String]) -> ArgParser [String]
forall a b. (a -> b) -> a -> b
$ \String
x -> String -> Maybe [String]
elts (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",")
where
elts :: String -> Maybe [String]
elts [] = [String] -> Maybe [String]
forall a. a -> Maybe a
Just []
elts String
s | String
w String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
as = (String
wString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String]) -> Maybe [String] -> Maybe [String]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> Maybe [String]
elts String
r
where
w :: String
w = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') String
s
r :: String
r = String -> String
forall a. HasCallStack => [a] -> [a]
tail ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') String
s)
elts String
_ = Maybe [String]
forall a. Maybe a
Nothing
argOptionWith :: String -> String -> String -> [String] -> (String -> Maybe a) -> ArgParser a
argOptionWith :: forall a.
String
-> String
-> String
-> [String]
-> (String -> Maybe a)
-> ArgParser a
argOptionWith String
one String
or String
suff [String]
opts String -> Maybe a
p =
String -> String -> (String -> Maybe a) -> ArgParser a
forall a. String -> String -> (String -> Maybe a) -> ArgParser a
arg (String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" | " [String]
opts String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suff)
(String
"expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
one String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
list) String -> Maybe a
p
where
list :: String
list =
case [String]
opts of
[] -> String
"<empty list>"
[String]
_ ->
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
opts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
or String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
opts
argUsage :: ExitCode -> [String] -> ArgParser a
argUsage :: forall a. ExitCode -> [String] -> ArgParser a
argUsage ExitCode
code [String]
err = [String] -> SeqParser a -> Annotated [String] SeqParser a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated [] (Int -> ([String] -> Either Error a) -> SeqParser a
forall a. Int -> ([String] -> Either Error a) -> SeqParser a
SeqParser Int
0 (Either Error a -> [String] -> Either Error a
forall a b. a -> b -> a
const (Error -> Either Error a
forall a b. a -> Either a b
Left (ExitCode -> [String] -> Error
Usage ExitCode
code [String]
err))))
type OptionParser = Annotated [Flag] ParParser
data Flag = Flag
{ Flag -> String
flagName :: String,
Flag -> String
flagGroup :: String,
Flag -> FlagMode
flagMode :: FlagMode,
Flag -> [String]
flagHelp :: [String],
Flag -> String
flagArgs :: String } deriving (Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
/= :: Flag -> Flag -> Bool
Eq, Int -> Flag -> String -> String
[Flag] -> String -> String
Flag -> String
(Int -> Flag -> String -> String)
-> (Flag -> String) -> ([Flag] -> String -> String) -> Show Flag
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Flag -> String -> String
showsPrec :: Int -> Flag -> String -> String
$cshow :: Flag -> String
show :: Flag -> String
$cshowList :: [Flag] -> String -> String
showList :: [Flag] -> String -> String
Show)
data FlagMode = NormalMode | ExpertMode | HiddenMode deriving (FlagMode -> FlagMode -> Bool
(FlagMode -> FlagMode -> Bool)
-> (FlagMode -> FlagMode -> Bool) -> Eq FlagMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlagMode -> FlagMode -> Bool
== :: FlagMode -> FlagMode -> Bool
$c/= :: FlagMode -> FlagMode -> Bool
/= :: FlagMode -> FlagMode -> Bool
Eq, Int -> FlagMode -> String -> String
[FlagMode] -> String -> String
FlagMode -> String
(Int -> FlagMode -> String -> String)
-> (FlagMode -> String)
-> ([FlagMode] -> String -> String)
-> Show FlagMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> FlagMode -> String -> String
showsPrec :: Int -> FlagMode -> String -> String
$cshow :: FlagMode -> String
show :: FlagMode -> String
$cshowList :: [FlagMode] -> String -> String
showList :: [FlagMode] -> String -> String
Show)
flagExpert :: Flag -> Bool
flagExpert :: Flag -> Bool
flagExpert Flag
f = Flag -> FlagMode
flagMode Flag
f FlagMode -> FlagMode -> Bool
forall a. Eq a => a -> a -> Bool
== FlagMode
ExpertMode
data ParParser a = ParParser
{ forall a. ParParser a -> Either Error (IO a)
val :: Either Error (IO a),
forall a. ParParser a -> [String] -> ParseResult a
peek :: [String] -> ParseResult a }
data ParseResult a
= Yes Int (ParParser a)
| No (ParParser a)
| Error Error
data Error =
Mistake String
| Usage ExitCode [String]
instance Functor ParParser where
fmap :: forall a b. (a -> b) -> ParParser a -> ParParser b
fmap a -> b
f ParParser a
x = (a -> b) -> ParParser (a -> b)
forall a. a -> ParParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> b
f ParParser (a -> b) -> ParParser a -> ParParser b
forall a b. ParParser (a -> b) -> ParParser a -> ParParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParParser a
x
instance Applicative ParParser where
pure :: forall a. a -> ParParser a
pure a
x = Either Error (IO a) -> ([String] -> ParseResult a) -> ParParser a
forall a.
Either Error (IO a) -> ([String] -> ParseResult a) -> ParParser a
ParParser (IO a -> Either Error (IO a)
forall a b. b -> Either a b
Right (a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)) (ParseResult a -> [String] -> ParseResult a
forall a b. a -> b -> a
const (a -> ParseResult a
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x))
ParParser Either Error (IO (a -> b))
v [String] -> ParseResult (a -> b)
p <*> :: forall a b. ParParser (a -> b) -> ParParser a -> ParParser b
<*> ParParser Either Error (IO a)
v' [String] -> ParseResult a
p' =
Either Error (IO b) -> ([String] -> ParseResult b) -> ParParser b
forall a.
Either Error (IO a) -> ([String] -> ParseResult a) -> ParParser a
ParParser ((IO (a -> b) -> IO a -> IO b)
-> Either Error (IO (a -> b))
-> Either Error (IO a)
-> Either Error (IO b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 IO (a -> b) -> IO a -> IO b
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) Either Error (IO (a -> b))
v Either Error (IO a)
v') (\[String]
xs -> [String] -> ParseResult (a -> b)
p [String]
xs ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> ParseResult a
p' [String]
xs)
instance Functor ParseResult where
fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f ParseResult a
x = (a -> b) -> ParseResult (a -> b)
forall a. a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> b
f ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseResult a
x
instance Applicative ParseResult where
pure :: forall a. a -> ParseResult a
pure = ParParser a -> ParseResult a
forall a. ParParser a -> ParseResult a
No (ParParser a -> ParseResult a)
-> (a -> ParParser a) -> a -> ParseResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ParParser a
forall a. a -> ParParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Yes Int
n ParParser (a -> b)
r <*> :: forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
<*> Yes Int
n' ParParser a
r'
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n' = Int -> ParParser b -> ParseResult b
forall a. Int -> ParParser a -> ParseResult a
Yes Int
n (ParParser (a -> b)
r ParParser (a -> b) -> ParParser a -> ParParser b
forall a b. ParParser (a -> b) -> ParParser a -> ParParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParParser a
r')
| Bool
otherwise = String -> ParseResult b
forall a. HasCallStack => String -> a
error String
"Options.ParseResult: inconsistent number of arguments"
Error Error
s <*> ParseResult a
_ = Error -> ParseResult b
forall a. Error -> ParseResult a
Error Error
s
ParseResult (a -> b)
_ <*> Error Error
s = Error -> ParseResult b
forall a. Error -> ParseResult a
Error Error
s
Yes Int
n ParParser (a -> b)
r <*> No ParParser a
x = Int -> ParParser b -> ParseResult b
forall a. Int -> ParParser a -> ParseResult a
Yes Int
n (ParParser (a -> b)
r ParParser (a -> b) -> ParParser a -> ParParser b
forall a b. ParParser (a -> b) -> ParParser a -> ParParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParParser a
x)
No ParParser (a -> b)
x <*> Yes Int
n ParParser a
r = Int -> ParParser b -> ParseResult b
forall a. Int -> ParParser a -> ParseResult a
Yes Int
n (ParParser (a -> b)
x ParParser (a -> b) -> ParParser a -> ParParser b
forall a b. ParParser (a -> b) -> ParParser a -> ParParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParParser a
r)
No ParParser (a -> b)
f <*> No ParParser a
x = ParParser b -> ParseResult b
forall a. ParParser a -> ParseResult a
No (ParParser (a -> b)
f ParParser (a -> b) -> ParParser a -> ParParser b
forall a b. ParParser (a -> b) -> ParParser a -> ParParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParParser a
x)
runPar :: ParParser a -> [String] -> Either Error (IO a)
runPar :: forall a. ParParser a -> [String] -> Either Error (IO a)
runPar ParParser a
p [] = ParParser a -> Either Error (IO a)
forall a. ParParser a -> Either Error (IO a)
val ParParser a
p
runPar ParParser a
p xs :: [String]
xs@(String
x:[String]
_) =
case ParParser a -> [String] -> ParseResult a
forall a. ParParser a -> [String] -> ParseResult a
peek ParParser a
p [String]
xs of
Yes Int
n ParParser a
p' -> ParParser a -> [String] -> Either Error (IO a)
forall a. ParParser a -> [String] -> Either Error (IO a)
runPar ParParser a
p' (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
n [String]
xs)
No ParParser a
_ -> Error -> Either Error (IO a)
forall a b. a -> Either a b
Left (String -> Error
Mistake (String
"Didn't recognise option " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x))
Error Error
err -> Error -> Either Error (IO a)
forall a b. a -> Either a b
Left Error
err
await :: (String -> Bool) -> Either Error a -> (String -> [String] -> ParseResult a) -> ParParser a
await :: forall a.
(String -> Bool)
-> Either Error a
-> (String -> [String] -> ParseResult a)
-> ParParser a
await String -> Bool
p Either Error a
def String -> [String] -> ParseResult a
par = Either Error (IO a) -> ([String] -> ParseResult a) -> ParParser a
forall a.
Either Error (IO a) -> ([String] -> ParseResult a) -> ParParser a
ParParser (a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> Either Error a -> Either Error (IO a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Error a
def) [String] -> ParseResult a
f
where f :: [String] -> ParseResult a
f (String
x:[String]
xs) | String -> Bool
p String
x =
case String -> [String] -> ParseResult a
par String
x [String]
xs of
Yes Int
n ParParser a
r -> Int -> ParParser a -> ParseResult a
forall a. Int -> ParParser a -> ParseResult a
Yes (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ParParser a
r
No ParParser a
_ ->
String -> ParseResult a
forall a. HasCallStack => String -> a
error String
"Options.await: got No"
Error Error
err -> Error -> ParseResult a
forall a. Error -> ParseResult a
Error Error
err
f [String]
_ = ParParser a -> ParseResult a
forall a. ParParser a -> ParseResult a
No ((String -> Bool)
-> Either Error a
-> (String -> [String] -> ParseResult a)
-> ParParser a
forall a.
(String -> Bool)
-> Either Error a
-> (String -> [String] -> ParseResult a)
-> ParParser a
await String -> Bool
p Either Error a
def String -> [String] -> ParseResult a
par)
primFlag ::
String -> [String] ->
(String -> Bool) ->
(a -> a -> Either Error a) ->
a -> ArgParser (String -> a) -> OptionParser a
primFlag :: forall a.
String
-> [String]
-> (String -> Bool)
-> (a -> a -> Either Error a)
-> a
-> ArgParser (String -> a)
-> OptionParser a
primFlag String
name [String]
help String -> Bool
p a -> a -> Either Error a
combine a
def (Annotated [String]
desc (SeqParser Int
args [String] -> Either Error (String -> a)
f)) =
[Flag] -> ParParser a -> Annotated [Flag] ParParser a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated [Flag
desc'] ((String -> Bool)
-> Either Error a
-> (String -> [String] -> ParseResult a)
-> ParParser a
forall a.
(String -> Bool)
-> Either Error a
-> (String -> [String] -> ParseResult a)
-> ParParser a
await String -> Bool
p (a -> Either Error a
forall a b. b -> Either a b
Right a
def) ((a -> Either Error a) -> String -> [String] -> ParseResult a
g a -> Either Error a
forall a b. b -> Either a b
Right))
where desc' :: Flag
desc' = String -> String -> FlagMode -> [String] -> String -> Flag
Flag String
name String
"General options" FlagMode
NormalMode [String]
help ([String] -> String
unwords [String]
desc)
g :: (a -> Either Error a) -> String -> [String] -> ParseResult a
g a -> Either Error a
comb String
x [String]
xs =
case [String] -> Either Error (String -> a)
f [String]
xs Either Error (String -> a)
-> ((String -> a) -> Either Error a) -> Either Error a
forall a b.
Either Error a -> (a -> Either Error b) -> Either Error b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Either Error a
comb (a -> Either Error a)
-> ((String -> a) -> a) -> (String -> a) -> Either Error a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
x) of
Left (Mistake String
err) -> Error -> ParseResult a
forall a. Error -> ParseResult a
Error (String -> Error
Mistake (String
"Error in option --" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err))
Left (Usage ExitCode
code [String]
err) -> Error -> ParseResult a
forall a. Error -> ParseResult a
Error (ExitCode -> [String] -> Error
Usage ExitCode
code [String]
err)
Right a
y ->
Int -> ParParser a -> ParseResult a
forall a. Int -> ParParser a -> ParseResult a
Yes Int
args ((String -> Bool)
-> Either Error a
-> (String -> [String] -> ParseResult a)
-> ParParser a
forall a.
(String -> Bool)
-> Either Error a
-> (String -> [String] -> ParseResult a)
-> ParParser a
await String -> Bool
p (a -> Either Error a
forall a b. b -> Either a b
Right a
y) ((a -> Either Error a) -> String -> [String] -> ParseResult a
g (a -> a -> Either Error a
combine a
y)))
flag :: String -> [String] -> a -> ArgParser a -> OptionParser a
flag :: forall a. String -> [String] -> a -> ArgParser a -> OptionParser a
flag String
name [String]
help a
def ArgParser a
p =
String
-> [String]
-> (String -> Bool)
-> (a -> a -> Either Error a)
-> a
-> ArgParser (String -> a)
-> OptionParser a
forall a.
String
-> [String]
-> (String -> Bool)
-> (a -> a -> Either Error a)
-> a
-> ArgParser (String -> a)
-> OptionParser a
primFlag String
name [String]
help
(\String
x -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
(\a
_ a
y -> a -> Either Error a
forall a. a -> Either Error a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y)
a
def (a -> String -> a
forall a b. a -> b -> a
const (a -> String -> a) -> ArgParser a -> ArgParser (String -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArgParser a
p)
manyFlags :: String -> [String] -> ArgParser a -> OptionParser [a]
manyFlags :: forall a. String -> [String] -> ArgParser a -> OptionParser [a]
manyFlags String
name [String]
help ArgParser a
p =
String
-> [String]
-> (String -> Bool)
-> ([a] -> [a] -> Either Error [a])
-> [a]
-> ArgParser (String -> [a])
-> OptionParser [a]
forall a.
String
-> [String]
-> (String -> Bool)
-> (a -> a -> Either Error a)
-> a
-> ArgParser (String -> a)
-> OptionParser a
primFlag String
name [String]
help
(\String
x -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
(\[a]
x [a]
y -> [a] -> Either Error [a]
forall a. a -> Either Error a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y))
[] ([a] -> String -> [a]
forall a b. a -> b -> a
const ([a] -> String -> [a]) -> (a -> [a]) -> a -> String -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> String -> [a]) -> ArgParser a -> ArgParser (String -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArgParser a
p)
bool :: String -> [String] -> Bool -> OptionParser Bool
bool :: String -> [String] -> Bool -> OptionParser Bool
bool String
name [String]
help Bool
def =
String
-> [String]
-> (String -> Bool)
-> (Bool -> Bool -> Either Error Bool)
-> Bool
-> ArgParser (String -> Bool)
-> OptionParser Bool
forall a.
String
-> [String]
-> (String -> Bool)
-> (a -> a -> Either Error a)
-> a
-> ArgParser (String -> a)
-> OptionParser a
primFlag (String
"(no-)" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name) [String]
help
(\String
x -> String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name, String
"--no-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name])
(\Bool
_ Bool
y -> Bool -> Either Error Bool
forall a. a -> Either Error a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
y)
Bool
def
((String -> Bool) -> ArgParser (String -> Bool)
forall a. a -> Annotated [String] SeqParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\String
name' -> if String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name' then Bool
True else Bool
False))
filenames :: OptionParser [String]
filenames :: OptionParser [String]
filenames = [Flag] -> ParParser [String] -> OptionParser [String]
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated [] ((String -> Bool)
-> Either Error [String]
-> (String -> [String] -> ParseResult [String])
-> ParParser [String]
forall a.
(String -> Bool)
-> Either Error a
-> (String -> [String] -> ParseResult a)
-> ParParser a
await String -> Bool
p (Error -> Either Error [String]
forall a b. a -> Either a b
Left Error
err) ([String] -> String -> [String] -> ParseResult [String]
f []))
where p :: String -> Bool
p String
x = Bool -> Bool
not (String
"-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x) Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-"
f :: [String] -> String -> [String] -> ParseResult [String]
f [String]
xs String
y [String]
_ = Int -> ParParser [String] -> ParseResult [String]
forall a. Int -> ParParser a -> ParseResult a
Yes Int
0 (let ys :: [String]
ys = [String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
y] in (String -> Bool)
-> Either Error [String]
-> (String -> [String] -> ParseResult [String])
-> ParParser [String]
forall a.
(String -> Bool)
-> Either Error a
-> (String -> [String] -> ParseResult a)
-> ParParser a
await String -> Bool
p ([String] -> Either Error [String]
forall a b. b -> Either a b
Right [String]
ys) ([String] -> String -> [String] -> ParseResult [String]
f [String]
ys))
err :: Error
err =
ExitCode -> [String] -> Error
Usage (Int -> ExitCode
ExitFailure Int
1)
[String
"No input files specified! Try --help.",
String
"You can use \"-\" to read from standard input."]
io :: IO a -> OptionParser a
io :: forall a. IO a -> OptionParser a
io IO a
m = [Flag] -> ParParser a -> Annotated [Flag] ParParser a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated [] ParParser a
p
where p :: ParParser a
p = Either Error (IO a) -> ([String] -> ParseResult a) -> ParParser a
forall a.
Either Error (IO a) -> ([String] -> ParseResult a) -> ParParser a
ParParser (IO a -> Either Error (IO a)
forall a b. b -> Either a b
Right IO a
m) (ParseResult a -> [String] -> ParseResult a
forall a b. a -> b -> a
const (ParParser a -> ParseResult a
forall a. ParParser a -> ParseResult a
No ParParser a
p))
inGroup :: String -> OptionParser a -> OptionParser a
inGroup :: forall a. String -> OptionParser a -> OptionParser a
inGroup String
x (Annotated [Flag]
fls ParParser a
f) = [Flag] -> ParParser a -> Annotated [Flag] ParParser a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated [Flag
fl{ flagGroup = x } | Flag
fl <- [Flag]
fls] ParParser a
f
expert :: OptionParser a -> OptionParser a
expert :: forall a. OptionParser a -> OptionParser a
expert (Annotated [Flag]
fls ParParser a
f) = [Flag] -> ParParser a -> Annotated [Flag] ParParser a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated [Flag
fl{ flagMode = ExpertMode } | Flag
fl <- [Flag]
fls] ParParser a
f
hidden :: OptionParser a -> OptionParser a
hidden :: forall a. OptionParser a -> OptionParser a
hidden (Annotated [Flag]
fls ParParser a
f) = [Flag] -> ParParser a -> Annotated [Flag] ParParser a
forall d (p :: * -> *) a. d -> p a -> Annotated d p a
Annotated [Flag
fl{ flagMode = HiddenMode } | Flag
fl <- [Flag]
fls] ParParser a
f
version :: String -> OptionParser a -> OptionParser a
version :: forall a. String -> OptionParser a -> OptionParser a
version String
x OptionParser a
p =
OptionParser a
p OptionParser a -> Annotated [Flag] ParParser () -> OptionParser a
forall a b.
Annotated [Flag] ParParser a
-> Annotated [Flag] ParParser b -> Annotated [Flag] ParParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
String
-> Annotated [Flag] ParParser () -> Annotated [Flag] ParParser ()
forall a. String -> OptionParser a -> OptionParser a
inGroup String
"Miscellaneous options"
(String
-> [String] -> () -> ArgParser () -> Annotated [Flag] ParParser ()
forall a. String -> [String] -> a -> ArgParser a -> OptionParser a
flag String
"version" [String
"Show the version number."] ()
(ExitCode -> [String] -> ArgParser ()
forall a. ExitCode -> [String] -> ArgParser a
argUsage ExitCode
ExitSuccess [String
x]))
printHelp :: ExitCode -> [String] -> IO a
printHelp :: forall a. ExitCode -> [String] -> IO a
printHelp ExitCode
code [String]
xs = do
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
stderr) [String]
xs
ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith ExitCode
code
printError :: String -> String -> IO a
printError :: forall a. String -> String -> IO a
printError String
name String
err =
ExitCode -> [String] -> IO a
forall a. ExitCode -> [String] -> IO a
printHelp (Int -> ExitCode
ExitFailure Int
1) ([String] -> IO a) -> [String] -> IO a
forall a b. (a -> b) -> a -> b
$
[String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".", String
"Try " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --help."]
help :: String -> String -> OptionParser a -> OptionParser a
help :: forall a. String -> String -> OptionParser a -> OptionParser a
help String
name String
description OptionParser a
p = OptionParser a
p'
where
p' :: OptionParser a
p' =
OptionParser a
p OptionParser a -> Annotated [Flag] ParParser () -> OptionParser a
forall a b.
Annotated [Flag] ParParser a
-> Annotated [Flag] ParParser b -> Annotated [Flag] ParParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
(String
-> Annotated [Flag] ParParser () -> Annotated [Flag] ParParser ()
forall a. String -> OptionParser a -> OptionParser a
inGroup String
"Miscellaneous options" (Annotated [Flag] ParParser () -> Annotated [Flag] ParParser ())
-> Annotated [Flag] ParParser () -> Annotated [Flag] ParParser ()
forall a b. (a -> b) -> a -> b
$
String
-> [String] -> () -> ArgParser () -> Annotated [Flag] ParParser ()
forall a. String -> [String] -> a -> ArgParser a -> OptionParser a
flag String
"help" [String
"Show help text."] ()
(ExitCode -> [String] -> ArgParser ()
forall a. ExitCode -> [String] -> ArgParser a
argUsage ExitCode
ExitSuccess (Bool -> String -> String -> OptionParser a -> [String]
forall a. Bool -> String -> String -> OptionParser a -> [String]
helpText Bool
False String
name String
description OptionParser a
p')))
OptionParser a -> Annotated [Flag] ParParser () -> OptionParser a
forall a b.
Annotated [Flag] ParParser a
-> Annotated [Flag] ParParser b -> Annotated [Flag] ParParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
(if (Flag -> Bool) -> [Flag] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Flag -> Bool
flagExpert (OptionParser a -> [Flag]
forall d (p :: * -> *) a. Annotated d p a -> d
descr OptionParser a
p) then
(String
-> Annotated [Flag] ParParser () -> Annotated [Flag] ParParser ()
forall a. String -> OptionParser a -> OptionParser a
inGroup String
"Miscellaneous options" (Annotated [Flag] ParParser () -> Annotated [Flag] ParParser ())
-> Annotated [Flag] ParParser () -> Annotated [Flag] ParParser ()
forall a b. (a -> b) -> a -> b
$
String
-> [String] -> () -> ArgParser () -> Annotated [Flag] ParParser ()
forall a. String -> [String] -> a -> ArgParser a -> OptionParser a
flag String
"expert-help" [String
"Show help text for hidden options."] ()
(ExitCode -> [String] -> ArgParser ()
forall a. ExitCode -> [String] -> ArgParser a
argUsage ExitCode
ExitSuccess (Bool -> String -> String -> OptionParser a -> [String]
forall a. Bool -> String -> String -> OptionParser a -> [String]
helpText Bool
True String
name String
description OptionParser a
p')))
else () -> Annotated [Flag] ParParser ()
forall a. a -> Annotated [Flag] ParParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
usageText :: String -> String -> [String]
usageText :: String -> String -> [String]
usageText String
name String
descr =
[String
descr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".",
String
"Usage: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" <option>* <file>*, where <file> is in TPTP format."]
helpText :: Bool -> String -> String -> OptionParser a -> [String]
helpText :: forall a. Bool -> String -> String -> OptionParser a -> [String]
helpText Bool
expert String
name String
description OptionParser a
p =
[String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [String
""] ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$
[String -> String -> [String]
usageText String
name String
description] [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++
[[Flag -> String
flagGroup Flag
f0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String -> [String] -> [String]
justify (String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Flag -> String
flagName Flag
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Flag -> String
flagArgs Flag
f) (Flag -> [String]
flagHelp Flag
f) | Flag
f <- [Flag]
fs]
| fs :: [Flag]
fs@(Flag
f0:[Flag]
_) <- [Flag] -> [[Flag]]
groups ((Flag -> Bool) -> [Flag] -> [Flag]
forall a. (a -> Bool) -> [a] -> [a]
filter Flag -> Bool
ok ([Flag] -> [Flag]
forall a. Eq a => [a] -> [a]
nub (OptionParser a -> [Flag]
forall d (p :: * -> *) a. Annotated d p a -> d
descr OptionParser a
p))) ] [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++
[ [String
"To see hidden options too, try --expert-help."]
| (Flag -> Bool) -> [Flag] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Flag -> Bool
flagExpert (OptionParser a -> [Flag]
forall d (p :: * -> *) a. Annotated d p a -> d
descr OptionParser a
p), Bool -> Bool
not Bool
expert ]
where
groups :: [Flag] -> [[Flag]]
groups [] = []
groups (Flag
f:[Flag]
fs) =
(Flag
fFlag -> [Flag] -> [Flag]
forall a. a -> [a] -> [a]
:[Flag
f' | Flag
f' <- [Flag]
fs, Flag -> String
flagGroup Flag
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Flag -> String
flagGroup Flag
f'])[Flag] -> [[Flag]] -> [[Flag]]
forall a. a -> [a] -> [a]
:
[Flag] -> [[Flag]]
groups [Flag
f' | Flag
f' <- [Flag]
fs, Flag -> String
flagGroup Flag
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= Flag -> String
flagGroup Flag
f']
ok :: Flag -> Bool
ok Flag
flag =
case Flag -> FlagMode
flagMode Flag
flag of
FlagMode
NormalMode -> Bool
True
FlagMode
ExpertMode -> Bool
expert
FlagMode
HiddenMode -> Bool
False
justify :: String -> [String] -> [String]
justify :: String -> [String] -> [String]
justify String
name [String]
help = [String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
help
parseCommandLine :: String -> OptionParser a -> IO a
parseCommandLine :: forall a. String -> OptionParser a -> IO a
parseCommandLine String
description OptionParser a
p =
[String] -> String -> OptionParser a -> IO a
forall a. [String] -> String -> OptionParser a -> IO a
parseCommandLineWithExtraArgs [] String
description OptionParser a
p
parseCommandLineWithExtraArgs :: [String] -> String -> OptionParser a -> IO a
parseCommandLineWithExtraArgs :: forall a. [String] -> String -> OptionParser a -> IO a
parseCommandLineWithExtraArgs [String]
args0 String
description OptionParser a
p = do
String
name <- IO String
getProgName
[String]
args <- IO [String]
getArgs
String -> [String] -> String -> OptionParser a -> IO a
forall a. String -> [String] -> String -> OptionParser a -> IO a
parseCommandLineWithArgs String
name ([String]
args0 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args) String
description OptionParser a
p
parseCommandLineWithArgs :: String -> [String] -> String -> OptionParser a -> IO a
parseCommandLineWithArgs :: forall a. String -> [String] -> String -> OptionParser a -> IO a
parseCommandLineWithArgs String
name [String]
args String
description OptionParser a
p = do
case ParParser a -> [String] -> Either Error (IO a)
forall a. ParParser a -> [String] -> Either Error (IO a)
runPar (OptionParser a -> ParParser a
forall d (p :: * -> *) a. Annotated d p a -> p a
parser (String -> String -> OptionParser a -> OptionParser a
forall a. String -> String -> OptionParser a -> OptionParser a
help String
name String
description OptionParser a
p)) [String]
args of
Left (Mistake String
err) -> String -> String -> IO a
forall a. String -> String -> IO a
printError String
name String
err
Left (Usage ExitCode
code [String]
err) -> ExitCode -> [String] -> IO a
forall a. ExitCode -> [String] -> IO a
printHelp ExitCode
code [String]
err
Right IO a
x -> IO a
x