{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE NoImplicitPrelude #-}

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

module CLI.Arguments.Get where

import GHC.Base
import GHC.List (filter, null, elem)
import Data.Maybe (fromJust)
import qualified Data.Foldable as F
import CLI.Arguments

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

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

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

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

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

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

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

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

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

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

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

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