{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  CLI.Arguments
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- A library to process command line arguments in some more convenient way.

module CLI.Arguments where

import Data.Monoid (mappend)
import GHC.Arr
import Data.List (sortBy)

data Arguments =
  A String
  | B GQtyArgs Delimiter [String]
  | C Delimiter [String]
      deriving Arguments -> Arguments -> Bool
(Arguments -> Arguments -> Bool)
-> (Arguments -> Arguments -> Bool) -> Eq Arguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arguments -> Arguments -> Bool
$c/= :: Arguments -> Arguments -> Bool
== :: Arguments -> Arguments -> Bool
$c== :: Arguments -> Arguments -> Bool
Eq

type Args = [Arguments]

type Specification = (Delimiter,GQtyArgs)

type CLSpecifications = [Specification]

type Delimiter = String

type GQtyArgs = Int

type FirstCharacter = Char

type FirstChars = (Char,Char)

instance Show Arguments where
  show :: Arguments -> String
show (A String
xs) = String
xs
  show (B Int
n String
ys [String]
yss) = Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ys String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
xs ->Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
forall a. Show a => a -> String
show String
xs) (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
n [String]
yss)
  show (C String
xs [String]
xss) = Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
ys ->Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
forall a. Show a => a -> String
show String
ys) [String]
xss String -> ShowS
forall a. Monoid a => a -> a -> a
`mappend` (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
xs)

isA :: Arguments -> Bool
isA :: Arguments -> Bool
isA (A String
_) = Bool
True
isA Arguments
_ = Bool
False

isB :: Arguments -> Bool
isB :: Arguments -> Bool
isB (B Int
_ String
_ [String]
_) = Bool
True
isB Arguments
_ = Bool
False

isC :: Arguments -> Bool
isC :: Arguments -> Bool
isC (C String
_ [String]
_) = Bool
True
isC Arguments
_ = Bool
False

nullArguments :: Arguments -> Bool
nullArguments :: Arguments -> Bool
nullArguments (A String
xs) = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs
nullArguments (B Int
n String
ys [String]
yss) = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
yss Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys  Bool -> Bool -> Bool
|| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
yss
nullArguments (C String
xs [String]
xss) = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs Bool -> Bool -> Bool
|| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss

notNullArguments :: Arguments -> Bool
notNullArguments :: Arguments -> Bool
notNullArguments (A (Char
_:String
_)) =  Bool
True
notNullArguments (A String
_) = Bool
False
notNullArguments (B Int
n (Char
_:String
_) yss :: [String]
yss@(String
_:[String]
_)) = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
yss
notNullArguments (B Int
_ String
_ [String]
_) = Bool
False
notNullArguments (C (Char
_:String
_) (String
_:[String]
_)) = Bool
True
notNullArguments Arguments
_ = Bool
False

b1Args2AArgs :: Arguments -> Arguments
b1Args2AArgs :: Arguments -> Arguments
b1Args2AArgs b :: Arguments
b@(B Int
n String
_ [String
ys])
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> Arguments
A String
ys
 | Bool
otherwise = Arguments
b
b1Args2AArgs Arguments
x = Arguments
x

args2Args
  :: CLSpecifications
  -> [String]
  ->  Args
args2Args :: CLSpecifications -> [String] -> [Arguments]
args2Args (t :: Specification
t@(String
xs,Int
n):CLSpecifications
ts) xss :: [String]
xss@(String
js:[String]
jss)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> [String] -> Arguments
C String
xs [String]
qssArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:CLSpecifications -> [String] -> [Arguments]
args2Args CLSpecifications
ts ([String]
kss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
rss)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String -> Arguments
A String
jsArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:CLSpecifications -> [String] -> [Arguments]
args2Args CLSpecifications
ts [String]
jss
  | Bool
otherwise = Int -> String -> [String] -> Arguments
B Int
n String
xs [String]
vssArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:CLSpecifications -> [String] -> [Arguments]
args2Args CLSpecifications
ts ([String]
kss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
zss)
      where ([String]
kss,[String]
uss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) [String]
xss
            wss :: [String]
wss = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
uss
            ([String]
qss,[String]
pss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) [String]
wss
            rss :: [String]
rss = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
pss
            ([String]
vss,[String]
zss) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [String]
wss
args2Args [] [String]
xss = (String -> Arguments) -> [String] -> [Arguments]
forall a b. (a -> b) -> [a] -> [b]
map String -> Arguments
A [String]
xss
args2Args CLSpecifications
_ [] = []

args2Args3'
  :: (Args,Args,Args)
  -> CLSpecifications
  -> [String]
  ->  (Args,Args,Args)
args2Args3' :: ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3' ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3) (t :: Specification
t@(String
xs,Int
n):CLSpecifications
ts) xss :: [String]
xss@(String
js:[String]
jss)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3' ([Arguments]
w1,[Arguments]
w2,String -> [String] -> Arguments
C String
xs [String]
qssArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:[Arguments]
w3) CLSpecifications
ts ([String]
kss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
rss)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3' (String -> Arguments
A String
jsArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:[Arguments]
w1,[Arguments]
w2,[Arguments]
w3) CLSpecifications
ts [String]
jss
  | Bool
otherwise = ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3' ([Arguments]
w1,Int -> String -> [String] -> Arguments
B Int
n String
xs [String]
vssArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:[Arguments]
w2,[Arguments]
w3) CLSpecifications
ts ([String]
kss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
zss)
      where ([String]
kss,[String]
uss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) [String]
xss
            wss :: [String]
wss = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
uss
            ([String]
qss,[String]
pss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) [String]
wss
            rss :: [String]
rss = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
pss
            ([String]
vss,[String]
zss) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [String]
wss
args2Args3' ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3) [] [String]
xss = ((String -> Arguments) -> [String] -> [Arguments]
forall a b. (a -> b) -> [a] -> [b]
map String -> Arguments
A [String]
xss [Arguments] -> [Arguments] -> [Arguments]
forall a. Monoid a => a -> a -> a
`mappend` [Arguments]
w1,[Arguments]
w2,[Arguments]
w3)
args2Args3' ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3) CLSpecifications
_ [] = ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3)

args2Args3
  :: CLSpecifications
  -> [String]
  -> (Args,Args,Args)
args2Args3 :: CLSpecifications
-> [String] -> ([Arguments], [Arguments], [Arguments])
args2Args3 = ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3' ([],[],[])
{-# INLINABLE args2Args3 #-}

------------------------------------------------

args2Args1
  :: FirstChars -- ^ A pair of the first characters of the starting group delimiter (the same for all 'String's in the all 'CLSpecifications') and the probable its modification (the first character of the last delimiter).
  -> CLSpecifications
  -> [String]
  ->  Args
args2Args1 :: FirstChars -> CLSpecifications -> [String] -> [Arguments]
args2Args1 (Char
x1,Char
x2) (t :: Specification
t@(xs :: String
xs@(Char
k:String
ks),Int
n):CLSpecifications
ts) xss :: [String]
xss@(String
js:[String]
jss)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> [String] -> Arguments
C String
xs [String]
qssArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:FirstChars -> CLSpecifications -> [String] -> [Arguments]
args2Args1 (Char
x1,Char
x2) CLSpecifications
ts ([String]
kss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
rss)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String -> Arguments
A String
jsArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:FirstChars -> CLSpecifications -> [String] -> [Arguments]
args2Args1 (Char
x1,Char
x2) CLSpecifications
ts [String]
jss
  | Bool
otherwise = Int -> String -> [String] -> Arguments
B Int
n String
xs [String]
vssArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:FirstChars -> CLSpecifications -> [String] -> [Arguments]
args2Args1(Char
x1,Char
x2) CLSpecifications
ts ([String]
kss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
zss)
      where ([String]
kss,[String]
uss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) [String]
xss
            wss :: [String]
wss = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
uss
            ([String]
qss,[String]
pss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\String
rs -> String
rs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs Bool -> Bool -> Bool
|| (Char
k Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x1 Bool -> Bool -> Bool
&& String
rs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char
x2Char -> ShowS
forall a. a -> [a] -> [a]
:String
ks))) [String]
wss
            rss :: [String]
rss = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
pss
            ([String]
vss,[String]
zss) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [String]
wss
args2Args1 (Char
x1,Char
x2) (t :: Specification
t@([],Int
n):CLSpecifications
ts) [String]
xss = FirstChars -> CLSpecifications -> [String] -> [Arguments]
args2Args1 (Char
x1,Char
x2) CLSpecifications
ts [String]
xss
args2Args1 FirstChars
_ [] [String]
xss = (String -> Arguments) -> [String] -> [Arguments]
forall a b. (a -> b) -> [a] -> [b]
map String -> Arguments
A [String]
xss
args2Args1 FirstChars
_ CLSpecifications
_ [] = []

args2Args3'1
  :: FirstChars -- ^ A pair of the first characters of the starting group delimiter (the same for all 'String's in the all 'CLSpecifications') and the probable its modification (the first character of the last delimiter).
  -> (Args,Args,Args)
  -> CLSpecifications
  -> [String]
  ->  (Args,Args,Args)
args2Args3'1 :: FirstChars
-> ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3'1 (Char
x1,Char
x2) ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3) (t :: Specification
t@(xs :: String
xs@(Char
k:String
ks),Int
n):CLSpecifications
ts) xss :: [String]
xss@(String
js:[String]
jss)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = FirstChars
-> ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3'1 (Char
x1,Char
x2) ([Arguments]
w1,[Arguments]
w2,String -> [String] -> Arguments
C String
xs [String]
qssArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:[Arguments]
w3) CLSpecifications
ts ([String]
kss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
rss)
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = FirstChars
-> ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3'1 (Char
x1,Char
x2) (String -> Arguments
A String
jsArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:[Arguments]
w1,[Arguments]
w2,[Arguments]
w3) CLSpecifications
ts [String]
jss
  | Bool
otherwise = FirstChars
-> ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3'1 (Char
x1,Char
x2) ([Arguments]
w1,Int -> String -> [String] -> Arguments
B Int
n String
xs [String]
vssArguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:[Arguments]
w2,[Arguments]
w3) CLSpecifications
ts ([String]
kss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
zss)
      where ([String]
kss,[String]
uss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) [String]
xss
            wss :: [String]
wss = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
uss
            ([String]
qss,[String]
pss) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\String
rs -> String
rs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs Bool -> Bool -> Bool
|| (Char
k Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x1 Bool -> Bool -> Bool
&& String
rs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char
x2Char -> ShowS
forall a. a -> [a] -> [a]
:String
ks))) [String]
wss
            rss :: [String]
rss = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
pss
            ([String]
vss,[String]
zss) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [String]
wss
args2Args3'1 (Char
x1,Char
x2) ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3) (t :: Specification
t@([],Int
n):CLSpecifications
ts) [String]
xss = FirstChars
-> ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3'1 (Char
x1,Char
x2) ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3) CLSpecifications
ts [String]
xss
args2Args3'1 FirstChars
_ ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3) [] [String]
xss = ((String -> Arguments) -> [String] -> [Arguments]
forall a b. (a -> b) -> [a] -> [b]
map String -> Arguments
A [String]
xss [Arguments] -> [Arguments] -> [Arguments]
forall a. Monoid a => a -> a -> a
`mappend` [Arguments]
w1,[Arguments]
w2,[Arguments]
w3)
args2Args3'1 FirstChars
_ ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3) CLSpecifications
_ [] = ([Arguments]
w1,[Arguments]
w2,[Arguments]
w3)

args2Args31
  :: FirstChars -- ^ A pair of the first characters of the starting group delimiter (the same for all 'String's in the all 'CLSpecifications') and the probable its modification (the first character of the last delimiter).
  -> CLSpecifications
  -> [String]
  -> (Args,Args,Args)
args2Args31 :: FirstChars
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args31 (Char
x1,Char
x2) = FirstChars
-> ([Arguments], [Arguments], [Arguments])
-> CLSpecifications
-> [String]
-> ([Arguments], [Arguments], [Arguments])
args2Args3'1 (Char
x1,Char
x2) ([],[],[])
{-# INLINABLE args2Args31 #-}

------------------------------------------

-- | This function can actually parse the command line arguments being the ['String'].
args2ArgsFilteredG
  :: (Arguments -> Bool) -- ^ A predicate to check which 'Arguments' must be kept in the result.
  -> CLSpecifications
  -> [String]
  -> Args
args2ArgsFilteredG :: (Arguments -> Bool) -> CLSpecifications -> [String] -> [Arguments]
args2ArgsFilteredG Arguments -> Bool
f CLSpecifications
ts = (Arguments -> Bool) -> [Arguments] -> [Arguments]
forall a. (a -> Bool) -> [a] -> [a]
filter Arguments -> Bool
f ([Arguments] -> [Arguments])
-> ([String] -> [Arguments]) -> [String] -> [Arguments]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arguments -> Arguments) -> [Arguments] -> [Arguments]
forall a b. (a -> b) -> [a] -> [b]
map Arguments -> Arguments
b1Args2AArgs ([Arguments] -> [Arguments])
-> ([String] -> [Arguments]) -> [String] -> [Arguments]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLSpecifications -> [String] -> [Arguments]
args2Args CLSpecifications
ts
{-# INLINABLE args2ArgsFilteredG #-}

-- | This function can actually parse the command line arguments being the ['String'].
args2ArgsFilteredG1
  :: FirstChars -- ^ A pair of the first characters of the starting group delimiter (the same for all 'String's in the all 'CLSpecifications') and the probable its modification (the first character of the last delimiter).
  -> (Arguments -> Bool) -- ^ A predicate to check which 'Arguments' must be kept in the result.
  -> CLSpecifications
  -> [String]
  -> Args
args2ArgsFilteredG1 :: FirstChars
-> (Arguments -> Bool)
-> CLSpecifications
-> [String]
-> [Arguments]
args2ArgsFilteredG1 (Char
x1,Char
x2) Arguments -> Bool
f CLSpecifications
ts = (Arguments -> Bool) -> [Arguments] -> [Arguments]
forall a. (a -> Bool) -> [a] -> [a]
filter Arguments -> Bool
f ([Arguments] -> [Arguments])
-> ([String] -> [Arguments]) -> [String] -> [Arguments]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arguments -> Arguments) -> [Arguments] -> [Arguments]
forall a b. (a -> b) -> [a] -> [b]
map Arguments -> Arguments
b1Args2AArgs ([Arguments] -> [Arguments])
-> ([String] -> [Arguments]) -> [String] -> [Arguments]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstChars -> CLSpecifications -> [String] -> [Arguments]
args2Args1 (Char
x1,Char
x2) CLSpecifications
ts
{-# INLINABLE args2ArgsFilteredG1 #-}

-- | This function can actually parse the command line arguments being the ['String'].
args2ArgsFiltered
  :: CLSpecifications
  -> [String]
  -> Args
args2ArgsFiltered :: CLSpecifications -> [String] -> [Arguments]
args2ArgsFiltered = (Arguments -> Bool) -> CLSpecifications -> [String] -> [Arguments]
args2ArgsFilteredG Arguments -> Bool
notNullArguments
{-# INLINABLE args2ArgsFiltered #-}

takeCs
  :: CLSpecifications
  -> [String]
  -> Args
takeCs :: CLSpecifications -> [String] -> [Arguments]
takeCs = (Arguments -> Bool) -> CLSpecifications -> [String] -> [Arguments]
args2ArgsFilteredG (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isC Arguments
x)
{-# INLINABLE takeCs #-}

takeCs1
  :: FirstChars -- ^ A pair of the first characters of the starting group delimiter (the same for all 'String's in the all 'CLSpecifications') and the probable its modification (the first character of the last delimiter).
  -> CLSpecifications
  -> [String]
  -> Args
takeCs1 :: FirstChars -> CLSpecifications -> [String] -> [Arguments]
takeCs1 (Char
x1,Char
x2) = FirstChars
-> (Arguments -> Bool)
-> CLSpecifications
-> [String]
-> [Arguments]
args2ArgsFilteredG1 (Char
x1,Char
x2) (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isC Arguments
x)
{-# INLINABLE takeCs1 #-}

takeBs
  :: CLSpecifications
  -> [String]
  -> Args
takeBs :: CLSpecifications -> [String] -> [Arguments]
takeBs = (Arguments -> Bool) -> CLSpecifications -> [String] -> [Arguments]
args2ArgsFilteredG (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isB Arguments
x)
{-# INLINABLE takeBs #-}

takeAs
  :: CLSpecifications
  -> [String]
  -> Args
takeAs :: CLSpecifications -> [String] -> [Arguments]
takeAs = (Arguments -> Bool) -> CLSpecifications -> [String] -> [Arguments]
args2ArgsFilteredG (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isA Arguments
x)
{-# INLINABLE takeAs #-}

------------------------------------------------------

takeArgsSortedBy
  :: (Arguments -> Bool) -- ^ A predicate to check which 'Arguments' must be kept in the result.
  -> (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'C's.
  -> CLSpecifications
  -> [String]
  -> Args
takeArgsSortedBy :: (Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgsSortedBy Arguments -> Bool
g Arguments -> Arguments -> Ordering
f CLSpecifications
ts = (Arguments -> Arguments -> Ordering) -> [Arguments] -> [Arguments]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Arguments -> Arguments -> Ordering
f ([Arguments] -> [Arguments])
-> ([String] -> [Arguments]) -> [String] -> [Arguments]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arguments -> Bool) -> CLSpecifications -> [String] -> [Arguments]
args2ArgsFilteredG Arguments -> Bool
g CLSpecifications
ts
{-# INLINABLE takeArgsSortedBy #-}

takeArgs1SortedBy
  :: FirstChars -- ^ A pair of the first characters of the starting group delimiter (the same for all 'String's in the all 'CLSpecifications') and the probable its modification (the first character of the last delimiter).
  -> (Arguments -> Bool) -- ^ A predicate to check which 'Arguments' must be kept in the result.
  -> (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'C's.
  -> CLSpecifications
  -> [String]
  -> Args
takeArgs1SortedBy :: FirstChars
-> (Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgs1SortedBy (Char
x1,Char
x2) Arguments -> Bool
g Arguments -> Arguments -> Ordering
f CLSpecifications
ts = (Arguments -> Arguments -> Ordering) -> [Arguments] -> [Arguments]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Arguments -> Arguments -> Ordering
f ([Arguments] -> [Arguments])
-> ([String] -> [Arguments]) -> [String] -> [Arguments]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FirstChars
-> (Arguments -> Bool)
-> CLSpecifications
-> [String]
-> [Arguments]
args2ArgsFilteredG1 (Char
x1,Char
x2) Arguments -> Bool
g CLSpecifications
ts
{-# INLINABLE takeArgs1SortedBy #-}

takeCsSortedBy
  :: (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'C's.
  -> CLSpecifications
  -> [String]
  -> Args
takeCsSortedBy :: (Arguments -> Arguments -> Ordering)
-> CLSpecifications -> [String] -> [Arguments]
takeCsSortedBy = (Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgsSortedBy (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isC Arguments
x)
{-# INLINABLE takeCsSortedBy #-}

takeCs1SortedBy
  :: FirstChars -- ^ A pair of the first characters of the starting group delimiter (the same for all 'String's in the all 'CLSpecifications') and the probable its modification (the first character of the last delimiter).
  -> (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'C's.
  -> CLSpecifications
  -> [String]
  -> Args
takeCs1SortedBy :: FirstChars
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeCs1SortedBy (Char
x1,Char
x2) = FirstChars
-> (Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgs1SortedBy (Char
x1,Char
x2) (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isC Arguments
x)
{-# INLINABLE takeCs1SortedBy #-}

takeBsSortedBy
  :: (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'B's.
  -> CLSpecifications
  -> [String]
  -> Args
takeBsSortedBy :: (Arguments -> Arguments -> Ordering)
-> CLSpecifications -> [String] -> [Arguments]
takeBsSortedBy = (Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgsSortedBy (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isB Arguments
x)
{-# INLINABLE takeBsSortedBy #-}

takeAsSortedBy
  :: (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'A's.
  -> CLSpecifications
  -> [String]
  -> Args
takeAsSortedBy :: (Arguments -> Arguments -> Ordering)
-> CLSpecifications -> [String] -> [Arguments]
takeAsSortedBy = (Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgsSortedBy (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isA Arguments
x)
{-# INLINABLE takeAsSortedBy #-}

------------------------------------------------------

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeABCsArr
  :: (CLSpecifications -> [String] -> Args) -- ^ A function to collect the 'Args'
  -> CLSpecifications
  -> [String]
  -> Array Int Arguments
takeABCsArr :: (CLSpecifications -> [String] -> [Arguments])
-> CLSpecifications -> [String] -> Array Int Arguments
takeABCsArr CLSpecifications -> [String] -> [Arguments]
f CLSpecifications
ts [String]
xss = (Int, Int) -> [Arguments] -> Array Int Arguments
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Arguments]
js
     where js :: [Arguments]
js = CLSpecifications -> [String] -> [Arguments]
f CLSpecifications
ts [String]
xss
           l :: Int
l = [Arguments] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arguments]
js
{-# INLINABLE takeABCsArr #-}

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeCsArr
  :: CLSpecifications
  -> [String]
  -> Array Int Arguments
takeCsArr :: CLSpecifications -> [String] -> Array Int Arguments
takeCsArr = (CLSpecifications -> [String] -> [Arguments])
-> CLSpecifications -> [String] -> Array Int Arguments
takeABCsArr CLSpecifications -> [String] -> [Arguments]
takeCs
{-# INLINABLE takeCsArr #-}

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeCs1Arr
  :: FirstChars -- ^ A pair of the first characters of the starting group delimiter (the same for all 'String's in the all 'CLSpecifications') and the probable its modification (the first character of the last delimiter).
  -> CLSpecifications
  -> [String]
  -> Array Int Arguments
takeCs1Arr :: FirstChars -> CLSpecifications -> [String] -> Array Int Arguments
takeCs1Arr (Char
x1,Char
x2) = (CLSpecifications -> [String] -> [Arguments])
-> CLSpecifications -> [String] -> Array Int Arguments
takeABCsArr (FirstChars -> CLSpecifications -> [String] -> [Arguments]
takeCs1 (Char
x1,Char
x2))
{-# INLINABLE takeCs1Arr #-}

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeBsArr
  :: CLSpecifications
  -> [String]
  -> Array Int Arguments
takeBsArr :: CLSpecifications -> [String] -> Array Int Arguments
takeBsArr = (CLSpecifications -> [String] -> [Arguments])
-> CLSpecifications -> [String] -> Array Int Arguments
takeABCsArr CLSpecifications -> [String] -> [Arguments]
takeBs
{-# INLINABLE takeBsArr #-}

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeAsArr
  :: CLSpecifications
  -> [String]
  -> Array Int Arguments
takeAsArr :: CLSpecifications -> [String] -> Array Int Arguments
takeAsArr  = (CLSpecifications -> [String] -> [Arguments])
-> CLSpecifications -> [String] -> Array Int Arguments
takeABCsArr CLSpecifications -> [String] -> [Arguments]
takeAs
{-# INLINABLE takeAsArr #-}

---------------------------------------------------

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeABCsArrSortedBy
  :: ((Arguments -> Arguments -> Ordering) -> CLSpecifications -> [String] -> Args)
  -> (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'C's.
  -> CLSpecifications
  -> [String]
  -> Array Int Arguments
takeABCsArrSortedBy :: ((Arguments -> Arguments -> Ordering)
 -> CLSpecifications -> [String] -> [Arguments])
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> Array Int Arguments
takeABCsArrSortedBy (Arguments -> Arguments -> Ordering)
-> CLSpecifications -> [String] -> [Arguments]
g Arguments -> Arguments -> Ordering
f CLSpecifications
ts [String]
xss = (Int, Int) -> [Arguments] -> Array Int Arguments
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Arguments]
js
     where js :: [Arguments]
js = (Arguments -> Arguments -> Ordering)
-> CLSpecifications -> [String] -> [Arguments]
g Arguments -> Arguments -> Ordering
f  CLSpecifications
ts [String]
xss
           l :: Int
l = [Arguments] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arguments]
js
{-# INLINABLE takeABCsArrSortedBy #-}

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeCsArrSortedBy
  :: (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'C's.
  -> CLSpecifications
  -> [String]
  -> Array Int Arguments
takeCsArrSortedBy :: (Arguments -> Arguments -> Ordering)
-> CLSpecifications -> [String] -> Array Int Arguments
takeCsArrSortedBy = ((Arguments -> Arguments -> Ordering)
 -> CLSpecifications -> [String] -> [Arguments])
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> Array Int Arguments
takeABCsArrSortedBy ((Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgsSortedBy (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isC Arguments
x))
{-# INLINABLE takeCsArrSortedBy #-}

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeCs1ArrSortedBy
  :: FirstChars -- ^ A pair of the first characters of the starting group delimiter (the same for all 'String's in the all 'CLSpecifications') and the probable its modification being also the first character.
  -> (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'C's.
  -> CLSpecifications
  -> [String]
  -> Array Int Arguments
takeCs1ArrSortedBy :: FirstChars
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> Array Int Arguments
takeCs1ArrSortedBy (Char
x1,Char
x2) = ((Arguments -> Arguments -> Ordering)
 -> CLSpecifications -> [String] -> [Arguments])
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> Array Int Arguments
takeABCsArrSortedBy (FirstChars
-> (Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgs1SortedBy (Char
x1,Char
x2) (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isC Arguments
x))
{-# INLINABLE takeCs1ArrSortedBy #-}

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeBsArrSortedBy
  :: (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'B's.
  -> CLSpecifications
  -> [String]
  -> Array Int Arguments
takeBsArrSortedBy :: (Arguments -> Arguments -> Ordering)
-> CLSpecifications -> [String] -> Array Int Arguments
takeBsArrSortedBy = ((Arguments -> Arguments -> Ordering)
 -> CLSpecifications -> [String] -> [Arguments])
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> Array Int Arguments
takeABCsArrSortedBy ((Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgsSortedBy (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isB Arguments
x))
{-# INLINABLE takeBsArrSortedBy #-}

-- | For empty list of 'String's returns empty array that has no elements. Trying to index it always returns error and can cause
-- segmentation fault in the running program or interpreter (GHCi).
takeAsArrSortedBy
  :: (Arguments -> Arguments -> Ordering) -- ^ A 'compare'-like implementation for 'Arguments'. If needed you can implement your own 'Ord' instance for 'Arguments' and use it here. Here can be partial, just for 'A's.
  -> CLSpecifications
  -> [String]
  -> Array Int Arguments
takeAsArrSortedBy :: (Arguments -> Arguments -> Ordering)
-> CLSpecifications -> [String] -> Array Int Arguments
takeAsArrSortedBy = ((Arguments -> Arguments -> Ordering)
 -> CLSpecifications -> [String] -> [Arguments])
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> Array Int Arguments
takeABCsArrSortedBy ((Arguments -> Bool)
-> (Arguments -> Arguments -> Ordering)
-> CLSpecifications
-> [String]
-> [Arguments]
takeArgsSortedBy (\Arguments
x -> Arguments -> Bool
notNullArguments Arguments
x Bool -> Bool -> Bool
&& Arguments -> Bool
isA Arguments
x))
{-# INLINABLE takeAsArrSortedBy #-}