-- Copyright (C) 2002-2003 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. {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} module Main (main) where import System.IO ( hSetBinaryMode) import System.IO ( stdin, stdout ) import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs ) import Control.Monad ( when ) import Control.Exception ( Exception( AssertionFailed ), handleJust, catchDyn ) import Darcs.RunCommand ( run_the_command ) import Darcs.Flags ( DarcsFlag(Verbose) ) import Darcs.Commands.Help ( help_cmd, list_available_commands, print_version ) import Autoconf( darcs_version ) import Darcs.SignalHandler ( withSignalsHandled ) import Context ( context ) import Darcs.Global ( with_atexit ) import Exec ( ExecException(..) ) #include "impossible.h" assertions :: Control.Exception.Exception -> Maybe String assertions (AssertionFailed s) = Just s assertions _ = Nothing execExceptionHandler :: ExecException -> IO a execExceptionHandler (ExecException cmd args redirects reason) = do putStrLn $ "Failed to execute external command: " ++ unwords (cmd:args) ++ "\n" ++ "Lowlevel error: " ++ reason ++ "\n" ++ "Redirects: " ++ show redirects ++"\n" exitWith $ ExitFailure 3 main :: IO () main = with_atexit $ withSignalsHandled $ flip catchDyn execExceptionHandler $ handleJust assertions bug $ do argv <- getArgs; when (length argv < 1) $ do print_version help_cmd [] [] when (length argv == 1 && (argv!!0 == "-h" || argv!!0 == "--help")) $ help_cmd [] [] when (length argv == 1 && (argv!!0 == "--overview")) $ help_cmd [Verbose] [] when (length argv == 1 && (argv!!0 == "-v" || argv!!0 == "--version")) $ do putStrLn darcs_version exitWith $ ExitSuccess when (length argv == 1 && (argv!!0 == "--exact-version")) $ do putStrLn $ "darcs compiled on "++__DATE__++", at "++__TIME__ putStrLn context exitWith $ ExitSuccess when (length argv == 1 && argv!!0 == "--commands") $ do list_available_commands exitWith $ ExitSuccess hSetBinaryMode stdin True hSetBinaryMode stdout True run_the_command (head argv) (tail argv)