{-# 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 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 < 1 = (C xs qss): args2Args ts (kss `mappend` rss) | n > 1 = (B n xs vss):args2Args ts (kss `mappend` zss) | otherwise = (A js):args2Args ts jss where (kss,uss) = break (== xs) xss wss = drop 1 uss (qss,pss) = break (== xs) wss rss = drop 1 pss (vss,zss) = splitAt n 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 ts = filter notNullArguments . map b1Args2AArgs . args2Args ts {-# INLINE args2ArgsFiltered #-}