    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE GADTs            #-}
    {-# LANGUAGE LambdaCase       #-}
    {-# LANGUAGE TupleSections    #-}
    {-# LANGUAGE ViewPatterns     #-}

    module WithCli.Modifier (
      Modifier(..),
      Modifiers,
      mkModifiers,
      isPositionalArgumentsField,
      getPositionalArgumentType,
      getVersion,

      applyModifiers,
      applyModifiersLong,

      -- exported for testing
      insertWith,
     ) where

    import           Prelude ()
    import           Prelude.Compat

    import           Control.Arrow
    import           Control.Monad
    import           Data.Char
    import           Data.List (foldl')
    import           Data.Maybe
    import           System.Console.GetOpt

    import           WithCli.Modifier.Types
    import           WithCli.Normalize
    import           WithCli.Parser
    import           WithCli.Result

    -- | 'Modifier's can be used to customize the command line parser.
    data Modifier
      = AddShortOption String Char
        -- ^ @AddShortOption fieldName c@ adds the 'Char' @c@ as a short option for
        --   the field addressed by @fieldName@.
      | RenameOption String String
        -- ^ @RenameOption fieldName customName@ renames the option generated
        --   through the @fieldName@ by @customName@.
      | RenameOptions (String -> Maybe String)
        -- ^ @RenameOptions f@ renames all options with the given functions. In case
        --   the function returns @Nothing@ the original field name is used.
        --
        --   Can be used together with 'Data.List.stripPrefix'.
      | UseForPositionalArguments String String
        -- ^ @UseForPositionalArguments fieldName argumentType@ fills the field
        --   addressed by @fieldName@ with the positional arguments (i.e. arguments
        --   that don't correspond to a flag). The field has to have type
        --   @['String']@.
        --
        --   @argumentType@ is used as the type of the positional arguments in the
        --   help output.
      | AddOptionHelp String String
        -- ^ @AddOptionHelp fieldName helpText@ adds a help text for the option
        --   @fieldName@.
      | AddVersionFlag String
        -- ^ @AddVersionFlag version@ adds a @--version@ flag.

    mkModifiers :: [Modifier] -> Result Modifiers
    mkModifiers :: [Modifier] -> Result Modifiers
    mkModifiers = (Modifiers -> Modifier -> Result Modifiers)
    -> Modifiers -> [Modifier] -> Result Modifiers
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Modifiers -> Modifier -> Result Modifiers
    inner Modifiers
    empty
      where
        empty :: Modifiers
        empty :: Modifiers
    empty = [(String, String)]
    -> (String -> String)
    -> Maybe (String, String)
    -> [(String, String)]
    -> Maybe String
    -> Modifiers
    Modifiers [] String -> String
    forall a. a -> a
    id Maybe (String, String)
    forall a. Maybe a
    Nothing [] Maybe String
    forall a. Maybe a
    Nothing

        inner :: Modifiers -> Modifier -> Result Modifiers
        inner :: Modifiers -> Modifier -> Result Modifiers
    inner (Modifiers [(String, String)]
    shorts String -> String
    renaming Maybe (String, String)
    args [(String, String)]
    help Maybe String
    version) Modifier
    modifier = case Modifier
    modifier of
          (AddShortOption String
    option Char
    short) ->
            Modifiers -> Result Modifiers
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Modifiers -> Result Modifiers) -> Modifiers -> Result Modifiers
    forall a b. (a -> b) -> a -> b
    $ [(String, String)]
    -> (String -> String)
    -> Maybe (String, String)
    -> [(String, String)]
    -> Maybe String
    -> Modifiers
    Modifiers ((String -> String -> String)
    -> String -> String -> [(String, String)] -> [(String, String)]
    forall a b. Eq a => (b -> b -> b) -> a -> b -> [(a, b)] -> [(a, b)]
    insertWith String -> String -> String
    forall a. [a] -> [a] -> [a]
    (++) String
    option [Char
    short] [(String, String)]
    shorts) String -> String
    renaming Maybe (String, String)
    args [(String, String)]
    help Maybe String
    version
          (RenameOption String
    from String
    to) ->
            let newRenaming :: String -> String
                newRenaming :: String -> String
    newRenaming String
    option = if String
    from String -> String -> Bool
    `matches` String
    option
                  then String
    to
                  else String
    option
            in Modifiers -> Result Modifiers
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Modifiers -> Result Modifiers) -> Modifiers -> Result Modifiers
    forall a b. (a -> b) -> a -> b
    $ [(String, String)]
    -> (String -> String)
    -> Maybe (String, String)
    -> [(String, String)]
    -> Maybe String
    -> Modifiers
    Modifiers [(String, String)]
    shorts (String -> String
    renaming (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    newRenaming) Maybe (String, String)
    args [(String, String)]
    help Maybe String
    version
          (RenameOptions String -> Maybe String
    newRenaming) ->
            Modifiers -> Result Modifiers
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Modifiers -> Result Modifiers) -> Modifiers -> Result Modifiers
    forall a b. (a -> b) -> a -> b
    $ [(String, String)]
    -> (String -> String)
    -> Maybe (String, String)
    -> [(String, String)]
    -> Maybe String
    -> Modifiers
    Modifiers [(String, String)]
    shorts (String -> String
    renaming (String -> String) -> (String -> Maybe String) -> String -> String
    forall a. (a -> a) -> (a -> Maybe a) -> a -> a
    `combineRenamings` String -> Maybe String
    newRenaming) Maybe (String, String)
    args [(String, String)]
    help Maybe String
    version
          (UseForPositionalArguments String
    option String
    typ) -> case Maybe (String, String)
    args of
            Maybe (String, String)
    Nothing -> Modifiers -> Result Modifiers
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Modifiers -> Result Modifiers) -> Modifiers -> Result Modifiers
    forall a b. (a -> b) -> a -> b
    $ [(String, String)]
    -> (String -> String)
    -> Maybe (String, String)
    -> [(String, String)]
    -> Maybe String
    -> Modifiers
    Modifiers [(String, String)]
    shorts String -> String
    renaming ((String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (String
    option, (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper String
    typ)) [(String, String)]
    help Maybe String
    version
            Just (String, String)
    _ -> String -> Result Modifiers
    forall a. String -> Result a
    Errors String
    "UseForPositionalArguments can only be used once"
          (AddOptionHelp String
    option String
    helpText) ->
            Modifiers -> Result Modifiers
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Modifiers -> Result Modifiers) -> Modifiers -> Result Modifiers
    forall a b. (a -> b) -> a -> b
    $ [(String, String)]
    -> (String -> String)
    -> Maybe (String, String)
    -> [(String, String)]
    -> Maybe String
    -> Modifiers
    Modifiers [(String, String)]
    shorts String -> String
    renaming Maybe (String, String)
    args (String -> String -> [(String, String)] -> [(String, String)]
    forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
    insert String
    option String
    helpText [(String, String)]
    help) Maybe String
    version
          (AddVersionFlag String
    v) ->
            Modifiers -> Result Modifiers
    forall a. a -> Result a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Modifiers -> Result Modifiers) -> Modifiers -> Result Modifiers
    forall a b. (a -> b) -> a -> b
    $ [(String, String)]
    -> (String -> String)
    -> Maybe (String, String)
    -> [(String, String)]
    -> Maybe String
    -> Modifiers
    Modifiers [(String, String)]
    shorts String -> String
    renaming Maybe (String, String)
    args [(String, String)]
    help (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    v)

        combineRenamings :: (a -> a) -> (a -> Maybe a) -> (a -> a)
        combineRenamings :: forall a. (a -> a) -> (a -> Maybe a) -> a -> a
    combineRenamings a -> a
    old a -> Maybe a
    new a
    x = a -> a
    old (a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    x (a -> Maybe a
    new a
    x))

    -- * list utils to replace Data.Map

    insertWith :: Eq a => (b -> b -> b) -> a -> b -> [(a, b)] -> [(a, b)]
    insertWith :: forall a b. Eq a => (b -> b -> b) -> a -> b -> [(a, b)] -> [(a, b)]
    insertWith b -> b -> b
    _ a
    key b
    value [] = [(a
    key, b
    value)]
    insertWith b -> b -> b
    combine a
    key b
    value ((a
    a, b
    b) : [(a, b)]
    r) =
      if a
    a a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    key
        then (a
    key, b
    b b -> b -> b
    `combine` b
    value) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [(a, b)]
    r
        else (a
    a, b
    b) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : (b -> b -> b) -> a -> b -> [(a, b)] -> [(a, b)]
    forall a b. Eq a => (b -> b -> b) -> a -> b -> [(a, b)] -> [(a, b)]
    insertWith b -> b -> b
    combine a
    key b
    value [(a, b)]
    r

    insert :: Eq a => a -> b -> [(a, b)] -> [(a, b)]
    insert :: forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
    insert a
    key b
    value [] = [(a
    key, b
    value)]
    insert a
    key b
    value ((a
    a, b
    b) : [(a, b)]
    r) =
      if a
    a a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    key
        then (a
    key, b
    value) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [(a, b)]
    r
        else (a
    a, b
    b) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : a -> b -> [(a, b)] -> [(a, b)]
    forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
    insert a
    key b
    value [(a, b)]
    r

    -- * transforming Parsers

    applyModifiersLong :: Modifiers -> String -> String
    applyModifiersLong :: Modifiers -> String -> String
    applyModifiersLong Modifiers
    modifiers String
    long = (Modifiers -> String -> String
    renaming Modifiers
    modifiers) String
    long

    applyModifiers :: Modifiers -> Parser Unnormalized a -> Parser Unnormalized a
    applyModifiers :: forall a.
    Modifiers -> Parser Unnormalized a -> Parser Unnormalized a
    applyModifiers Modifiers
    modifiers =
      (forall x. [OptDescr (Result x)] -> [OptDescr (Result x)])
    -> Parser Unnormalized a -> Parser Unnormalized a
    forall a.
    (forall x. [OptDescr (Result x)] -> [OptDescr (Result x)])
    -> Parser Unnormalized a -> Parser Unnormalized a
    modParserOptions ((forall x. [OptDescr (Result x)] -> [OptDescr (Result x)])
     -> Parser Unnormalized a -> Parser Unnormalized a)
    -> (forall x. [OptDescr (Result x)] -> [OptDescr (Result x)])
    -> Parser Unnormalized a
    -> Parser Unnormalized a
    forall a b. (a -> b) -> a -> b
    $ (OptDescr (Result x) -> OptDescr (Result x))
    -> [OptDescr (Result x)] -> [OptDescr (Result x)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((OptDescr (Result x) -> OptDescr (Result x))
     -> [OptDescr (Result x)] -> [OptDescr (Result x)])
    -> (OptDescr (Result x) -> OptDescr (Result x))
    -> [OptDescr (Result x)]
    -> [OptDescr (Result x)]
    forall a b. (a -> b) -> a -> b
    $
        OptDescr (Result x) -> OptDescr (Result x)
    forall a. OptDescr a -> OptDescr a
    addShortOptions (OptDescr (Result x) -> OptDescr (Result x))
    -> (OptDescr (Result x) -> OptDescr (Result x))
    -> OptDescr (Result x)
    -> OptDescr (Result x)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
        Modifiers -> OptDescr (Result x) -> OptDescr (Result x)
    forall x. Modifiers -> OptDescr x -> OptDescr x
    addOptionHelp Modifiers
    modifiers (OptDescr (Result x) -> OptDescr (Result x))
    -> (OptDescr (Result x) -> OptDescr (Result x))
    -> OptDescr (Result x)
    -> OptDescr (Result x)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
        Modifiers -> OptDescr (Result x) -> OptDescr (Result x)
    forall x. Modifiers -> OptDescr x -> OptDescr x
    renameOptions Modifiers
    modifiers
      where
        addShortOptions :: OptDescr a -> OptDescr a
        addShortOptions :: forall a. OptDescr a -> OptDescr a
    addShortOptions = \ option :: OptDescr a
    option@(Option String
    _ [String]
    longs ArgDescr a
    _ String
    _) ->
          case ((String, String) -> Bool)
    -> [(String, String)] -> [(String, String)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\ (String
    needle, String
    _) -> String
    needle String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    longs) (Modifiers -> [(String, String)]
    shortOptions Modifiers
    modifiers) of
            [] -> OptDescr a
    option
            ([String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String)
    -> ([(String, String)] -> [String]) -> [(String, String)] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String
    forall a b. (a, b) -> b
    snd -> String
    newShorts) ->
              (OptDescr a -> Char -> OptDescr a)
    -> OptDescr a -> String -> OptDescr a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ((Char -> OptDescr a -> OptDescr a)
    -> OptDescr a -> Char -> OptDescr a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Char -> OptDescr a -> OptDescr a
    forall a. Char -> OptDescr a -> OptDescr a
    addShort) OptDescr a
    option String
    newShorts

        addShort :: Char -> OptDescr a -> OptDescr a
        addShort :: forall a. Char -> OptDescr a -> OptDescr a
    addShort Char
    short (Option String
    shorts [String]
    longs ArgDescr a
    argDescrs String
    help) =
          String -> [String] -> ArgDescr a -> String -> OptDescr a
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option (String
    shorts String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    short]) [String]
    longs ArgDescr a
    argDescrs String
    help

        renameOptions :: Modifiers -> OptDescr a -> OptDescr a
        renameOptions :: forall x. Modifiers -> OptDescr x -> OptDescr x
    renameOptions Modifiers
    modifiers (Option String
    shorts [String]
    longs ArgDescr a
    descrs String
    help) =
          String -> [String] -> ArgDescr a -> String -> OptDescr a
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option String
    shorts ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Modifiers -> String -> String
    renaming Modifiers
    modifiers) [String]
    longs) ArgDescr a
    descrs String
    help

        addOptionHelp :: Modifiers -> OptDescr x -> OptDescr x
        addOptionHelp :: forall x. Modifiers -> OptDescr x -> OptDescr x
    addOptionHelp Modifiers
    modifiers (Option String
    shorts [String]
    longs ArgDescr x
    argDescr String
    help) =
          String -> [String] -> ArgDescr x -> String -> OptDescr x
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option String
    shorts [String]
    longs ArgDescr x
    argDescr String
    newHelp
          where
            newHelp :: String
    newHelp = case (String -> Maybe String) -> [String] -> [String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\ String
    long -> String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    long (Modifiers -> [(String, String)]
    helpTexts Modifiers
    modifiers)) [String]
    longs of
              [] -> String
    help
              String
    h : [String]
    _ -> String
    h