{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE StrictData, Strict #-}
-- |
-- Module      :  CLI.Arguments.Get.Strict
-- Copyright   :  (c) OleksandrZhabenko 2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- A library to process command line arguments in some more convenient way.

module CLI.Arguments.Get.Strict where

import Data.Maybe (fromJust)
import qualified Data.Foldable as F
import CLI.Arguments.Strict

oneA
 :: (F.Foldable t) => String -> t Arguments -> Bool
oneA :: String -> t Arguments -> Bool
oneA String
xs t Arguments
ys = (Arguments -> Bool) -> t Arguments -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any (\(A String
ts) -> String
ts String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) t Arguments
ys

oneB
 :: (F.Foldable t) => String -> t Arguments -> Bool
oneB :: String -> t Arguments -> Bool
oneB String
xs t Arguments
ys = (Arguments -> Bool) -> t Arguments -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any (\(B GQtyArgs
_ String
zs [String]
_) -> String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) t Arguments
ys

oneC
 :: (F.Foldable t) => String -> t Arguments -> Bool
oneC :: String -> t Arguments -> Bool
oneC String
xs t Arguments
ys = (Arguments -> Bool) -> t Arguments -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any (\(C String
zs [String]
_) -> String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) t Arguments
ys

listA
 :: (F.Foldable t) => [String] -> t Arguments -> Bool
listA :: [String] -> t Arguments -> Bool
listA [String]
xss t Arguments
ys
  | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = Bool
False
  | Bool
otherwise = (Arguments -> Bool) -> t Arguments -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any (\(A String
ts) -> String
ts String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
xss) t Arguments
ys

listB
 :: (F.Foldable t) => [String] -> t Arguments -> Bool
listB :: [String] -> t Arguments -> Bool
listB [String]
xss t Arguments
ys
  | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = Bool
False
  | Bool
otherwise = (Arguments -> Bool) -> t Arguments -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any (\(B GQtyArgs
_ String
zs [String]
_) -> String
zs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
xss) t Arguments
ys

listC
 :: (F.Foldable t) => [String] -> t Arguments -> Bool
listC :: [String] -> t Arguments -> Bool
listC [String]
xss t Arguments
ys
  | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = Bool
False
  | Bool
otherwise = (Arguments -> Bool) -> t Arguments -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any (\(C String
zs [String]
_) -> String
zs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
xss) t Arguments
ys

getA
 :: (F.Foldable t) => String -> t Arguments -> String
getA :: String -> t Arguments -> String
getA String
xs t Arguments
ys
  | String -> t Arguments -> Bool
forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneA String
xs t Arguments
ys = (\(A String
ts) -> String
ts) (Arguments -> String)
-> (t Arguments -> Arguments) -> t Arguments -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Arguments -> Arguments
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Arguments -> Arguments)
-> (t Arguments -> Maybe Arguments) -> t Arguments -> Arguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arguments -> Bool) -> t Arguments -> Maybe Arguments
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\(A String
rs) -> String
rs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) (t Arguments -> String) -> t Arguments -> String
forall a b. (a -> b) -> a -> b
$ t Arguments
ys
  | Bool
otherwise = []

getB
 :: (F.Foldable t) => String -> t Arguments -> [String]
getB :: String -> t Arguments -> [String]
getB String
xs t Arguments
ys
  | String -> t Arguments -> Bool
forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneB String
xs t Arguments
ys =  (\(B GQtyArgs
_ String
_ [String]
yss) -> [String]
yss) (Arguments -> [String])
-> (t Arguments -> Arguments) -> t Arguments -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Arguments -> Arguments
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Arguments -> Arguments)
-> (t Arguments -> Maybe Arguments) -> t Arguments -> Arguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arguments -> Bool) -> t Arguments -> Maybe Arguments
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\(B GQtyArgs
_ String
zs [String]
_) -> String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) (t Arguments -> [String]) -> t Arguments -> [String]
forall a b. (a -> b) -> a -> b
$ t Arguments
ys
  | Bool
otherwise = []

getC
 :: (F.Foldable t) => String -> t Arguments -> [String]
getC :: String -> t Arguments -> [String]
getC String
xs t Arguments
ys
  | String -> t Arguments -> Bool
forall (t :: * -> *). Foldable t => String -> t Arguments -> Bool
oneC String
xs t Arguments
ys = (\(C String
_ [String]
yss) -> [String]
yss) (Arguments -> [String])
-> (t Arguments -> Arguments) -> t Arguments -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Arguments -> Arguments
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Arguments -> Arguments)
-> (t Arguments -> Maybe Arguments) -> t Arguments -> Arguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Arguments -> Bool) -> t Arguments -> Maybe Arguments
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\(C String
zs [String]
_) -> String
zs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
xs) (t Arguments -> [String]) -> t Arguments -> [String]
forall a b. (a -> b) -> a -> b
$ t Arguments
ys
  | Bool
otherwise = []

getLstA
 :: (F.Foldable t) => [String] -> t Arguments -> [String]
getLstA :: [String] -> t Arguments -> [String]
getLstA [String]
xss t Arguments
ys
  | [String] -> t Arguments -> Bool
forall (t :: * -> *). Foldable t => [String] -> t Arguments -> Bool
listA [String]
xss t Arguments
ys = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> String -> t Arguments -> String
forall (t :: * -> *). Foldable t => String -> t Arguments -> String
getA String
xs t Arguments
ys) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
xss
  | Bool
otherwise = []

getLstB
 :: (F.Foldable t) => [String] -> t Arguments -> [[String]]
getLstB :: [String] -> t Arguments -> [[String]]
getLstB [String]
xss t Arguments
ys
  | [String] -> t Arguments -> Bool
forall (t :: * -> *). Foldable t => [String] -> t Arguments -> Bool
listB [String]
xss t Arguments
ys = ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[String]] -> [[String]])
-> ([String] -> [[String]]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> String -> t Arguments -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getB String
xs t Arguments
ys) ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [String]
xss
  | Bool
otherwise = []

getLstC
 :: (F.Foldable t) => [String] -> t Arguments -> [[String]]
getLstC :: [String] -> t Arguments -> [[String]]
getLstC [String]
xss t Arguments
ys
  | [String] -> t Arguments -> Bool
forall (t :: * -> *). Foldable t => [String] -> t Arguments -> Bool
listC [String]
xss t Arguments
ys = ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[String]] -> [[String]])
-> ([String] -> [[String]]) -> [String] -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (\String
xs -> String -> t Arguments -> [String]
forall (t :: * -> *).
Foldable t =>
String -> t Arguments -> [String]
getC String
xs t Arguments
ys) ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [String]
xss
  | Bool
otherwise = []