module SimpleGetOpt
(
getOpts
, getOptsX
, getOptsFrom
, OptSpec(..)
, OptDescr(..)
, OptSetter
, ArgDescr(..)
, GetOptException(..)
, GetOpt.ArgOrder(..)
, optSpec
, dumpUsage
, reportUsageError
, usageString
, specToGetOpt
) where
import qualified System.Console.GetOpt as GetOpt
import System.IO(stderr,hPutStrLn)
import System.Exit(exitFailure)
import System.Environment(getArgs)
import Control.Monad(unless)
import Control.Exception(Exception,throwIO,catch)
data OptSpec a = OptSpec
{ forall a. OptSpec a -> [String]
progDescription :: [String]
, forall a. OptSpec a -> [OptDescr a]
progOptions :: [OptDescr a]
, forall a. OptSpec a -> [(String, String)]
progParamDocs :: [(String,String)]
, forall a. OptSpec a -> String -> OptSetter a
progParams :: String -> OptSetter a
, forall a. OptSpec a -> ArgOrder (OptSetter a)
progArgOrder :: !(GetOpt.ArgOrder (OptSetter a))
}
optSpec :: OptSpec a
optSpec :: forall a. OptSpec a
optSpec = OptSpec
{ progDescription :: [String]
progDescription = []
, progOptions :: [OptDescr a]
progOptions = []
, progParamDocs :: [(String, String)]
progParamDocs = []
, progParams :: String -> OptSetter a
progParams = \String
_ a
_ -> String -> Either String a
forall a b. a -> Either a b
Left String
"Unexpected parameter"
, progArgOrder :: ArgOrder (OptSetter a)
progArgOrder = ArgOrder (OptSetter a)
forall a. ArgOrder a
GetOpt.Permute
}
data OptDescr a = Option
{ forall a. OptDescr a -> String
optShortFlags :: [Char]
, forall a. OptDescr a -> [String]
optLongFlags :: [String]
, forall a. OptDescr a -> String
optDescription :: String
, forall a. OptDescr a -> ArgDescr a
optArgument :: ArgDescr a
}
type OptSetter a = a -> Either String a
data ArgDescr a =
NoArg (OptSetter a)
| ReqArg String (String -> OptSetter a)
| OptArg String (Maybe String -> OptSetter a)
specToGetOpt :: OptSpec a -> [ GetOpt.OptDescr (OptSetter a) ]
specToGetOpt :: forall a. OptSpec a -> [OptDescr (OptSetter a)]
specToGetOpt = (OptDescr a -> OptDescr (OptSetter a))
-> [OptDescr a] -> [OptDescr (OptSetter a)]
forall a b. (a -> b) -> [a] -> [b]
map OptDescr a -> OptDescr (OptSetter a)
forall a. OptDescr a -> OptDescr (OptSetter a)
convertOpt ([OptDescr a] -> [OptDescr (OptSetter a)])
-> (OptSpec a -> [OptDescr a])
-> OptSpec a
-> [OptDescr (OptSetter a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptSpec a -> [OptDescr a]
forall a. OptSpec a -> [OptDescr a]
progOptions
convertArg :: ArgDescr a -> GetOpt.ArgDescr (OptSetter a)
convertArg :: forall a. ArgDescr a -> ArgDescr (OptSetter a)
convertArg ArgDescr a
arg =
case ArgDescr a
arg of
NoArg OptSetter a
a -> OptSetter a -> ArgDescr (OptSetter a)
forall a. a -> ArgDescr a
GetOpt.NoArg OptSetter a
a
ReqArg String
s String -> OptSetter a
a -> (String -> OptSetter a) -> String -> ArgDescr (OptSetter a)
forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> OptSetter a
a String
s
OptArg String
s Maybe String -> OptSetter a
a -> (Maybe String -> OptSetter a) -> String -> ArgDescr (OptSetter a)
forall a. (Maybe String -> a) -> String -> ArgDescr a
GetOpt.OptArg Maybe String -> OptSetter a
a String
s
convertOpt :: OptDescr a -> GetOpt.OptDescr (OptSetter a)
convertOpt :: forall a. OptDescr a -> OptDescr (OptSetter a)
convertOpt (Option String
a [String]
b String
c ArgDescr a
d) = String
-> [String]
-> ArgDescr (OptSetter a)
-> String
-> OptDescr (OptSetter a)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option String
a [String]
b (ArgDescr a -> ArgDescr (OptSetter a)
forall a. ArgDescr a -> ArgDescr (OptSetter a)
convertArg ArgDescr a
d) String
c
addOpt :: (a, [String]) -> (a -> Either String a) -> (a, [String])
addOpt :: forall a. (a, [String]) -> (a -> Either String a) -> (a, [String])
addOpt (a
a,[String]
es) a -> Either String a
f = case a -> Either String a
f a
a of
Left String
e -> (a
a,String
eString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
es)
Right a
a1 -> (a
a1,[String]
es)
addFile :: (String -> OptSetter a) -> (a, [String]) -> String -> (a,[String])
addFile :: forall a.
(String -> OptSetter a) -> (a, [String]) -> String -> (a, [String])
addFile String -> OptSetter a
add (a
a,[String]
es) String
file = case String -> OptSetter a
add String
file a
a of
Left String
e -> (a
a,String
eString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
es)
Right a
a1 -> (a
a1,[String]
es)
getOptsFrom :: a -> OptSpec a -> [String] -> Either GetOptException a
getOptsFrom :: forall a. a -> OptSpec a -> [String] -> Either GetOptException a
getOptsFrom a
dflt OptSpec a
os [String]
as =
do let ([OptSetter a]
funs,[String]
files,[String]
errs) = ArgOrder (OptSetter a)
-> [OptDescr (OptSetter a)]
-> [String]
-> ([OptSetter a], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
GetOpt.getOpt (OptSpec a -> ArgOrder (OptSetter a)
forall a. OptSpec a -> ArgOrder (OptSetter a)
progArgOrder OptSpec a
os) (OptSpec a -> [OptDescr (OptSetter a)]
forall a. OptSpec a -> [OptDescr (OptSetter a)]
specToGetOpt OptSpec a
os) [String]
as
Bool -> Either GetOptException () -> Either GetOptException ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs) (Either GetOptException () -> Either GetOptException ())
-> Either GetOptException () -> Either GetOptException ()
forall a b. (a -> b) -> a -> b
$ GetOptException -> Either GetOptException ()
forall a b. a -> Either a b
Left ([String] -> GetOptException
GetOptException [String]
errs)
let (a
a, [String]
errs1) = ((a, [String]) -> OptSetter a -> (a, [String]))
-> (a, [String]) -> [OptSetter a] -> (a, [String])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (a, [String]) -> OptSetter a -> (a, [String])
forall a. (a, [String]) -> (a -> Either String a) -> (a, [String])
addOpt (a
dflt,[]) [OptSetter a]
funs
Bool -> Either GetOptException () -> Either GetOptException ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs1) (Either GetOptException () -> Either GetOptException ())
-> Either GetOptException () -> Either GetOptException ()
forall a b. (a -> b) -> a -> b
$ GetOptException -> Either GetOptException ()
forall a b. a -> Either a b
Left ([String] -> GetOptException
GetOptException [String]
errs1)
let (a
b, [String]
errs2) = ((a, [String]) -> String -> (a, [String]))
-> (a, [String]) -> [String] -> (a, [String])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((String -> OptSetter a) -> (a, [String]) -> String -> (a, [String])
forall a.
(String -> OptSetter a) -> (a, [String]) -> String -> (a, [String])
addFile (OptSpec a -> String -> OptSetter a
forall a. OptSpec a -> String -> OptSetter a
progParams OptSpec a
os)) (a
a,[]) [String]
files
Bool -> Either GetOptException () -> Either GetOptException ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs2) (Either GetOptException () -> Either GetOptException ())
-> Either GetOptException () -> Either GetOptException ()
forall a b. (a -> b) -> a -> b
$ GetOptException -> Either GetOptException ()
forall a b. a -> Either a b
Left ([String] -> GetOptException
GetOptException [String]
errs2)
a -> Either GetOptException a
forall a. a -> Either GetOptException a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
b
getOptsX :: a -> OptSpec a -> IO a
getOptsX :: forall a. a -> OptSpec a -> IO a
getOptsX a
dflt OptSpec a
os =
do [String]
as <- IO [String]
getArgs
case a -> OptSpec a -> [String] -> Either GetOptException a
forall a. a -> OptSpec a -> [String] -> Either GetOptException a
getOptsFrom a
dflt OptSpec a
os [String]
as of
Left GetOptException
e -> GetOptException -> IO a
forall e a. Exception e => e -> IO a
throwIO GetOptException
e
Right a
a -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
getOpts :: a -> OptSpec a -> IO a
getOpts :: forall a. a -> OptSpec a -> IO a
getOpts a
dlft OptSpec a
os =
a -> OptSpec a -> IO a
forall a. a -> OptSpec a -> IO a
getOptsX a
dlft OptSpec a
os IO a -> (GetOptException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(GetOptException [String]
errs) -> OptSpec a -> [String] -> IO a
forall a b. OptSpec a -> [String] -> IO b
reportUsageError OptSpec a
os [String]
errs
reportUsageError :: OptSpec a -> [String] -> IO b
reportUsageError :: forall a b. OptSpec a -> [String] -> IO b
reportUsageError OptSpec a
os [String]
es =
do Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Invalid command line options:"
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
es
OptSpec a -> IO ()
forall a. OptSpec a -> IO ()
dumpUsage OptSpec a
os
IO b
forall a. IO a
exitFailure
dumpUsage :: OptSpec a -> IO ()
dumpUsage :: forall a. OptSpec a -> IO ()
dumpUsage OptSpec a
os = Handle -> String -> IO ()
hPutStrLn Handle
stderr (OptSpec a -> String
forall a. OptSpec a -> String
usageString OptSpec a
os)
usageString :: OptSpec a -> String
usageString :: forall a. OptSpec a -> String
usageString OptSpec a
os = String -> [OptDescr (OptSetter a)] -> String
forall a. String -> [OptDescr a] -> String
GetOpt.usageInfo (String
desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
params String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Flags:") (OptSpec a -> [OptDescr (OptSetter a)]
forall a. OptSpec a -> [OptDescr (OptSetter a)]
specToGetOpt OptSpec a
os)
where
desc :: String
desc = case OptSpec a -> [String]
forall a. OptSpec a -> [String]
progDescription OptSpec a
os of
[] -> []
[String]
xs -> [String] -> String
unlines [String]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
params :: String
params = case ((String, String) -> String) -> [(String, String)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
ppParam (OptSpec a -> [(String, String)]
forall a. OptSpec a -> [(String, String)]
progParamDocs OptSpec a
os) of
String
"" -> String
""
String
ps -> String
"Parameters:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ps String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
ppParam :: (String, String) -> String
ppParam (String
x,String
y) = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
padKey String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
keyWidth :: Int
keyWidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((String, String) -> Int) -> [(String, String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, String) -> String) -> (String, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) (OptSpec a -> [(String, String)]
forall a. OptSpec a -> [(String, String)]
progParamDocs OptSpec a
os))
padKey :: String -> String
padKey String
k = String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
keyWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
k) Char
' '
data GetOptException = GetOptException [String] deriving Int -> GetOptException -> String -> String
[GetOptException] -> String -> String
GetOptException -> String
(Int -> GetOptException -> String -> String)
-> (GetOptException -> String)
-> ([GetOptException] -> String -> String)
-> Show GetOptException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GetOptException -> String -> String
showsPrec :: Int -> GetOptException -> String -> String
$cshow :: GetOptException -> String
show :: GetOptException -> String
$cshowList :: [GetOptException] -> String -> String
showList :: [GetOptException] -> String -> String
Show
instance Exception GetOptException