module Chiasma.Class.CmdArgs where

import qualified Data.Map.Strict as Map
import Exon (exon)

import Chiasma.Data.Ident (Ident, identText)

class CmdArgs a where
  cmdArgs :: a -> [Text]

flag :: [Text] -> Bool -> [Text]
flag :: [Text] -> Bool -> [Text]
flag =
  [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool []

flag1 :: Text -> Bool -> [Text]
flag1 :: Text -> Bool -> [Text]
flag1 =
  [Text] -> Bool -> [Text]
flag ([Text] -> Bool -> [Text])
-> (Text -> [Text]) -> Text -> Bool -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

optionWith :: Text -> (a -> Text) -> Maybe a -> [Text]
optionWith :: forall a. Text -> (a -> Text) -> Maybe a -> [Text]
optionWith Text
flg a -> Text
f =
  (a -> [Text]) -> Maybe a -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \ a
a -> [Text
Item [Text]
flg, a -> Text
f a
a]

option :: Text -> Maybe Text -> [Text]
option :: Text -> Maybe Text -> [Text]
option Text
flg =
  Text -> (Text -> Text) -> Maybe Text -> [Text]
forall a. Text -> (a -> Text) -> Maybe a -> [Text]
optionWith Text
flg Text -> Text
forall a. a -> a
id

identOption :: Text -> Maybe Ident -> [Text]
identOption :: Text -> Maybe Ident -> [Text]
identOption Text
flg =
  Text -> (Ident -> Text) -> Maybe Ident -> [Text]
forall a. Text -> (a -> Text) -> Maybe a -> [Text]
optionWith Text
flg Ident -> Text
identText

arg :: Maybe Text -> [Text]
arg :: Maybe Text -> [Text]
arg =
  Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList

envVars :: Map Text Text -> [Text]
envVars :: Map Text Text -> [Text]
envVars =
  ((Text, Text) -> [Text]) -> [(Text, Text)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \case
    (Text
k, Text
v) -> [Item [Text]
"-e", [exon|#{k}=#{v}|]]
  ([(Text, Text)] -> [Text])
-> (Map Text Text -> [(Text, Text)]) -> Map Text Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList

optionArgs ::
  CmdArgs a =>
  Maybe a ->
  [Text]
optionArgs :: forall a. CmdArgs a => Maybe a -> [Text]
optionArgs =
  (a -> [Text]) -> Maybe a -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> [Text]
forall a. CmdArgs a => a -> [Text]
cmdArgs

optionArgsWith ::
  CmdArgs a =>
  Text ->
  Maybe a ->
  [Text]
optionArgsWith :: forall a. CmdArgs a => Text -> Maybe a -> [Text]
optionArgsWith Text
flg =
  (a -> [Text]) -> Maybe a -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \ a
a -> Text
flg Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: a -> [Text]
forall a. CmdArgs a => a -> [Text]
cmdArgs a
a