content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE NondecreasingIndentation #-}
  {-# LANGUAGE TupleSections #-}
  module GHC.Driver.Session.Lint (checkOptions) where
  
  import GHC.Driver.Backend
  import GHC.Driver.Phases
  import GHC.Driver.Session
  import GHC.Platform.Ways
  
  import GHC.Utils.Misc
  import GHC.Utils.Panic
  
  import GHC.Data.Maybe
  
  import System.IO
  import Control.Monad
  import qualified Data.Set as Set
  import Prelude
  
  import GHC.Driver.Session.Mode
  
  -- -----------------------------------------------------------------------------
  -- Option sanity checks
  
  -- | Ensure sanity of options.
  --
  -- Throws 'UsageError' or 'CmdLineError' if not.
  checkOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> [String] -> IO ()
       -- Final sanity checking before kicking off a compilation (pipeline).
  checkOptions mode dflags srcs objs units = do
       -- Complain about any unknown flags
     let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
     when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
  
     when (not (Set.null (rtsWays (ways dflags)))
           && isInterpretiveMode mode) $
          hPutStrLn stderr ("Warning: -debug, -threaded and -ticky are ignored by GHCi")
  
          -- -prof and --interactive are not a good combination
     when ((fullWays (ways dflags) /= hostFullWays)
           && LinkInMemory == ghcLink dflags
           && not (gopt Opt_ExternalInterpreter dflags)) $
        do throwGhcException (UsageError
                "-fexternal-interpreter is required when using --interactive with a non-standard way (-prof, -static, or -dynamic).")
          -- -ohi sanity check
     if (isJust (outputHi dflags) &&
        (isCompManagerMode mode || srcs `lengthExceeds` 1))
          then throwGhcException (UsageError "-ohi can only be used when compiling a single source file")
          else do
  
     if (isJust (dynOutputHi dflags) &&
        (isCompManagerMode mode || srcs `lengthExceeds` 1))
       then throwGhcException (UsageError "-dynohi can only be used when compiling a single source file")
       else do
  
          -- -o sanity checking
     if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
           && not (isLinkMode mode))
          then throwGhcException (UsageError "can't apply -o to multiple source files")
          else do
  
     let not_linking = not (isLinkMode mode) || isNoLink (ghcLink dflags)
  
     when (not_linking && not (null objs)) $
          hPutStrLn stderr ("Warning: the following files would be used as linker inputs, but linking is not being done: " ++ unwords objs)
  
          -- Check that there are some input files
          -- (except in the interactive case)
     if null srcs && (null objs || not_linking) && needsInputsMode mode && null units
          then throwGhcException (UsageError "no input files" )
          else do
  
     case mode of
        StopBefore StopC | not (backendGeneratesHc (backend dflags))
          -> throwGhcException $ UsageError $
             "the option -C is only available with an unregisterised GHC"
        StopBefore StopAs | ghcLink dflags == NoLink
          -> throwGhcException $ UsageError $
             "the options -S and -fno-code are incompatible. Please omit -S"
  
        _ -> return ()
  
       -- Verify that output files point somewhere sensible.
     verifyOutputFiles dflags
  
  -- Compiler output options
  
  -- Called to verify that the output files point somewhere valid.
  --
  -- The assumption is that the directory portion of these output
  -- options will have to exist by the time 'verifyOutputFiles'
  -- is invoked.
  --
  -- We create the directories for -odir, -hidir, -outputdir etc. ourselves if
  -- they don't exist, so don't check for those here (#2278).
  verifyOutputFiles :: DynFlags -> IO ()
  verifyOutputFiles dflags = do
    let ofile = outputFile dflags
    when (isJust ofile) $ do
       let fn = fromJust ofile
       flg <- doesDirNameExist fn
       when (not flg) (nonExistentDir "-o" fn)
    let ohi = outputHi dflags
    when (isJust ohi) $ do
       let hi = fromJust ohi
       flg <- doesDirNameExist hi
       when (not flg) (nonExistentDir "-ohi" hi)
   where
     nonExistentDir flg dir =
       throwGhcException (CmdLineError ("error: directory portion of " ++
                               show dir ++ " does not exist (used with " ++
                               show flg ++ " option.)"))
  
  -- | Utility for reporting unknown flag error
  unknownFlagsErr :: [String] -> a
  unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs
    where
      oneError f =
          "unrecognised flag: " ++ f ++ "\n" ++
          (case flagSuggestions (nubSort allNonDeprecatedFlags) f of
              [] -> ""
              suggs -> "did you mean one of:\n" ++ unlines (map ("  " ++) suggs))
  