{-# 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 [Char]
replOnlyOptions = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList [
    [Char]
"-z"
  , [Char]
"--ignore-project"
  , [Char]
"--repl-no-load"
  , [Char]
"--repl-options"
  , [Char]
"--repl-multi-file"
  , [Char]
"-b"
  , [Char]
"--build-depends"
  , [Char]
"--no-transitive-deps"
  , [Char]
"--enable-multi-repl"
  , [Char]
"--disable-multi-repl"
  , [Char]
"--with-repl"
  ]

rejectUnsupportedOptions :: [String] -> IO ()
rejectUnsupportedOptions :: [[Char]] -> IO ()
rejectUnsupportedOptions [[Char]]
args = case ArgOrder Argument
-> [OptDescr Argument]
-> [[Char]]
-> ([Argument], [[Char]], [[Char]], [[Char]])
forall a.
ArgOrder a
-> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]], [[Char]])
getOpt' ArgOrder Argument
forall a. ArgOrder a
Permute [OptDescr Argument]
options [[Char]]
args of
  ([Argument]
xs, [[Char]]
_, [[Char]]
_, [[Char]]
_) | 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 :: [[Char]]
names = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(Char -> [Char]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\ Char
c -> [Char
'-', Char
c]) [Char]
short [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"--" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ) [[Char]]
long | Option [Char]
short [[Char]]
long ArgDescr Argument
_ [Char]
_ <- [OptDescr Argument]
documentedOptions]
    [Char] -> IO ()
putStr ([[Char]] -> [Char]
unlines [[Char]]
names)
    IO ()
forall a. IO a
exitSuccess
  ([Argument]
_, [[Char]]
_, [Char]
unsupported : [[Char]]
_, [[Char]]
_) -> do
    [Char] -> IO ()
forall a. [Char] -> IO a
die ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: cabal: unrecognized 'doctest' option `" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
unsupported [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"'"
  ([Argument], [[Char]], [[Char]], [[Char]])
_ -> 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 -> [Char] -> [Char]
[Argument] -> [Char] -> [Char]
Argument -> [Char]
(Int -> Argument -> [Char] -> [Char])
-> (Argument -> [Char])
-> ([Argument] -> [Char] -> [Char])
-> Show Argument
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Argument -> [Char] -> [Char]
showsPrec :: Int -> Argument -> [Char] -> [Char]
$cshow :: Argument -> [Char]
show :: Argument -> [Char]
$cshowList :: [Argument] -> [Char] -> [Char]
showList :: [Argument] -> [Char] -> [Char]
Show)

options :: [OptDescr Argument]
options :: [OptDescr Argument]
options =
    [Char]
-> [[Char]] -> ArgDescr Argument -> [Char] -> OptDescr Argument
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"list-options"] (Argument -> ArgDescr Argument
forall a. a -> ArgDescr a
NoArg Argument
ListOptions) [Char]
""
  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 [Char]
long Maybe Char
short Argument
arg [Char]
help) = [Char]
-> [[Char]] -> ArgDescr Argument -> [Char] -> OptDescr Argument
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option (Maybe Char -> [Char]
forall a. Maybe a -> [a]
maybeToList Maybe Char
short) [[Char]
long] ([Char] -> Argument -> ArgDescr Argument
toArgDescr [Char]
long Argument
arg) [Char]
help

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

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