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 forall a. [a] -> [a] -> [a]
++ [String]
errs)
    where ([Either String a]
flags, [String]
files, [String]
errs) = forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
O.getOpt forall a. ArgOrder a
O.Permute [OptDescr (Either String a)]
opts [String]
args
          ([String]
flagBad, [a]
flagGood) = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ if Int
nargs forall a. Ord a => a -> a -> Bool
<= Int
26 then [String
"  " forall a. [a] -> [a] -> [a]
++ String
args forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
28 forall a. Num a => a -> a -> a
- Int
nargs) Char
' ' forall a. [a] -> [a] -> [a]
++ String
desc]
                     else [String
"  " forall a. [a] -> [a] -> [a]
++ String
args, forall a. Int -> a -> [a]
replicate Int
30 Char
' ' forall a. [a] -> [a] -> [a]
++ String
desc]
    | Option String
s [String]
l ArgDescr a
arg String
desc <- [OptDescr a]
xs
    , let args :: String
args = forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. ArgDescr a -> Char -> String
short ArgDescr a
arg) String
s forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. ArgDescr a -> String -> String
long ArgDescr a
arg) [String]
l
    , let nargs :: Int
nargs = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
args]
    where short :: ArgDescr a -> Char -> String
short NoArg{} Char
x = String
"-" forall a. [a] -> [a] -> [a]
++ [Char
x]
          short (ReqArg String -> a
_ String
b) Char
x = String
"-" forall a. [a] -> [a] -> [a]
++ [Char
x] forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
b
          short (OptArg Maybe String -> a
_ String
b) Char
x = String
"-" forall a. [a] -> [a] -> [a]
++ [Char
x] forall a. [a] -> [a] -> [a]
++ String
"[" forall a. [a] -> [a] -> [a]
++ String
b forall a. [a] -> [a] -> [a]
++ String
"]"
          long :: ArgDescr a -> String -> String
long NoArg{} String
x = String
"--" forall a. [a] -> [a] -> [a]
++ String
x
          long (ReqArg String -> a
_ String
b) String
x = String
"--" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"=" forall a. [a] -> [a] -> [a]
++ String
b
          long (OptArg Maybe String -> a
_ String
b) String
x = String
"--" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"[=" forall a. [a] -> [a] -> [a]
++ String
b 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. OptDescr a -> Maybe (OptDescr a)
f
    where
        short :: HashSet Char
short = forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList forall a b. (a -> b) -> a -> b
$ 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  = forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList forall a b. (a -> b) -> a -> b
$ 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) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
a2 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
b2 = forall a. Maybe a
Nothing
                           | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
a2 [String]
b2 ArgDescr a
c String
d
            where a2 :: String
a2 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
Set.member HashSet Char
short) String
a
                  b2 :: [String]
b2 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall a b.
(a -> b)
-> OptDescr (Either String a) -> OptDescr (Either String b)
fmapFmapOptDescr forall a b. a -> Either a b
Left) [OptDescr (Either String a)]
xs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a b.
(a -> b)
-> OptDescr (Either String a) -> OptDescr (Either String b)
fmapFmapOptDescr 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 = forall a. Show a => [(a, String)] -> [OptDescr (Either String a)]
optionsEnumDesc [(a
x, String
"Flag " forall a. [a] -> [a] -> [a]
++ String -> String
lower (forall a. Show a => a -> String
show a
x) forall a. [a] -> [a] -> [a]
++ String
".") | a
x <- 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 = [forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String -> String
lower forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
x] (forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
x) String
d | (a
x,String
d) <- [(a, String)]
xs]