    -- Copyright (C) 2002,2003,2005 David Roundy
    --
    -- This program is free software; you can redistribute it and/or modify
    -- it under the terms of the GNU General Public License as published by
    -- the Free Software Foundation; either version 2, or (at your option)
    -- any later version.
    --
    -- This program is distributed in the hope that it will be useful,
    -- but WITHOUT ANY WARRANTY; without even the implied warranty of
    -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    -- GNU General Public License for more details.
    --
    -- You should have received a copy of the GNU General Public License
    -- along with this program; see the file COPYING.  If not, write to
    -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
    -- Boston, MA 02110-1301, USA.

    {-# LANGUAGE CPP #-}
    module Darcs.RunCommand ( run_the_command ) where

    import Control.Monad ( unless, when )
    import System.Console.GetOpt( ArgOrder( Permute, RequireOrder ),
                                  OptDescr( Option ),
                                  getOpt )
    import System.Exit ( ExitCode ( ExitSuccess ), exitWith )

    import Darcs.Arguments ( DarcsFlag(..),
                             help,
                             optionFromDarcsoption,
                             listOptions )
    import Darcs.ArgumentDefaults ( get_default_flags )
    import Darcs.Commands ( CommandArgs( CommandOnly, SuperCommandOnly, SuperCommandSub ),
                            DarcsCommand,
                            commandName,
                            commandCommand,
                            commandPrereq,
                            commandExtraArgHelp,
                            commandExtraArgs,
                            commandArgdefaults,
                            commandGetArgPossibilities,
                            commandOptions, commandAlloptions,
                            disambiguateCommands,
                            getCommandHelp, getCommandMiniHelp,
                            getSubcommands,
                            extractCommands,
                            superName,
                            subusage, chompNewline )
    import Darcs.Commands.GZCRCs ( doCRCWarnings )
    import Darcs.Global ( atexit )
    import Darcs.Commands.Help ( commandControlList )
    import Darcs.External ( viewDoc )
    import Darcs.Global ( setDebugMode, setSshControlMasterDisabled,
                          setTimingsMode, setVerboseMode )
    import Darcs.Match ( checkMatchSyntax )
    import Progress ( setProgressMode )
    import Darcs.RepoPath ( getCurrentDirectory )
    import Darcs.Test ( run_posthook, run_prehook )
    import Darcs.Utils ( formatPath )
    import Data.List ( intersperse )
    import Printer ( text )
    import URL ( setDebugHTTP, setHTTPPipelining )

    run_the_command :: String -> [String] -> IO ()
    run_the_command cmd args =
      either fail rtc $ disambiguateCommands commandControlList cmd args
     where
      rtc (CommandOnly c, as)       = run_command Nothing c  as
      rtc (SuperCommandOnly c,  as) = run_raw_supercommand c as
      rtc (SuperCommandSub c s, as) = run_command (Just c) s as

    -- This is the actual heavy lifter code, which is responsible for parsing the
    -- arguments and then running the command itself.

    run_command :: Maybe DarcsCommand -> DarcsCommand -> [String] -> IO ()

    run_command _ _ args -- Check for "dangerous" typoes...
        | "-all" `elem` args = -- -all indicates --all --look-for-adds!
            fail $ "Are you sure you didn't mean -" ++ "-all rather than -all?"
    run_command msuper cmd args = do
       cwd <- getCurrentDirectory
       let options = opts1 ++ opts2
           (opts1, opts2) = commandOptions cwd cmd
       case getOpt Permute
                 (optionFromDarcsoption cwd listOptions++options) args of
        (opts,extra,[])
          | Help `elem` opts -> viewDoc $ text $ getCommandHelp msuper cmd
          | ListOptions `elem` opts  -> do
               setProgressMode False
               commandPrereq cmd opts
               file_args <- commandGetArgPossibilities cmd
               putStrLn $ get_options_options (opts1++opts2) ++ unlines file_args
          | otherwise -> consider_running msuper cmd (addVerboseIfDebug opts) extra
        (_,_,ermsgs) -> do fail $ chompNewline(unlines ermsgs)
        where addVerboseIfDebug opts | DebugVerbose `elem` opts = Debug:Verbose:opts
                                     | otherwise = opts

    consider_running :: Maybe DarcsCommand -> DarcsCommand
                     -> [DarcsFlag] -> [String] -> IO ()
    consider_running msuper cmd opts old_extra = do
     cwd <- getCurrentDirectory
     location <- commandPrereq cmd opts
     case location of
       Left complaint -> fail $ "Unable to " ++
                         formatPath ("darcs " ++ superName msuper ++ commandName cmd) ++
                         " here.\n\n" ++ complaint
       Right () -> do
        specops <- add_command_defaults cmd opts
        extra <- (commandArgdefaults cmd) specops cwd old_extra
        when (Disable `elem` specops) $
          fail $ "Command "++commandName cmd++" disabled with --disable option!"
        if commandExtraArgs cmd < 0
          then runWithHooks specops extra
          else if length extra > commandExtraArgs cmd
               then fail $ "Bad argument: `"++unwords extra++"'\n"++
                           getCommandMiniHelp msuper cmd
               else if length extra < commandExtraArgs cmd
                    then fail $ "Missing argument:  " ++
                                nth_arg (length extra + 1) ++
                                "\n" ++ getCommandMiniHelp msuper cmd
                    else runWithHooks specops extra
           where nth_arg n = nth_of n (commandExtraArgHelp cmd)
                 nth_of 1 (h:_) = h
                 nth_of n (_:hs) = nth_of (n-1) hs
                 nth_of _ [] = "UNDOCUMENTED"
                 runWithHooks os ex = do
                   here <- getCurrentDirectory
                   checkMatchSyntax os
                   -- set any global variables
                   when (Timings `elem` os) setTimingsMode
                   when (Debug `elem` os) setDebugMode
                   when (DebugHTTP `elem` os) setDebugHTTP
                   when (Verbose `elem` os) setVerboseMode
                   when (Quiet `elem` os) $ setProgressMode False
                   when (HTTPPipelining `elem` os) $ setHTTPPipelining True
                   when (NoHTTPPipelining `elem` os) $ setHTTPPipelining False
                   unless (SSHControlMaster `elem` os) setSshControlMasterDisabled
                   unless (Quiet `elem` os) $ atexit $ doCRCWarnings (Verbose `elem` os)
                   -- actually run the command and its hooks
                   preHookExitCode <- run_prehook os here
                   if preHookExitCode /= ExitSuccess
                      then exitWith preHookExitCode
                      else do let fixFlag = FixFilePath here cwd
                              (commandCommand cmd) (fixFlag : os) ex
                              postHookExitCode <- run_posthook os here
                              exitWith postHookExitCode

    add_command_defaults :: DarcsCommand -> [DarcsFlag] -> IO [DarcsFlag]
    add_command_defaults cmd already = do
      let (opts1, opts2) = commandAlloptions cmd
      defaults <- get_default_flags (commandName cmd) (opts1 ++ opts2) already
      return $ already ++ defaults

    get_options_options :: [OptDescr DarcsFlag] -> String
    get_options_options = concat . intersperse "\n" . concatMap goo
     where
      goo (Option _ os _ _) = map ("--"++) os

    run_raw_supercommand :: DarcsCommand -> [String] -> IO ()
    run_raw_supercommand super [] =
        fail $ "Command '"++ commandName super ++"' requires subcommand!\n\n"
                 ++ subusage super
    run_raw_supercommand super args = do
      cwd <- getCurrentDirectory
      case getOpt RequireOrder
                 (optionFromDarcsoption cwd help++
                  optionFromDarcsoption cwd listOptions) args of
        (opts,_,[])
          | Help `elem` opts ->
                viewDoc $ text $ getCommandHelp Nothing super
          | ListOptions `elem` opts -> do
                putStrLn "--help"
                mapM_ (putStrLn . commandName) (extractCommands $ getSubcommands super)
          | otherwise ->
                if Disable `elem` opts
                then fail $ "Command " ++ (commandName super) ++
                          " disabled with --disable option!"
                else fail $ "Invalid subcommand!\n\n" ++ subusage super
        (_,_,ermsgs) -> do fail $ chompNewline(unlines ermsgs)