module Distribution.GetOpt (
getOpt, getOpt',
usageInfo,
ArgOrder(..),
OptDescr(..),
ArgDescr(..),
) where
import Prelude ()
import Distribution.Compat.Prelude
import System.Console.GetOpt
( ArgOrder(..), OptDescr(..), ArgDescr(..) )
data OptKind a
= Opt a
| UnreqOpt String
| NonOpt String
| EndOfOpts
| OptErr String
usageInfo :: String
-> [OptDescr a]
-> String
usageInfo :: String -> [OptDescr a] -> String
usageInfo String
header [OptDescr a]
optDescr = [String] -> String
unlines (String
headerString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
table)
where ([String]
ss,[String]
ls,[String]
ds) = [(String, String, String)] -> ([String], [String], [String])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ArgDescr a -> Char -> String
forall a. ArgDescr a -> Char -> String
fmtShort ArgDescr a
ad) String
sos)
,(String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ArgDescr a -> String -> String
forall a. ArgDescr a -> String -> String
fmtLong ArgDescr a
ad) (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 [String]
los)
,String
d)
| Option String
sos [String]
los ArgDescr a
ad String
d <- [OptDescr a]
optDescr ]
ssWidth :: Int
ssWidth = ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [String]
ss
lsWidth :: Int
lsWidth = ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [String]
ls
dsWidth :: Int
dsWidth = Int
30 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` (Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
ssWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lsWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
table :: [String]
table = [ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
padTo Int
ssWidth String
so' String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
padTo Int
lsWidth String
lo' String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d'
| (String
so,String
lo,String
d) <- [String] -> [String] -> [String] -> [(String, String, String)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [String]
ss [String]
ls [String]
ds
, (String
so',String
lo',String
d') <- Int -> String -> String -> String -> [(String, String, String)]
fmtOpt Int
dsWidth String
so String
lo String
d ]
padTo :: Int -> String -> String
padTo Int
n String
x = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat Char
' ')
fmtOpt :: Int -> String -> String -> String -> [(String, String, String)]
fmtOpt :: Int -> String -> String -> String -> [(String, String, String)]
fmtOpt Int
descrWidth String
so String
lo String
descr =
case Int -> String -> [String]
wrapText Int
descrWidth String
descr of
[] -> [(String
so,String
lo,String
"")]
(String
d:[String]
ds) -> (String
so,String
lo,String
d) (String, String, String)
-> [(String, String, String)] -> [(String, String, String)]
forall a. a -> [a] -> [a]
: [ (String
"",String
"",String
d') | String
d' <- [String]
ds ]
fmtShort :: ArgDescr a -> Char -> String
fmtShort :: ArgDescr a -> Char -> String
fmtShort (NoArg a
_ ) Char
so = String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
so]
fmtShort (ReqArg String -> a
_ String
_) Char
so = String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
so]
fmtShort (OptArg Maybe String -> a
_ String
_) Char
so = String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
so]
fmtLong :: ArgDescr a -> String -> String
fmtLong :: ArgDescr a -> String -> String
fmtLong (NoArg a
_ ) String
lo = String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lo
fmtLong (ReqArg String -> a
_ String
ad) String
lo = String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ad
fmtLong (OptArg Maybe String -> a
_ String
ad) String
lo = String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ad String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
wrapText :: Int -> String -> [String]
wrapText :: Int -> String -> [String]
wrapText Int
width = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String] -> [[String]]
wrap Int
0 [] ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
where wrap :: Int -> [String] -> [String] -> [[String]]
wrap :: Int -> [String] -> [String] -> [[String]]
wrap Int
0 [] (String
w:[String]
ws)
| String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
= Int -> [String] -> [String] -> [[String]]
wrap (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w) [String
w] [String]
ws
wrap Int
col [String]
line (String
w:[String]
ws)
| Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width
= [String] -> [String]
forall a. [a] -> [a]
reverse [String]
line [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: Int -> [String] -> [String] -> [[String]]
wrap Int
0 [] (String
wString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ws)
wrap Int
col [String]
line (String
w:[String]
ws)
= let col' :: Int
col' = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Int -> [String] -> [String] -> [[String]]
wrap Int
col' (String
wString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
line) [String]
ws
wrap Int
_ [] [] = []
wrap Int
_ [String]
line [] = [[String] -> [String]
forall a. [a] -> [a]
reverse [String]
line]
getOpt :: ArgOrder a
-> [OptDescr a]
-> [String]
-> ([a],[String],[String])
getOpt :: ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder a
ordering [OptDescr a]
optDescr [String]
args = ([a]
os,[String]
xs,[String]
es [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
errUnrec [String]
us)
where ([a]
os,[String]
xs,[String]
us,[String]
es) = ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder a
ordering [OptDescr a]
optDescr [String]
args
getOpt' :: ArgOrder a
-> [OptDescr a]
-> [String]
-> ([a],[String], [String] ,[String])
getOpt' :: ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder a
_ [OptDescr a]
_ [] = ([],[],[],[])
getOpt' ArgOrder a
ordering [OptDescr a]
optDescr (String
arg:[String]
args) = OptKind a -> ArgOrder a -> ([a], [String], [String], [String])
procNextOpt OptKind a
opt ArgOrder a
ordering
where procNextOpt :: OptKind a -> ArgOrder a -> ([a], [String], [String], [String])
procNextOpt (Opt a
o) ArgOrder a
_ = (a
oa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
os,[String]
xs,[String]
us,[String]
es)
procNextOpt (UnreqOpt String
u) ArgOrder a
_ = ([a]
os,[String]
xs,String
uString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
us,[String]
es)
procNextOpt (NonOpt String
x) ArgOrder a
RequireOrder = ([],String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
rest,[],[])
procNextOpt (NonOpt String
x) ArgOrder a
Permute = ([a]
os,String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs,[String]
us,[String]
es)
procNextOpt (NonOpt String
x) (ReturnInOrder String -> a
f) = (String -> a
f String
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
os, [String]
xs,[String]
us,[String]
es)
procNextOpt OptKind a
EndOfOpts ArgOrder a
RequireOrder = ([],[String]
rest,[],[])
procNextOpt OptKind a
EndOfOpts ArgOrder a
Permute = ([],[String]
rest,[],[])
procNextOpt OptKind a
EndOfOpts (ReturnInOrder String -> a
f) = ((String -> a) -> [String] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map String -> a
f [String]
rest,[],[],[])
procNextOpt (OptErr String
e) ArgOrder a
_ = ([a]
os,[String]
xs,[String]
us,String
eString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
es)
(OptKind a
opt,[String]
rest) = String -> [String] -> [OptDescr a] -> (OptKind a, [String])
forall a.
String -> [String] -> [OptDescr a] -> (OptKind a, [String])
getNext String
arg [String]
args [OptDescr a]
optDescr
([a]
os,[String]
xs,[String]
us,[String]
es) = ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder a
ordering [OptDescr a]
optDescr [String]
rest
getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
getNext :: String -> [String] -> [OptDescr a] -> (OptKind a, [String])
getNext (Char
'-':Char
'-':[]) [String]
rest [OptDescr a]
_ = (OptKind a
forall a. OptKind a
EndOfOpts,[String]
rest)
getNext (Char
'-':Char
'-':String
xs) [String]
rest [OptDescr a]
optDescr = String -> [String] -> [OptDescr a] -> (OptKind a, [String])
forall a.
String -> [String] -> [OptDescr a] -> (OptKind a, [String])
longOpt String
xs [String]
rest [OptDescr a]
optDescr
getNext (Char
'-': Char
x :String
xs) [String]
rest [OptDescr a]
optDescr = Char -> String -> [String] -> [OptDescr a] -> (OptKind a, [String])
forall a.
Char -> String -> [String] -> [OptDescr a] -> (OptKind a, [String])
shortOpt Char
x String
xs [String]
rest [OptDescr a]
optDescr
getNext String
a [String]
rest [OptDescr a]
_ = (String -> OptKind a
forall a. String -> OptKind a
NonOpt String
a,[String]
rest)
longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a, [String])
longOpt String
ls [String]
rs [OptDescr a]
optDescr = [ArgDescr a] -> String -> [String] -> (OptKind a, [String])
long [ArgDescr a]
ads String
arg [String]
rs
where (String
opt,String
arg) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'=') String
ls
getWith :: (String -> String -> Bool) -> [OptDescr a]
getWith String -> String -> Bool
p = [ OptDescr a
o | o :: OptDescr a
o@(Option String
_ [String]
xs ArgDescr a
_ String
_) <- [OptDescr a]
optDescr
, Maybe String -> Bool
forall a. Maybe a -> Bool
isJust ((String -> Bool) -> [String] -> Maybe String
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> String -> Bool
p String
opt) [String]
xs)]
exact :: [OptDescr a]
exact = (String -> String -> Bool) -> [OptDescr a]
getWith String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==)
options :: [OptDescr a]
options = if [OptDescr a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptDescr a]
exact then (String -> String -> Bool) -> [OptDescr a]
getWith String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf else [OptDescr a]
exact
ads :: [ArgDescr a]
ads = [ ArgDescr a
ad | Option String
_ [String]
_ ArgDescr a
ad String
_ <- [OptDescr a]
options ]
optStr :: String
optStr = String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt
long :: [ArgDescr a] -> String -> [String] -> (OptKind a, [String])
long (ArgDescr a
_:ArgDescr a
_:[ArgDescr a]
_) String
_ [String]
rest = ([OptDescr a] -> String -> OptKind a
forall a. [OptDescr a] -> String -> OptKind a
errAmbig [OptDescr a]
options String
optStr,[String]
rest)
long [NoArg a
a ] [] [String]
rest = (a -> OptKind a
forall a. a -> OptKind a
Opt a
a,[String]
rest)
long [NoArg a
_ ] (Char
'=':String
_) [String]
rest = (String -> OptKind a
forall a. String -> OptKind a
errNoArg String
optStr,[String]
rest)
long [ReqArg String -> a
_ String
d] [] [] = (String -> String -> OptKind a
forall a. String -> String -> OptKind a
errReq String
d String
optStr,[])
long [ReqArg String -> a
f String
_] [] (String
r:[String]
rest) = (a -> OptKind a
forall a. a -> OptKind a
Opt (String -> a
f String
r),[String]
rest)
long [ReqArg String -> a
f String
_] (Char
'=':String
xs) [String]
rest = (a -> OptKind a
forall a. a -> OptKind a
Opt (String -> a
f String
xs),[String]
rest)
long [OptArg Maybe String -> a
f String
_] [] [String]
rest = (a -> OptKind a
forall a. a -> OptKind a
Opt (Maybe String -> a
f Maybe String
forall a. Maybe a
Nothing),[String]
rest)
long [OptArg Maybe String -> a
f String
_] (Char
'=':String
xs) [String]
rest = (a -> OptKind a
forall a. a -> OptKind a
Opt (Maybe String -> a
f (String -> Maybe String
forall a. a -> Maybe a
Just String
xs)),[String]
rest)
long [ArgDescr a]
_ String
_ [String]
rest = (String -> OptKind a
forall a. String -> OptKind a
UnreqOpt (String
"--"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
ls),[String]
rest)
shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String])
shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a, [String])
shortOpt Char
y String
ys [String]
rs [OptDescr a]
optDescr = [ArgDescr a] -> String -> [String] -> (OptKind a, [String])
short [ArgDescr a]
ads String
ys [String]
rs
where options :: [OptDescr a]
options = [ OptDescr a
o | o :: OptDescr a
o@(Option String
ss [String]
_ ArgDescr a
_ String
_) <- [OptDescr a]
optDescr, Char
s <- String
ss, Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
s ]
ads :: [ArgDescr a]
ads = [ ArgDescr a
ad | Option String
_ [String]
_ ArgDescr a
ad String
_ <- [OptDescr a]
options ]
optStr :: String
optStr = Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:[Char
y]
short :: [ArgDescr a] -> String -> [String] -> (OptKind a, [String])
short (ArgDescr a
_:ArgDescr a
_:[ArgDescr a]
_) String
_ [String]
rest = ([OptDescr a] -> String -> OptKind a
forall a. [OptDescr a] -> String -> OptKind a
errAmbig [OptDescr a]
options String
optStr,[String]
rest)
short (NoArg a
a :[ArgDescr a]
_) [] [String]
rest = (a -> OptKind a
forall a. a -> OptKind a
Opt a
a,[String]
rest)
short (NoArg a
a :[ArgDescr a]
_) String
xs [String]
rest = (a -> OptKind a
forall a. a -> OptKind a
Opt a
a,(Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
rest)
short (ReqArg String -> a
_ String
d:[ArgDescr a]
_) [] [] = (String -> String -> OptKind a
forall a. String -> String -> OptKind a
errReq String
d String
optStr,[])
short (ReqArg String -> a
f String
_:[ArgDescr a]
_) [] (String
r:[String]
rest) = (a -> OptKind a
forall a. a -> OptKind a
Opt (String -> a
f String
r),[String]
rest)
short (ReqArg String -> a
f String
_:[ArgDescr a]
_) String
xs [String]
rest = (a -> OptKind a
forall a. a -> OptKind a
Opt (String -> a
f String
xs),[String]
rest)
short (OptArg Maybe String -> a
f String
_:[ArgDescr a]
_) [] [String]
rest = (a -> OptKind a
forall a. a -> OptKind a
Opt (Maybe String -> a
f Maybe String
forall a. Maybe a
Nothing),[String]
rest)
short (OptArg Maybe String -> a
f String
_:[ArgDescr a]
_) String
xs [String]
rest = (a -> OptKind a
forall a. a -> OptKind a
Opt (Maybe String -> a
f (String -> Maybe String
forall a. a -> Maybe a
Just String
xs)),[String]
rest)
short [] [] [String]
rest = (String -> OptKind a
forall a. String -> OptKind a
UnreqOpt String
optStr,[String]
rest)
short [] String
xs [String]
rest = (String -> OptKind a
forall a. String -> OptKind a
UnreqOpt (String
optStrString -> String -> String
forall a. [a] -> [a] -> [a]
++String
xs),[String]
rest)
errAmbig :: [OptDescr a] -> String -> OptKind a
errAmbig :: [OptDescr a] -> String -> OptKind a
errAmbig [OptDescr a]
ods String
optStr = String -> OptKind a
forall a. String -> OptKind a
OptErr (String -> [OptDescr a] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
header [OptDescr a]
ods)
where header :: String
header = String
"option `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is ambiguous; could be one of:"
errReq :: String -> String -> OptKind a
errReq :: String -> String -> OptKind a
errReq String
d String
optStr = String -> OptKind a
forall a. String -> OptKind a
OptErr (String
"option `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' requires an argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")
errUnrec :: String -> String
errUnrec :: String -> String
errUnrec String
optStr = String
"unrecognized option `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'\n"
errNoArg :: String -> OptKind a
errNoArg :: String -> OptKind a
errNoArg String
optStr = String -> OptKind a
forall a. String -> OptKind a
OptErr (String
"option `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' doesn't allow an argument\n")