{-# 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]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList 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]