{-# 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 Int String [String]
| C String [String]
deriving Eq
type Args = [Arguments]
type Specification = (Delimiter,GQtyArgs)
type CLSpecifications = [Specification]
type Delimiter = String
type GQtyArgs = Int
instance Show Arguments where
show (A xs) = xs
show (B n ys yss) = ' ':ys `mappend` concatMap (\xs ->' ':show xs) (take n yss)
show (C xs xss) = ' ':xs `mappend` concatMap (\ys ->' ':show ys) xss `mappend` (' ':xs)
isA :: Arguments -> Bool
isA (A _) = True
isA _ = False
isB :: Arguments -> Bool
isB (B _ _ _) = True
isB _ = False
isC :: Arguments -> Bool
isC (C _ _) = True
isC _ = False
nullArguments :: Arguments -> Bool
nullArguments (A xs) = null xs
nullArguments (B n ys yss) = n /= length yss || null ys || null yss
nullArguments (C xs xss) = null xs || null xss
notNullArguments :: Arguments -> Bool
notNullArguments (A (_:_)) = True
notNullArguments (A _) = False
notNullArguments (B n (_:_) yss@(_:_)) = n == length yss
notNullArguments (B _ _ _) = False
notNullArguments (C (_:_) (_:_)) = True
notNullArguments _ = False
b1Args2AArgs :: Arguments -> Arguments
b1Args2AArgs b@(B n _ [ys])
| n < 1 = A ys
| otherwise = b
b1Args2AArgs x = x
args2Args
:: CLSpecifications
-> [String]
-> Args
args2Args (t@(xs,n):ts) xss@(js:jss)
| n < 0 = C xs qss:args2Args ts (kss `mappend` rss)
| n == 0 = A js:args2Args ts jss
| otherwise = B n xs vss:args2Args ts (kss `mappend` zss)
where (kss,uss) = break (== xs) xss
wss = drop 1 uss
(qss,pss) = break (== xs) wss
rss = drop 1 pss
(vss,zss) = splitAt n wss
args2Args [] xss = map A xss
args2Args _ [] = []
args2Args3'
:: (Args,Args,Args)
-> CLSpecifications
-> [String]
-> (Args,Args,Args)
args2Args3' (w1,w2,w3) (t@(xs,n):ts) xss@(js:jss)
| n < 0 = args2Args3' (w1,w2,C xs qss:w3) ts (kss `mappend` rss)
| n == 0 = args2Args3' (A js:w1,w2,w3) ts jss
| otherwise = args2Args3' (w1,B n xs vss:w2,w3) ts (kss `mappend` zss)
where (kss,uss) = break (== xs) xss
wss = drop 1 uss
(qss,pss) = break (== xs) wss
rss = drop 1 pss
(vss,zss) = splitAt n wss
args2Args3' (w1,w2,w3) [] xss = (map A xss `mappend` w1,w2,w3)
args2Args3' (w1,w2,w3) _ [] = (w1,w2,w3)
args2Args3
:: CLSpecifications
-> [String]
-> (Args,Args,Args)
args2Args3 = args2Args3' ([],[],[])
{-# INLINE args2Args3 #-}
-- | 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 ts = filter notNullArguments . map b1Args2AArgs . args2Args ts
{-# INLINE args2ArgsFiltered #-}
takeCs
:: CLSpecifications
-> [String]
-> Args
takeCs ts = filter (\x -> notNullArguments x && isC x) . map b1Args2AArgs . args2Args ts
{-# INLINE takeCs #-}
takeBs
:: CLSpecifications
-> [String]
-> Args
takeBs ts = filter (\x -> notNullArguments x && isB x) . map b1Args2AArgs . args2Args ts
{-# INLINE takeBs #-}
takeAs
:: CLSpecifications
-> [String]
-> Args
takeAs ts = filter (\x -> notNullArguments x && isA x) . map b1Args2AArgs . args2Args ts
{-# INLINE takeAs #-}
------------------------------------------------------
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 f ts = sortBy f . filter (\x -> notNullArguments x && isC x) . map b1Args2AArgs . args2Args ts
{-# INLINE takeCsSortedBy #-}
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 f ts = sortBy f . filter (\x -> notNullArguments x && isB x) . map b1Args2AArgs . args2Args ts
{-# INLINE 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 f ts = sortBy f . filter (\x -> notNullArguments x && isA x) . map b1Args2AArgs . args2Args ts
{-# INLINE takeAsSortedBy #-}
------------------------------------------------------
takeCsArr
:: CLSpecifications
-> [String]
-> Array Int Arguments
takeCsArr ts xss
| null xss = error "CLI.Arguments.takeCsArr: Empty list of 'String's."
| otherwise = listArray (0,l-1) js
where js = filter (\x -> notNullArguments x && isC x) . map b1Args2AArgs . args2Args ts $ xss
l = length js
{-# INLINE takeCsArr #-}
takeBsArr
:: CLSpecifications
-> [String]
-> Array Int Arguments
takeBsArr ts xss
| null xss = error "CLI.Arguments.takeBsArr: Empty list of 'String's."
| otherwise = listArray (0,l-1) js
where js = filter (\x -> notNullArguments x && isB x) . map b1Args2AArgs . args2Args ts $ xss
l = length js
{-# INLINE takeBsArr #-}
takeAsArr
:: CLSpecifications
-> [String]
-> Array Int Arguments
takeAsArr ts xss
| null xss = error "CLI.Arguments.takeBsArr: Empty list of 'String's."
| otherwise = listArray (0,l-1) js
where js = filter (\x -> notNullArguments x && isA x) . map b1Args2AArgs . args2Args ts $ xss
l = length js
{-# INLINE takeAsArr #-}
---------------------------------------------------
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 f ts xss
| null xss = error "CLI.Arguments.takeCsArrSortedBy: Empty list of 'String's."
| otherwise = listArray (0,l-1) js
where js = sortBy f . filter (\x -> notNullArguments x && isC x) . map b1Args2AArgs . args2Args ts $ xss
l = length js
{-# INLINE takeCsArrSortedBy #-}
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 f ts xss
| null xss = error "CLI.Arguments.takeBsArrSortedBy: Empty list of 'String's."
| otherwise = listArray (0,l-1) js
where js = sortBy f . filter (\x -> notNullArguments x && isB x) . map b1Args2AArgs . args2Args ts $ xss
l = length js
{-# INLINE takeBsArrSortedBy #-}
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 f ts xss
| null xss = error "CLI.Arguments.takeBsArrSortedBy: Empty list of 'String's."
| otherwise = listArray (0,l-1) js
where js = sortBy f . filter (\x -> notNullArguments x && isA x) . map b1Args2AArgs . args2Args ts $ xss
l = length js
{-# INLINE takeAsArrSortedBy #-}