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

    #ifdef TEST
    , replOnlyOptions
    #endif
    ) where

    import           Imports

    import           System.Exit
    import           System.Console.GetOpt

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

    import qualified Cabal.ReplOptions as Repl

    replOnlyOptions :: Set String
    replOnlyOptions :: Set String
    replOnlyOptions = [String] -> Set String
    forall a. Ord a => [a] -> Set a
    Set.fromList [
        String
    "-z"
      , String
    "--ignore-project"
      , String
    "--repl-no-load"
      , String
    "--repl-options"
      , String
    "--repl-multi-file"
      , String
    "-b"
      , String
    "--build-depends"
      , String
    "--no-transitive-deps"
      , String
    "--enable-multi-repl"
      , String
    "--disable-multi-repl"
      , String
    "--keep-temp-files"
      ]

    rejectUnsupportedOptions :: [String] -> IO ()
    rejectUnsupportedOptions :: [String] -> IO ()
    rejectUnsupportedOptions [String]
    args = case ArgOrder Argument
    -> [OptDescr Argument]
    -> [String]
    -> ([Argument], [String], [String], [String])
    forall a.
    ArgOrder a
    -> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
    getOpt' ArgOrder Argument
    forall a. ArgOrder a
    Permute [OptDescr Argument]
    options [String]
    args of
      ([Argument]
    xs, [String]
    _, [String]
    _, [String]
    _) | Argument
    ListOptions Argument -> [Argument] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Argument]
    xs -> do
        let
          names :: [String]
          names :: [String]
    names = [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [(Char -> String) -> String -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ Char
    c -> [Char
    '-', Char
    c]) String
    short [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "--" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> ) [String]
    long | Option String
    short [String]
    long ArgDescr Argument
    _ String
    _ <- [OptDescr Argument]
    documentedOptions]
        String -> IO ()
    putStr ([String] -> String
    unlines [String]
    names)
        IO ()
    forall a. IO a
    exitSuccess
      ([Argument]
    _, [String]
    _, String
    unsupported : [String]
    _, [String]
    _) -> do
        String -> IO ()
    forall a. String -> IO a
    die (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Error: cabal: unrecognized 'doctest' option `" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    unsupported String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "'"
      ([Argument], [String], [String], [String])
    _ -> IO ()
    forall (m :: * -> *). Monad m => m ()
    pass

    data Argument = Argument String (Maybe String) | ListOptions
      deriving (Argument -> Argument -> Bool
    (Argument -> Argument -> Bool)
    -> (Argument -> Argument -> Bool) -> Eq Argument
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Argument -> Argument -> Bool
    == :: Argument -> Argument -> Bool
    $c/= :: Argument -> Argument -> Bool
    /= :: Argument -> Argument -> Bool
    Eq, Int -> Argument -> String -> String
    [Argument] -> String -> String
    Argument -> String
    (Int -> Argument -> String -> String)
    -> (Argument -> String)
    -> ([Argument] -> String -> String)
    -> Show Argument
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Argument -> String -> String
    showsPrec :: Int -> Argument -> String -> String
    $cshow :: Argument -> String
    show :: Argument -> String
    $cshowList :: [Argument] -> String -> String
    showList :: [Argument] -> String -> String
    Show)

    options :: [OptDescr Argument]
    options :: [OptDescr Argument]
    options =
        String
    -> [String] -> ArgDescr Argument -> String -> OptDescr Argument
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [] [String
    "list-options"] (Argument -> ArgDescr Argument
    forall a. a -> ArgDescr a
    NoArg Argument
    ListOptions) String
    ""
      OptDescr Argument -> [OptDescr Argument] -> [OptDescr Argument]
    forall a. a -> [a] -> [a]
    : [OptDescr Argument]
    documentedOptions

    documentedOptions :: [OptDescr Argument]
    documentedOptions :: [OptDescr Argument]
    documentedOptions = (Option -> OptDescr Argument) -> [Option] -> [OptDescr Argument]
    forall a b. (a -> b) -> [a] -> [b]
    map Option -> OptDescr Argument
    toOptDescr [Option]
    Repl.options
      where
        toOptDescr :: Repl.Option -> OptDescr Argument
        toOptDescr :: Option -> OptDescr Argument
    toOptDescr (Repl.Option String
    long Maybe Char
    short Argument
    arg String
    help) = String
    -> [String] -> ArgDescr Argument -> String -> OptDescr Argument
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option (Maybe Char -> String
    forall a. Maybe a -> [a]
    maybeToList Maybe Char
    short) [String
    long] (String -> Argument -> ArgDescr Argument
    toArgDescr String
    long Argument
    arg) String
    help

        toArgDescr :: String -> Repl.Argument -> ArgDescr Argument
        toArgDescr :: String -> Argument -> ArgDescr Argument
    toArgDescr String
    long = \ case
          Repl.Argument String
    name -> (String -> Argument) -> String -> ArgDescr Argument
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg (Maybe String -> Argument
    argument (Maybe String -> Argument)
    -> (String -> Maybe String) -> String -> Argument
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe String
    forall a. a -> Maybe a
    Just) String
    name
          Argument
    Repl.NoArgument -> Argument -> ArgDescr Argument
    forall a. a -> ArgDescr a
    NoArg (Maybe String -> Argument
    argument Maybe String
    forall a. Maybe a
    Nothing)
          Repl.OptionalArgument String
    name -> (Maybe String -> Argument) -> String -> ArgDescr Argument
    forall a. (Maybe String -> a) -> String -> ArgDescr a
    OptArg Maybe String -> Argument
    argument String
    name
          where
            argument :: Maybe String -> Argument
            argument :: Maybe String -> Argument
    argument Maybe String
    value = String -> Maybe String -> Argument
    Argument (String
    "--" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    long) Maybe String
    value

    discardReplOptions :: [String] -> [String]
    discardReplOptions :: [String] -> [String]
    discardReplOptions [String]
    args = case ArgOrder Argument
    -> [OptDescr Argument]
    -> [String]
    -> ([Argument], [String], [String])
    forall a.
    ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
    getOpt ArgOrder Argument
    forall a. ArgOrder a
    Permute [OptDescr Argument]
    options [String]
    args of
      ([Argument]
    xs, [String]
    _, [String]
    _) -> [String -> Maybe String -> String
    renderArgument String
    name Maybe String
    value | Argument String
    name Maybe String
    value <- [Argument]
    xs, String -> Set String -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.notMember String
    name Set String
    replOnlyOptions]
      where
        renderArgument :: String -> Maybe String -> String
    renderArgument String
    name = \ case
          Maybe String
    Nothing -> String
    name
          Just String
    value -> String
    name String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "=" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    value