    module General.GetOpt(
        OptDescr(..), ArgDescr(..),
        getOpt,
        fmapFmapOptDescr,
        showOptDescr,
        mergeOptDescr,
        removeOverlap,
        optionsEnum,
        optionsEnumDesc
        ) where

    import qualified System.Console.GetOpt as O
    import System.Console.GetOpt hiding (getOpt)
    import qualified Data.HashSet as Set
    import Data.Maybe
    import Data.Either
    import Data.List.Extra

    getOpt :: [OptDescr (Either String a)] -> [String] -> ([a], [String], [String])
    getOpt :: forall a.
    [OptDescr (Either String a)]
    -> [String] -> ([a], [String], [String])
    getOpt [OptDescr (Either String a)]
    opts [String]
    args = ([a]
    flagGood, [String]
    files, [String]
    flagBad [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    errs)
        where ([Either String a]
    flags, [String]
    files, [String]
    errs) = ArgOrder (Either String a)
    -> [OptDescr (Either String a)]
    -> [String]
    -> ([Either String a], [String], [String])
    forall a.
    ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
    O.getOpt ArgOrder (Either String a)
    forall a. ArgOrder a
    O.Permute [OptDescr (Either String a)]
    opts [String]
    args
              ([String]
    flagBad, [a]
    flagGood) = [Either String a] -> ([String], [a])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either String a]
    flags

    fmapFmapOptDescr :: (a -> b) -> OptDescr (Either String a) -> OptDescr (Either String b)
    fmapFmapOptDescr :: forall a b.
    (a -> b)
    -> OptDescr (Either String a) -> OptDescr (Either String b)
    fmapFmapOptDescr a -> b
    f = (Either String a -> Either String b)
    -> OptDescr (Either String a) -> OptDescr (Either String b)
    forall a b. (a -> b) -> OptDescr a -> OptDescr b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> b) -> Either String a -> Either String b
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f)

    showOptDescr :: [OptDescr a] -> [String]
    showOptDescr :: forall a. [OptDescr a] -> [String]
    showOptDescr [OptDescr a]
    xs = [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        [ if Int
    nargs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    26 then [String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    args String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    28 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    nargs) Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    desc]
                         else [String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    args, Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    30 Char
    ' ' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    desc]
        | Option String
    s [String]
    l ArgDescr a
    arg String
    desc <- [OptDescr a]
    xs
        , let args :: String
    args = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Char -> String) -> String -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (ArgDescr a -> Char -> String
    forall {a}. ArgDescr a -> Char -> String
    short ArgDescr a
    arg) String
    s [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (ArgDescr a -> String -> String
    forall {a}. ArgDescr a -> String -> String
    long ArgDescr a
    arg) [String]
    l
        , let nargs :: Int
    nargs = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    args]
        where short :: ArgDescr a -> Char -> String
    short NoArg{} Char
    x = String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    x]
              short (ReqArg String -> a
    _ String
    b) Char
    x = String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    x] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    b
              short (OptArg Maybe String -> a
    _ String
    b) Char
    x = String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    x] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    b String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"
              long :: ArgDescr a -> String -> String
    long NoArg{} String
    x = String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x
              long (ReqArg String -> a
    _ String
    b) String
    x = String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    b
              long (OptArg Maybe String -> a
    _ String
    b) String
    x = String
    "--" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "[=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    b String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"

    -- | Remove flags from the first field that are present in the second
    removeOverlap :: [OptDescr b] -> [OptDescr a] -> [OptDescr a]
    removeOverlap :: forall b a. [OptDescr b] -> [OptDescr a] -> [OptDescr a]
    removeOverlap [OptDescr b]
    bad = (OptDescr a -> Maybe (OptDescr a)) -> [OptDescr a] -> [OptDescr a]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe OptDescr a -> Maybe (OptDescr a)
    forall {a}. OptDescr a -> Maybe (OptDescr a)
    f
        where
            short :: HashSet Char
    short = String -> HashSet Char
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    Set.fromList (String -> HashSet Char) -> String -> HashSet Char
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String
    x | Option String
    x [String]
    _ ArgDescr b
    _ String
    _ <- [OptDescr b]
    bad]
            long :: HashSet String
    long  = [String] -> HashSet String
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    Set.fromList ([String] -> HashSet String) -> [String] -> HashSet String
    forall a b. (a -> b) -> a -> b
    $ [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[String]
    x | Option String
    _ [String]
    x ArgDescr b
    _ String
    _ <- [OptDescr b]
    bad]
            f :: OptDescr a -> Maybe (OptDescr a)
    f (Option String
    a [String]
    b ArgDescr a
    c String
    d) | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    a2 Bool -> Bool -> Bool
    && [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    b2 = Maybe (OptDescr a)
    forall a. Maybe a
    Nothing
                               | Bool
    otherwise = OptDescr a -> Maybe (OptDescr a)
    forall a. a -> Maybe a
    Just (OptDescr a -> Maybe (OptDescr a))
    -> OptDescr a -> Maybe (OptDescr a)
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> ArgDescr a -> String -> OptDescr a
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option String
    a2 [String]
    b2 ArgDescr a
    c String
    d
                where a2 :: String
    a2 = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> HashSet Char -> Bool) -> HashSet Char -> Char -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Char -> HashSet Char -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    Set.member HashSet Char
    short) String
    a
                      b2 :: [String]
    b2 = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> HashSet String -> Bool)
    -> HashSet String -> String -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> HashSet String -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    Set.member HashSet String
    long) [String]
    b

    mergeOptDescr :: [OptDescr (Either String a)] -> [OptDescr (Either String b)] -> [OptDescr (Either String (Either a b))]
    mergeOptDescr :: forall a b.
    [OptDescr (Either String a)]
    -> [OptDescr (Either String b)]
    -> [OptDescr (Either String (Either a b))]
    mergeOptDescr [OptDescr (Either String a)]
    xs [OptDescr (Either String b)]
    ys = (OptDescr (Either String a)
     -> OptDescr (Either String (Either a b)))
    -> [OptDescr (Either String a)]
    -> [OptDescr (Either String (Either a b))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> Either a b)
    -> OptDescr (Either String a)
    -> OptDescr (Either String (Either a b))
    forall a b.
    (a -> b)
    -> OptDescr (Either String a) -> OptDescr (Either String b)
    fmapFmapOptDescr a -> Either a b
    forall a b. a -> Either a b
    Left) [OptDescr (Either String a)]
    xs [OptDescr (Either String (Either a b))]
    -> [OptDescr (Either String (Either a b))]
    -> [OptDescr (Either String (Either a b))]
    forall a. [a] -> [a] -> [a]
    ++ (OptDescr (Either String b)
     -> OptDescr (Either String (Either a b)))
    -> [OptDescr (Either String b)]
    -> [OptDescr (Either String (Either a b))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((b -> Either a b)
    -> OptDescr (Either String b)
    -> OptDescr (Either String (Either a b))
    forall a b.
    (a -> b)
    -> OptDescr (Either String a) -> OptDescr (Either String b)
    fmapFmapOptDescr b -> Either a b
    forall a b. b -> Either a b
    Right) [OptDescr (Either String b)]
    ys

    optionsEnum :: (Enum a, Bounded a, Show a) => [OptDescr (Either String a)]
    optionsEnum :: forall a.
    (Enum a, Bounded a, Show a) =>
    [OptDescr (Either String a)]
    optionsEnum = [(a, String)] -> [OptDescr (Either String a)]
    forall a. Show a => [(a, String)] -> [OptDescr (Either String a)]
    optionsEnumDesc [(a
    x, String
    "Flag " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    lower (a -> String
    forall a. Show a => a -> String
    show a
    x) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ".") | a
    x <- [a]
    forall a. (Enum a, Bounded a) => [a]
    enumerate]

    optionsEnumDesc :: Show a => [(a, String)] -> [OptDescr (Either String a)]
    optionsEnumDesc :: forall a. Show a => [(a, String)] -> [OptDescr (Either String a)]
    optionsEnumDesc [(a, String)]
    xs = [String
    -> [String]
    -> ArgDescr (Either String a)
    -> String
    -> OptDescr (Either String a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option String
    "" [String -> String
    lower (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ a -> String
    forall a. Show a => a -> String
    show a
    x] (Either String a -> ArgDescr (Either String a)
    forall a. a -> ArgDescr a
    NoArg (Either String a -> ArgDescr (Either String a))
    -> Either String a -> ArgDescr (Either String a)
    forall a b. (a -> b) -> a -> b
    $ a -> Either String a
    forall a b. b -> Either a b
    Right a
    x) String
    d | (a
    x,String
    d) <- [(a, String)]
    xs]