Options.hs

{-# 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.fromList [
    "-z"
  , "--ignore-project"
  , "--repl-no-load"
  , "--repl-options"
  , "--repl-multi-file"
  , "-b"
  , "--build-depends"
  , "--no-transitive-deps"
  , "--enable-multi-repl"
  , "--disable-multi-repl"
  , "--keep-temp-files"
  ]

rejectUnsupportedOptions :: [String] -> IO ()
rejectUnsupportedOptions args = case getOpt' Permute options args of
  (xs, _, _, _) | ListOptions `elem` xs -> do
    let
      names :: [String]
      names = concat [map (\ c -> ['-', c]) short ++ map ("--" <> ) long | Option short long _ _ <- documentedOptions]
    putStr (unlines names)
    exitSuccess
  (_, _, unsupported : _, _) -> do
    die $ "Error: cabal: unrecognized 'doctest' option `" <> unsupported <> "'"
  _ -> pass

data Argument = Argument String (Maybe String) | ListOptions
  deriving (Eq, Show)

options :: [OptDescr Argument]
options =
    Option [] ["list-options"] (NoArg ListOptions) ""
  : documentedOptions

documentedOptions :: [OptDescr Argument]
documentedOptions = map toOptDescr Repl.options
  where
    toOptDescr :: Repl.Option -> OptDescr Argument
    toOptDescr (Repl.Option long short arg help) = Option (maybeToList short) [long] (toArgDescr long arg) help

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

discardReplOptions :: [String] -> [String]
discardReplOptions args = case getOpt Permute options args of
  (xs, _, _) -> concat [name : maybeToList value | Argument name value <- xs, Set.notMember name replOnlyOptions]