    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    module Cabal.Options (
      rejectUnsupportedOptions
    , discardReplOptions

    #ifdef TEST
    , Option(..)
    , pathOptions
    , replOptions
    , shouldReject
    , Discard(..)
    , shouldDiscard
    #endif
    ) where

    import           Imports

    import           Data.List
    import           System.Exit

    import           Data.Set (Set)
    import qualified Data.Set as Set

    data Option = Option {
      Option -> [Char]
    optionName :: String
    , Option -> OptionArgument
    _optionArgument :: OptionArgument
    }

    data OptionArgument = Argument | NoArgument

    pathOptions :: [Option]
    pathOptions :: [Option]
    pathOptions = [
        [Char] -> OptionArgument -> Option
    Option [Char]
    "-z" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--ignore-project" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--output-format" OptionArgument
    Argument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--compiler-info" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--cache-home" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--remote-repo-cache" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--logs-dir" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--store-dir" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--config-file" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--installdir" OptionArgument
    NoArgument
      ]

    replOptions :: [Option]
    replOptions :: [Option]
    replOptions = [
        [Char] -> OptionArgument -> Option
    Option [Char]
    "-z" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--ignore-project" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--repl-no-load" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--repl-options" OptionArgument
    Argument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--repl-multi-file" OptionArgument
    Argument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "-b" OptionArgument
    Argument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--build-depends" OptionArgument
    Argument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--no-transitive-deps" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--enable-multi-repl" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--disable-multi-repl" OptionArgument
    NoArgument
      , [Char] -> OptionArgument -> Option
    Option [Char]
    "--keep-temp-files" OptionArgument
    NoArgument
      ]

    rejectUnsupportedOptions :: [String] -> IO ()
    rejectUnsupportedOptions :: [[Char]] -> IO ()
    rejectUnsupportedOptions = ([Char] -> IO ()) -> [[Char]] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (([Char] -> IO ()) -> [[Char]] -> IO ())
    -> ([Char] -> IO ()) -> [[Char]] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \ [Char]
    arg -> Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Char] -> Bool
    shouldReject [Char]
    arg) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      [Char] -> IO ()
    forall a. [Char] -> IO a
    die [Char]
    "Error: cabal: unrecognized 'doctest' option `--installdir'"

    shouldReject :: String -> Bool
    shouldReject :: [Char] -> Bool
    shouldReject [Char]
    arg =
         [Char] -> Set [Char] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member [Char]
    arg Set [Char]
    rejectNames
      Bool -> Bool -> Bool
    || (([Char] -> Bool) -> [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    `any` [[Char]]
    longOptionsWithArgument) ([Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    arg)
      where
        rejectNames :: Set String
        rejectNames :: Set [Char]
    rejectNames = [[Char]] -> Set [Char]
    forall a. Ord a => [a] -> Set a
    Set.fromList ((Option -> [Char]) -> [Option] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map Option -> [Char]
    optionName [Option]
    pathOptions)

        longOptionsWithArgument :: [String]
        longOptionsWithArgument :: [[Char]]
    longOptionsWithArgument = [[Char]
    name [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    "=" | Option name :: [Char]
    name@(Char
    '-':Char
    '-':[Char]
    _) OptionArgument
    Argument <- [Option]
    pathOptions]

    discardReplOptions :: [String] -> [String]
    discardReplOptions :: [[Char]] -> [[Char]]
    discardReplOptions = [[Char]] -> [[Char]]
    go
      where
        go :: [[Char]] -> [[Char]]
    go = \ case
          [] -> []
          [Char]
    arg : [[Char]]
    args -> case [Char] -> Discard
    shouldDiscard [Char]
    arg of
            Discard
    Keep -> [Char]
    arg [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]] -> [[Char]]
    go [[Char]]
    args
            Discard
    Discard -> [[Char]] -> [[Char]]
    go [[Char]]
    args
            Discard
    DiscardWithArgument -> [[Char]] -> [[Char]]
    go (Int -> [[Char]] -> [[Char]]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [[Char]]
    args)

    data Discard = Keep | Discard | DiscardWithArgument
      deriving (Discard -> Discard -> Bool
    (Discard -> Discard -> Bool)
    -> (Discard -> Discard -> Bool) -> Eq Discard
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Discard -> Discard -> Bool
    == :: Discard -> Discard -> Bool
    $c/= :: Discard -> Discard -> Bool
    /= :: Discard -> Discard -> Bool
    Eq, Int -> Discard -> [Char] -> [Char]
    [Discard] -> [Char] -> [Char]
    Discard -> [Char]
    (Int -> Discard -> [Char] -> [Char])
    -> (Discard -> [Char])
    -> ([Discard] -> [Char] -> [Char])
    -> Show Discard
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> Discard -> [Char] -> [Char]
    showsPrec :: Int -> Discard -> [Char] -> [Char]
    $cshow :: Discard -> [Char]
    show :: Discard -> [Char]
    $cshowList :: [Discard] -> [Char] -> [Char]
    showList :: [Discard] -> [Char] -> [Char]
    Show)

    shouldDiscard :: String -> Discard
    shouldDiscard :: [Char] -> Discard
    shouldDiscard [Char]
    arg
      | [Char] -> Set [Char] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member [Char]
    arg Set [Char]
    flags = Discard
    Discard
      | [Char] -> Set [Char] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member [Char]
    arg Set [Char]
    options = Discard
    DiscardWithArgument
      | Bool
    isOptionWithArgument = Discard
    Discard
      | Bool
    otherwise = Discard
    Keep
      where
        flags :: Set String
        flags :: Set [Char]
    flags = [[Char]] -> Set [Char]
    forall a. Ord a => [a] -> Set a
    Set.fromList [[Char]
    name | Option [Char]
    name OptionArgument
    NoArgument <- [Option]
    replOptions]

        options :: Set String
        options :: Set [Char]
    options = [[Char]] -> Set [Char]
    forall a. Ord a => [a] -> Set a
    Set.fromList ([[Char]]
    longOptions [[Char]] -> [[Char]] -> [[Char]]
    forall a. Semigroup a => a -> a -> a
    <> [[Char]]
    shortOptions)

        longOptions :: [String]
        longOptions :: [[Char]]
    longOptions = [[Char]
    name | Option name :: [Char]
    name@(Char
    '-':Char
    '-':[Char]
    _) OptionArgument
    Argument <- [Option]
    replOptions]

        shortOptions :: [String]
        shortOptions :: [[Char]]
    shortOptions = [[Char]
    name | Option name :: [Char]
    name@[Char
    '-', Char
    _] OptionArgument
    Argument <- [Option]
    replOptions]

        isOptionWithArgument :: Bool
        isOptionWithArgument :: Bool
    isOptionWithArgument = ([Char] -> Bool) -> [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    arg) (([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    "=") [[Char]]
    longOptions [[Char]] -> [[Char]] -> [[Char]]
    forall a. Semigroup a => a -> a -> a
    <> [[Char]]
    shortOptions)