{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | This module parses strings coming from the command line
--   and tries to classify them as:
--
--     - option names + their associated values
--     - flag names
--     - arguments
--
--    It is however not always possible to know if a given list of string is:
--
--      - an option name + some values: find --files file1 file2
--      - a flag name + some arguments: copy --force source target
--
--    During lexing we leave this last case as "ambiguous".
--    This will be disambiguated during parsing where we know if
--    a given name is an option or a flag.
module Data.Registry.Options.Lexemes where

import Data.List qualified as L
import Data.Map.Strict qualified as Map
import Data.MultiMap (MultiMap)
import Data.MultiMap qualified as M
import Data.Text qualified as T
import Protolude as P
import Prelude (show)

-- | This data type helps pre-parsing option names and values
data Lexemes = Lexemes
  { -- | list of option names and associated values
    Lexemes -> MultiMap Text Text
lexedOptions :: MultiMap Text Text,
    -- | list of flag names
    Lexemes -> [Text]
lexedFlags :: [Text],
    -- | list of argument values
    Lexemes -> [Text]
lexedArguments :: [Text],
    -- | possible ambiguous case: option + values or flag + arguments
    Lexemes -> Maybe (Text, [Text])
lexedAmbiguous :: Maybe (Text, [Text])
  }
  deriving (Lexemes -> Lexemes -> Bool
(Lexemes -> Lexemes -> Bool)
-> (Lexemes -> Lexemes -> Bool) -> Eq Lexemes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lexemes -> Lexemes -> Bool
$c/= :: Lexemes -> Lexemes -> Bool
== :: Lexemes -> Lexemes -> Bool
$c== :: Lexemes -> Lexemes -> Bool
Eq, Int -> Lexemes -> ShowS
[Lexemes] -> ShowS
Lexemes -> String
(Int -> Lexemes -> ShowS)
-> (Lexemes -> String) -> ([Lexemes] -> ShowS) -> Show Lexemes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lexemes] -> ShowS
$cshowList :: [Lexemes] -> ShowS
show :: Lexemes -> String
$cshow :: Lexemes -> String
showsPrec :: Int -> Lexemes -> ShowS
$cshowsPrec :: Int -> Lexemes -> ShowS
Show)

instance Semigroup Lexemes where
  <> :: Lexemes -> Lexemes -> Lexemes
(<>) = Lexemes -> Lexemes -> Lexemes
union

instance Monoid Lexemes where
  mempty :: Lexemes
mempty = MultiMap Text Text
-> [Text] -> [Text] -> Maybe (Text, [Text]) -> Lexemes
Lexemes MultiMap Text Text
forall k a. MultiMap k a
M.empty [Text]
forall a. Monoid a => a
mempty [Text]
forall a. Monoid a => a
mempty Maybe (Text, [Text])
forall a. Maybe a
Nothing
  mappend :: Lexemes -> Lexemes -> Lexemes
mappend = Lexemes -> Lexemes -> Lexemes
forall a. Semigroup a => a -> a -> a
(<>)

-- | Concatenate 2 lists of lexemes
union :: Lexemes -> Lexemes -> Lexemes
union :: Lexemes -> Lexemes -> Lexemes
union (Lexemes MultiMap Text Text
m1 [Text]
fs1 [Text]
as1 Maybe (Text, [Text])
am1) (Lexemes MultiMap Text Text
m2 [Text]
fs2 [Text]
as2 Maybe (Text, [Text])
am2) =
  MultiMap Text Text
-> [Text] -> [Text] -> Maybe (Text, [Text]) -> Lexemes
Lexemes
    ([(Text, Text)] -> MultiMap Text Text
forall k a. Ord k => [(k, a)] -> MultiMap k a
M.fromList ([(Text, Text)] -> MultiMap Text Text)
-> [(Text, Text)] -> MultiMap Text Text
forall a b. (a -> b) -> a -> b
$ MultiMap Text Text -> [(Text, Text)]
forall k a. MultiMap k a -> [(k, a)]
M.toList MultiMap Text Text
m1 [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> MultiMap Text Text -> [(Text, Text)]
forall k a. MultiMap k a -> [(k, a)]
M.toList MultiMap Text Text
m2)
    ([Text]
fs1 [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
fs2)
    ([Text]
as1 [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
as2)
    (Maybe (Text, [Text])
am1 Maybe (Text, [Text])
-> Maybe (Text, [Text]) -> Maybe (Text, [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Text, [Text])
am2)

-- | Override the values from one Lexemes with the values from another
--   This is a bit tricky since ambiguous option/flags coming from the command can eventually
--   be detected to be valid options / flags when parsed as such in the environment or in a config file
override :: Lexemes -> Lexemes -> Lexemes
override :: Lexemes -> Lexemes -> Lexemes
override (Lexemes MultiMap Text Text
m1 [Text]
fs1 [Text]
as1 Maybe (Text, [Text])
am1) (Lexemes MultiMap Text Text
m2 [Text]
fs2 [Text]
as2 Maybe (Text, [Text])
am2) =
  MultiMap Text Text
-> [Text] -> [Text] -> Maybe (Text, [Text]) -> Lexemes
Lexemes
    MultiMap Text Text
mergeOptions
    ([Text] -> [Text] -> [Text]
mergeMax [Text]
fs1 [Text]
fs2)
    ([Text]
as1 [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
as2)
    Maybe (Text, [Text])
mergeAmbiguous
  where
    -- merge 2 lists so that every unique element of each list is present
    -- if there are duplicates in one list or the other, the max number of duplicates is kept
    mergeMax :: [Text] -> [Text] -> [Text]
    mergeMax :: [Text] -> [Text] -> [Text]
mergeMax [Text]
vs1 [Text]
vs2 = do
      let g1 :: Map Text [Text]
g1 = [Text] -> Map Text [Text]
forall a. Ord a => [a] -> Map a [a]
groupByEq [Text]
vs1
      let g2 :: Map Text [Text]
g2 = [Text] -> Map Text [Text]
forall a. Ord a => [a] -> Map a [a]
groupByEq [Text]
vs2
      [[Text]] -> [Text]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Text]] -> [Text])
-> (Map Text [Text] -> [[Text]]) -> Map Text [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text [Text] -> [[Text]]
forall k a. Map k a -> [a]
Map.elems (Map Text [Text] -> [Text]) -> Map Text [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ ([Text] -> [Text] -> [Text])
-> Map Text [Text] -> Map Text [Text] -> Map Text [Text]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\[Text]
v1 [Text]
v2 -> if [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
v1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
v2 then [Text]
v1 else [Text]
v2) Map Text [Text]
g1 Map Text [Text]
g2

    groupByEq :: Ord a => [a] -> Map a [a]
    groupByEq :: forall a. Ord a => [a] -> Map a [a]
groupByEq = MultiMap a a -> Map a [a]
forall k a. MultiMap k a -> Map k [a]
M.toMap (MultiMap a a -> Map a [a])
-> ([a] -> MultiMap a a) -> [a] -> Map a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> MultiMap a a
forall k a. Ord k => [(k, a)] -> MultiMap k a
M.fromList ([(a, a)] -> MultiMap a a)
-> ([a] -> [(a, a)]) -> [a] -> MultiMap a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, a)) -> [a] -> [(a, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, a
a))

    mergeOptions :: MultiMap Text Text
mergeOptions = do
      let allOptions :: MultiMap Text Text
allOptions = Map Text [Text] -> MultiMap Text Text
forall k a. Map k [a] -> MultiMap k a
M.fromMap (Map Text [Text] -> MultiMap Text Text)
-> ([(Text, [Text])] -> Map Text [Text])
-> [(Text, [Text])]
-> MultiMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, [Text])] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, [Text])] -> MultiMap Text Text)
-> [(Text, [Text])] -> MultiMap Text Text
forall a b. (a -> b) -> a -> b
$ MultiMap Text Text -> [(Text, [Text])]
forall k a. MultiMap k a -> [(k, [a])]
M.assocs MultiMap Text Text
m1 [(Text, [Text])] -> [(Text, [Text])] -> [(Text, [Text])]
forall a. Semigroup a => a -> a -> a
<> MultiMap Text Text -> [(Text, [Text])]
forall k a. MultiMap k a -> [(k, [a])]
M.assocs MultiMap Text Text
m2
      case (Maybe (Text, [Text])
am1, Maybe (Text, [Text])
am2) of
        -- no ambiguous options
        (Maybe (Text, [Text])
Nothing, Maybe (Text, [Text])
Nothing) -> MultiMap Text Text
allOptions
        (Just (Text, [Text])
_, Maybe (Text, [Text])
Nothing) -> MultiMap Text Text
allOptions
        (Maybe (Text, [Text])
_, Just (Text
t2, [Text]
v2)) ->
          if Text
t2 Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` MultiMap Text Text -> [Text]
forall k a. MultiMap k a -> [k]
M.keys MultiMap Text Text
allOptions then Map Text [Text] -> MultiMap Text Text
forall k a. Map k [a] -> MultiMap k a
M.fromMap (Map Text [Text] -> MultiMap Text Text)
-> Map Text [Text] -> MultiMap Text Text
forall a b. (a -> b) -> a -> b
$ [(Text, [Text])] -> Map Text [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (MultiMap Text Text -> [(Text, [Text])]
forall k a. MultiMap k a -> [(k, [a])]
M.assocs MultiMap Text Text
allOptions [(Text, [Text])] -> [(Text, [Text])] -> [(Text, [Text])]
forall a. Semigroup a => a -> a -> a
<> [(Text
t2, [Text]
v2)]) else MultiMap Text Text
allOptions

    mergeAmbiguous :: Maybe (Text, [Text])
mergeAmbiguous =
      case (Maybe (Text, [Text])
am1, Maybe (Text, [Text])
am2) of
        (Maybe (Text, [Text])
Nothing, Maybe (Text, [Text])
Nothing) -> Maybe (Text, [Text])
forall a. Maybe a
Nothing
        (Just (Text, [Text])
_, Just (Text
t2, [Text]
vs2)) -> (Text, [Text]) -> Maybe (Text, [Text])
forall a. a -> Maybe a
Just (Text
t2, [Text]
vs2)
        (Just (Text
t1, [Text]
vs1), Maybe (Text, [Text])
Nothing) ->
          if Text
t1 Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` MultiMap Text Text -> [Text]
forall k a. MultiMap k a -> [k]
M.keys MultiMap Text Text
m2 then Maybe (Text, [Text])
forall a. Maybe a
Nothing else (Text, [Text]) -> Maybe (Text, [Text])
forall a. a -> Maybe a
Just (Text
t1, [Text]
vs1)
        (Maybe (Text, [Text])
Nothing, Just (Text
t2, [Text]
vs2)) ->
          if Text
t2 Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` MultiMap Text Text -> [Text]
forall k a. MultiMap k a -> [k]
M.keys MultiMap Text Text
m1 then Maybe (Text, [Text])
forall a. Maybe a
Nothing else (Text, [Text]) -> Maybe (Text, [Text])
forall a. a -> Maybe a
Just (Text
t2, [Text]
vs2)

-- * Create lexemes

-- | Lex some input arguments
--   They are first stripped of additional whitespace
--   and empty strings are removed (there shouldn't be any though, coming from the command line)
lexArgs :: [Text] -> Lexemes
lexArgs :: [Text] -> Lexemes
lexArgs = [Text] -> Lexemes
mkLexemes ([Text] -> Lexemes) -> ([Text] -> [Text]) -> [Text] -> Lexemes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip

-- | Lex some input arguments
mkLexemes :: [Text] -> Lexemes
mkLexemes :: [Text] -> Lexemes
mkLexemes [] = Lexemes
forall a. Monoid a => a
mempty
mkLexemes (Text
"--" : [Text]
rest) = [Text] -> Lexemes
argsLexemes [Text]
rest
mkLexemes [Text
t] =
  -- this is either a single flag or an argument
  if Text -> Bool
isDashed Text
t
    then -- if there is an = sign this an option

      if Text
"=" Text -> Text -> Bool
`T.isInfixOf` Text
t
        then Text -> Lexemes
makeEqualOptionLexeme Text
t
        else Text -> Lexemes
makeFlagsLexeme Text
t
    else Text -> Lexemes
argLexemes (Text -> Text
dropDashed Text
t)
mkLexemes (Text
t : [Text]
rest) =
  -- if we get an option name
  if Text -> Bool
isDashed Text
t
    then -- if the option value is appended directly to the option name

      if Text
"=" Text -> Text -> Bool
`T.isInfixOf` Text
t
        then Text -> Lexemes
makeEqualOptionLexeme Text
t Lexemes -> Lexemes -> Lexemes
forall a. Semigroup a => a -> a -> a
<> [Text] -> Lexemes
mkLexemes [Text]
rest
        else -- otherwise
        do
          let key :: Text
key = Text -> Text
dropDashed Text
t
          let ([Text]
vs, [Text]
others) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break Text -> Bool
isDashed [Text]
rest
          -- if there are no values after the option name, we have a flag
          if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
vs
            then Text -> Lexemes
makeFlagsLexeme Text
t Lexemes -> Lexemes -> Lexemes
forall a. Semigroup a => a -> a -> a
<> [Text] -> Lexemes
mkLexemes [Text]
others
            else -- otherwise

            -- if there are additional options/flags, then we collect values for the
            -- current option and make lexemes for the rest

              if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
isDashed [Text]
others
                then Text -> [Text] -> Lexemes
optionsLexemes Text
key [Text]
vs Lexemes -> Lexemes -> Lexemes
forall a. Semigroup a => a -> a -> a
<> [Text] -> Lexemes
mkLexemes [Text]
others
                else -- this case is ambiguous, possibly the values are repeated values for an option
                -- or the option is a flag with no values and all the rest are arguments
                  Text -> [Text] -> Lexemes
ambiguousLexemes Text
key [Text]
rest
    else Text -> Lexemes
argLexemes Text
t Lexemes -> Lexemes -> Lexemes
forall a. Semigroup a => a -> a -> a
<> [Text] -> Lexemes
mkLexemes [Text]
rest

-- | Create lexemes for an option name + an option value
optionLexemes :: Text -> Text -> Lexemes
optionLexemes :: Text -> Text -> Lexemes
optionLexemes Text
k = Text -> [Text] -> Lexemes
optionsLexemes Text
k ([Text] -> Lexemes) -> (Text -> [Text]) -> Text -> Lexemes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Create lexemes for an option name + a list of option values
optionsLexemes :: Text -> [Text] -> Lexemes
optionsLexemes :: Text -> [Text] -> Lexemes
optionsLexemes Text
k [Text]
vs = MultiMap Text Text
-> [Text] -> [Text] -> Maybe (Text, [Text]) -> Lexemes
Lexemes ([(Text, Text)] -> MultiMap Text Text
forall k a. Ord k => [(k, a)] -> MultiMap k a
M.fromList ((Text
k,) (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
vs)) [Text]
forall a. Monoid a => a
mempty [Text]
forall a. Monoid a => a
mempty Maybe (Text, [Text])
forall a. Maybe a
Nothing

-- | Create an option for --option=value or -o=value
--   Return mempty if no equal sign is present
makeEqualOptionLexeme :: Text -> Lexemes
makeEqualOptionLexeme :: Text -> Lexemes
makeEqualOptionLexeme Text
t = do
  case Text -> Text -> [Text]
T.splitOn Text
"=" (Text -> Text
dropDashed Text
t) of
    [Text
optionName, Text
optionValue] -> Text -> Text -> Lexemes
optionLexemes Text
optionName Text
optionValue
    -- this case should not happen
    [Text]
_ -> Lexemes
forall a. Monoid a => a
mempty

-- | Create lexemes for a list of potentially short flag names
--   e.g. makeFlagsLexeme "-opq" === flagsLexemes ["o", "p", "q"]
makeFlagsLexeme :: Text -> Lexemes
makeFlagsLexeme :: Text -> Lexemes
makeFlagsLexeme Text
t =
  ( if Text -> Bool
isSingleDashed Text
t
      then -- split the letters
        [Text] -> Lexemes
flagsLexemes ([Text] -> Lexemes) -> (Text -> [Text]) -> Text -> Lexemes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> String -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
T.singleton (String -> [Text]) -> (Text -> String) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
      else Text -> Lexemes
flagLexemes
  )
    (Text -> Text
dropDashed Text
t)

-- | Create lexemes for a flag name
flagLexemes :: Text -> Lexemes
flagLexemes :: Text -> Lexemes
flagLexemes = [Text] -> Lexemes
flagsLexemes ([Text] -> Lexemes) -> (Text -> [Text]) -> Text -> Lexemes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Create lexemes for a list of flag names
flagsLexemes :: [Text] -> Lexemes
flagsLexemes :: [Text] -> Lexemes
flagsLexemes [Text]
fs = MultiMap Text Text
-> [Text] -> [Text] -> Maybe (Text, [Text]) -> Lexemes
Lexemes MultiMap Text Text
forall k a. MultiMap k a
M.empty [Text]
fs [Text]
forall a. Monoid a => a
mempty Maybe (Text, [Text])
forall a. Maybe a
Nothing

-- | Create lexemes for an argument value
argLexemes :: Text -> Lexemes
argLexemes :: Text -> Lexemes
argLexemes = [Text] -> Lexemes
argsLexemes ([Text] -> Lexemes) -> (Text -> [Text]) -> Text -> Lexemes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Create lexemes for several arguments
argsLexemes :: [Text] -> Lexemes
argsLexemes :: [Text] -> Lexemes
argsLexemes [Text]
ts = MultiMap Text Text
-> [Text] -> [Text] -> Maybe (Text, [Text]) -> Lexemes
Lexemes MultiMap Text Text
forall k a. MultiMap k a
M.empty [Text]
forall a. Monoid a => a
mempty [Text]
ts Maybe (Text, [Text])
forall a. Maybe a
Nothing

-- | Create lexemes an ambiguous flag an its values
--   Later parsing will indicate if the name is an option names and the values the option values
--   or if this is a flag + arguments
ambiguousLexemes :: Text -> [Text] -> Lexemes
ambiguousLexemes :: Text -> [Text] -> Lexemes
ambiguousLexemes Text
t [Text]
ts = MultiMap Text Text
-> [Text] -> [Text] -> Maybe (Text, [Text]) -> Lexemes
Lexemes MultiMap Text Text
forall k a. MultiMap k a
M.empty [Text]
forall a. Monoid a => a
mempty [Text]
forall a. Monoid a => a
mempty ((Text, [Text]) -> Maybe (Text, [Text])
forall a. a -> Maybe a
Just (Text
t, [Text]
ts))

-- | Return the possible list of argument values to parse from
--   Note that there can be ambiguous flags
getArguments :: Lexemes -> [Text]
getArguments :: Lexemes -> [Text]
getArguments (Lexemes MultiMap Text Text
_ [Text]
_ [Text]
as Maybe (Text, [Text])
Nothing) = [Text]
as
getArguments (Lexemes MultiMap Text Text
_ [Text]
_ [Text]
as1 (Just (Text
_, [Text]
as2))) = [Text]
as1 [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
as2

-- | Return option/flag names from lexed values
getFlagNames :: Lexemes -> [Text]
getFlagNames :: Lexemes -> [Text]
getFlagNames (Lexemes MultiMap Text Text
m [Text]
fs [Text]
_ Maybe (Text, [Text])
am) = MultiMap Text Text -> [Text]
forall k a. MultiMap k a -> [k]
M.keys MultiMap Text Text
m [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
fs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ((Text, [Text]) -> Text
forall a b. (a, b) -> a
fst ((Text, [Text]) -> Text) -> [(Text, [Text])] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, [Text]) -> [(Text, [Text])]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (Text, [Text])
am)

-- | Return a value for a given name
--   This can be a value associated to a given option
--   or just a flag name acting as a value to decode
--   (the value can also come from an ambiguous option value)
getValue :: Text -> Lexemes -> Maybe (Maybe Text)
getValue :: Text -> Lexemes -> Maybe (Maybe Text)
getValue Text
key (Lexemes MultiMap Text Text
options [Text]
flags [Text]
_ Maybe (Text, [Text])
ambiguous) =
  case [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMay (Text -> MultiMap Text Text -> [Text]
forall k a. Ord k => k -> MultiMap k a -> [a]
M.lookup Text
key MultiMap Text Text
options) of
    Just Text
v -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v)
    Maybe Text
Nothing ->
      case (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key) [Text]
flags of
        Just Text
_ -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing
        Maybe Text
Nothing -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Maybe Text -> Maybe (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, [Text]) -> Maybe Text
getAmbiguousValue Maybe (Text, [Text])
ambiguous
  where
    getAmbiguousValue :: Maybe (Text, [Text]) -> Maybe Text
getAmbiguousValue Maybe (Text, [Text])
Nothing = Maybe Text
forall a. Maybe a
Nothing
    getAmbiguousValue (Just (Text
k, [Text]
vs)) =
      if Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key
        then [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMay [Text]
vs
        else Maybe Text
forall a. Maybe a
Nothing

-- | Remove the value associated to an option name
--   The value might be:
--     - associated to an option name
--     - the name of a flag
--     - associated to an ambiguous flag name
popOptionValue :: Text -> Lexemes -> Lexemes
popOptionValue :: Text -> Lexemes -> Lexemes
popOptionValue Text
key Lexemes
ls =
  Lexemes
ls
    { lexedOptions :: MultiMap Text Text
lexedOptions = Text -> MultiMap Text Text -> MultiMap Text Text
forall k v. Ord k => k -> MultiMap k v -> MultiMap k v
pop Text
key (MultiMap Text Text -> MultiMap Text Text)
-> MultiMap Text Text -> MultiMap Text Text
forall a b. (a -> b) -> a -> b
$ Lexemes -> MultiMap Text Text
lexedOptions Lexemes
ls,
      lexedFlags :: [Text]
lexedFlags = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
key) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Lexemes -> [Text]
lexedFlags Lexemes
ls,
      lexedAmbiguous :: Maybe (Text, [Text])
lexedAmbiguous = case Lexemes -> Maybe (Text, [Text])
lexedAmbiguous Lexemes
ls of
        Just (Text
k, []) | Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key -> Maybe (Text, [Text])
forall a. Maybe a
Nothing
        Just (Text
k, Text
_ : [Text]
as) | Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
key -> (Text, [Text]) -> Maybe (Text, [Text])
forall a. a -> Maybe a
Just (Text
k, [Text]
as)
        Maybe (Text, [Text])
other -> Maybe (Text, [Text])
other
    }

-- | Remove an argument value
--   first from the list of arguments if there are some`
--   otherwise remove a value in the list of values associated to an ambiguous flag
popArgumentValue :: Lexemes -> Lexemes
popArgumentValue :: Lexemes -> Lexemes
popArgumentValue Lexemes
ls =
  case Lexemes -> [Text]
lexedArguments Lexemes
ls of
    (Text
_ : [Text]
as) -> Lexemes
ls {lexedArguments :: [Text]
lexedArguments = [Text]
as}
    [] ->
      Lexemes
ls
        { lexedAmbiguous :: Maybe (Text, [Text])
lexedAmbiguous = case Lexemes -> Maybe (Text, [Text])
lexedAmbiguous Lexemes
ls of
            Maybe (Text, [Text])
Nothing -> Maybe (Text, [Text])
forall a. Maybe a
Nothing
            Just (Text
_, []) -> Maybe (Text, [Text])
forall a. Maybe a
Nothing
            Just (Text
k, Text
_ : [Text]
as) -> (Text, [Text]) -> Maybe (Text, [Text])
forall a. a -> Maybe a
Just (Text
k, [Text]
as)
        }

-- | Remove a flag
--   If the flag is actually an ambiguous flag with some associated values then
--   this means that those values were arguments and need to be treated as such
popFlag :: Text -> Lexemes -> Lexemes
popFlag :: Text -> Lexemes -> Lexemes
popFlag Text
f Lexemes
ls = do
  let ([Text]
before, [Text]
after) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
f) ([Text] -> ([Text], [Text])) -> [Text] -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ Lexemes -> [Text]
lexedFlags Lexemes
ls
  let ([Text]
args, Maybe (Text, [Text])
amb) =
        case Lexemes -> Maybe (Text, [Text])
lexedAmbiguous Lexemes
ls of
          Just (Text
k, [Text]
vs) | Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k -> ([Text]
vs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Lexemes -> [Text]
lexedArguments Lexemes
ls, Maybe (Text, [Text])
forall a. Maybe a
Nothing)
          Maybe (Text, [Text])
other -> (Lexemes -> [Text]
lexedArguments Lexemes
ls, Maybe (Text, [Text])
other)

  Lexemes
ls
    { lexedFlags :: [Text]
lexedFlags = [Text]
before [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 [Text]
after,
      lexedArguments :: [Text]
lexedArguments = [Text]
args,
      lexedAmbiguous :: Maybe (Text, [Text])
lexedAmbiguous = Maybe (Text, [Text])
amb
    }

-- | Return True if some text starts with `-`
isDashed :: Text -> Bool
isDashed :: Text -> Bool
isDashed = Text -> Text -> Bool
T.isPrefixOf Text
"-"

-- | Return True if some text starts with `-` but not with `--`
isSingleDashed :: Text -> Bool
isSingleDashed :: Text -> Bool
isSingleDashed Text
t = Text -> Text -> Bool
T.isPrefixOf Text
"-" Text
t Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Text -> Bool
T.isPrefixOf Text
"-" (Int -> Text -> Text
T.drop Int
1 Text
t))

-- | Drop dashes in front of a flag name
dropDashed :: Text -> Text
dropDashed :: Text -> Text
dropDashed = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')

-- * MultiMap functions

instance (Show k, Show v) => Show (MultiMap k v) where
  show :: MultiMap k v -> String
show = [(k, [v])] -> String
forall a b. (Show a, StringConv String b) => a -> b
P.show ([(k, [v])] -> String)
-> (MultiMap k v -> [(k, [v])]) -> MultiMap k v -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiMap k v -> [(k, [v])]
forall k a. MultiMap k a -> [(k, [a])]
M.assocs

instance (Eq k, Eq v) => Eq (MultiMap k v) where
  MultiMap k v
m1 == :: MultiMap k v -> MultiMap k v -> Bool
== MultiMap k v
m2 = MultiMap k v -> [(k, [v])]
forall k a. MultiMap k a -> [(k, [a])]
M.assocs MultiMap k v
m1 [(k, [v])] -> [(k, [v])] -> Bool
forall a. Eq a => a -> a -> Bool
== MultiMap k v -> [(k, [v])]
forall k a. MultiMap k a -> [(k, [a])]
M.assocs MultiMap k v
m2

-- | Drop the first value associated to a key in the map
--   If a key has no more values drop the key
pop :: (Ord k) => k -> MultiMap k v -> MultiMap k v
pop :: forall k v. Ord k => k -> MultiMap k v -> MultiMap k v
pop k
key MultiMap k v
m =
  Map k [v] -> MultiMap k v
forall k a. Map k [a] -> MultiMap k a
M.fromMap (Map k [v] -> MultiMap k v) -> Map k [v] -> MultiMap k v
forall a b. (a -> b) -> a -> b
$ [(k, [v])] -> Map k [v]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, [v])] -> Map k [v]) -> [(k, [v])] -> Map k [v]
forall a b. (a -> b) -> a -> b
$ ((k, [v]) -> Bool) -> [(k, [v])] -> [(k, [v])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((k, [v]) -> Bool) -> (k, [v]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([v] -> Bool) -> ((k, [v]) -> [v]) -> (k, [v]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, [v]) -> [v]
forall a b. (a, b) -> b
snd) ([(k, [v])] -> [(k, [v])]) -> [(k, [v])] -> [(k, [v])]
forall a b. (a -> b) -> a -> b
$ (\(k
k, [v]
vs) -> if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
key then (k
k, Int -> [v] -> [v]
forall a. Int -> [a] -> [a]
drop Int
1 [v]
vs) else (k
k, [v]
vs)) ((k, [v]) -> (k, [v])) -> [(k, [v])] -> [(k, [v])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MultiMap k v -> [(k, [v])]
forall k a. MultiMap k a -> [(k, [a])]
M.assocs MultiMap k v
m