-- | This provides a compatiblity wrapper to the @System.Console.GetOpt@ module in @base@.
--   That module is essentially a Haskell port of the GNU @getopt@ library.
--
--   /Changes:/ The changes from @GetOpt@ are listed in the documentation for each function.
module System.Console.CmdArgs.GetOpt(
    convert, getOpt, getOpt', usageInfo,
    ArgOrder(..), OptDescr(..), ArgDescr(..)
    ) where

import System.Console.CmdArgs.Explicit
import System.Console.GetOpt(OptDescr(..), ArgDescr(..))


-- | What to do with options following non-options.
--
--   /Changes:/ Only 'Permute' is allowed, both @RequireOrder@ and @ReturnInOrder@
--   have been removed.
data ArgOrder a = Permute
instance Functor ArgOrder where
    fmap :: (a -> b) -> ArgOrder a -> ArgOrder b
fmap a -> b
_ ArgOrder a
Permute = ArgOrder b
forall a. ArgOrder a
Permute


-- | Return a string describing the usage of a command, derived from
--   the header (first argument) and the options described by the
--   second argument.
usageInfo :: String -> [OptDescr a] -> String
usageInfo :: String -> [OptDescr a] -> String
usageInfo String
desc [OptDescr a]
flags = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
desc String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 (String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Mode ([a], [String]) -> String
forall a. Show a => a -> String
show (Mode ([a], [String]) -> String) -> Mode ([a], [String]) -> String
forall a b. (a -> b) -> a -> b
$ String -> [OptDescr a] -> Mode ([a], [String])
forall a. String -> [OptDescr a] -> Mode ([a], [String])
convert String
"" [OptDescr a]
flags)


-- | Process the command-line, and return the list of values that matched
--   (and those that didn\'t). The arguments are:
--
--   * The order requirements (see 'ArgOrder')
--
--   * The option descriptions (see 'OptDescr')
--
--   * The actual command line arguments (presumably got from
--     'System.Environment.getArgs').
--
--   'getOpt' returns a triple consisting of the option arguments, a list
--   of non-options, and a list of error messages.
--
--   /Changes:/ The list of errors will contain at most one entry, and if an
--   error is present then the other two lists will be empty.
getOpt  :: ArgOrder  a -> [OptDescr  a] -> [String] -> ([a], [String], [String])
getOpt :: ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder a
_ [OptDescr a]
flags [String]
args =
    case Mode ([a], [String]) -> [String] -> Either String ([a], [String])
forall a. Mode a -> [String] -> Either String a
process (String -> [OptDescr a] -> Mode ([a], [String])
forall a. String -> [OptDescr a] -> Mode ([a], [String])
convert String
"" [OptDescr a]
flags) [String]
args of
        Left String
x -> ([],[],[String
x])
        Right ([a]
a,[String]
b) -> ([a]
a,[String]
b,[])


-- | /Changes:/ This is exactly the same as 'getOpt', but the 3rd element of the
--   tuple (second last) will be an empty list.
getOpt' :: ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' :: ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder a
x [OptDescr a]
y [String]
z = ([a]
a,[String]
b,[],[String]
c)
    where ([a]
a,[String]
b,[String]
c) = ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder a
x [OptDescr a]
y [String]
z


-- | Given a help text and a list of option descriptions, generate a 'Mode'.
convert :: String -> [OptDescr a] -> Mode ([a],[String])
convert :: String -> [OptDescr a] -> Mode ([a], [String])
convert String
help [OptDescr a]
flags = String
-> ([a], [String])
-> String
-> Arg ([a], [String])
-> [Flag ([a], [String])]
-> Mode ([a], [String])
forall a. String -> a -> String -> Arg a -> [Flag a] -> Mode a
mode String
"program" ([],[]) String
help Arg ([a], [String])
forall a. Arg (a, [String])
args ((OptDescr a -> Flag ([a], [String]))
-> [OptDescr a] -> [Flag ([a], [String])]
forall a b. (a -> b) -> [a] -> [b]
map OptDescr a -> Flag ([a], [String])
forall a b. OptDescr a -> Flag ([a], b)
f [OptDescr a]
flags)
    where
        args :: Arg (a, [String])
args = Update (a, [String]) -> String -> Arg (a, [String])
forall a. Update a -> String -> Arg a
flagArg (\String
x (a
a,[String]
b) -> (a, [String]) -> Either String (a, [String])
forall a b. b -> Either a b
Right (a
a,[String]
b[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
x])) String
"ARG"

        f :: OptDescr a -> Flag ([a], b)
f (Option String
short [String]
long ArgDescr a
x String
help) = case ArgDescr a
x of
            NoArg a
x -> [String] -> (([a], b) -> ([a], b)) -> String -> Flag ([a], b)
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String]
names (\([a]
a,b
b) -> ([a]
a[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a
x],b
b)) String
help
            ReqArg String -> a
op String
x -> [String] -> Update ([a], b) -> String -> String -> Flag ([a], b)
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String]
names (\String
x ([a]
a,b
b) -> ([a], b) -> Either String ([a], b)
forall a b. b -> Either a b
Right ([a]
a[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[String -> a
op String
x],b
b)) String
x String
help
            OptArg Maybe String -> a
op String
x -> String
-> [String] -> Update ([a], b) -> String -> String -> Flag ([a], b)
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt String
"" [String]
names (\String
x ([a]
a,b
b) -> ([a], b) -> Either String ([a], b)
forall a b. b -> Either a b
Right ([a]
a[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[Maybe String -> a
op (Maybe String -> a) -> Maybe String -> a
forall a b. (a -> b) -> a -> b
$ if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
x],b
b)) String
x String
help
            where names :: [String]
names = (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
forall (m :: * -> *) a. Monad m => a -> m a
return String
short [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
long