{-# 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)

data Arguments =
  A String
  | B Int String [String]
  | C String [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

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
_:[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
1 = (String -> [String] -> Arguments
C String
xs [String]
qss)Arguments -> [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. Ord a => a -> a -> Bool
> Int
1 = (Int -> String -> [String] -> Arguments
B Int
n String
xs [String]
vss)Arguments -> [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)
  | Bool
otherwise = (String -> Arguments
A String
js)Arguments -> [Arguments] -> [Arguments]
forall a. a -> [a] -> [a]
:CLSpecifications -> [String] -> [Arguments]
args2Args CLSpecifications
ts [String]
jss
      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

-- | This function can actually parse the command line arguments being the ['String'] so that some of them will disappear
-- because of the 'CLSpecifications' provided and the order of the arguments.
args2ArgsFiltered
  :: CLSpecifications
  -> [String]
  -> Args
args2ArgsFiltered :: CLSpecifications -> [String] -> [Arguments]
args2ArgsFiltered CLSpecifications
ts = (Arguments -> Bool) -> [Arguments] -> [Arguments]
forall a. (a -> Bool) -> [a] -> [a]
filter Arguments -> Bool
notNullArguments ([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
{-# INLINE args2ArgsFiltered #-}