1 -- Copyright (C) 2002-2003 David Roundy
    2 --
    3 -- This program is free software; you can redistribute it and/or modify
    4 -- it under the terms of the GNU General Public License as published by
    5 -- the Free Software Foundation; either version 2, or (at your option)
    6 -- any later version.
    7 --
    8 -- This program is distributed in the hope that it will be useful,
    9 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 -- GNU General Public License for more details.
   12 --
   13 -- You should have received a copy of the GNU General Public License
   14 -- along with this program; see the file COPYING.  If not, write to
   15 -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 -- Boston, MA 02110-1301, USA.
   17 
   18 {-# OPTIONS_GHC -cpp #-}
   19 {-# LANGUAGE CPP #-}
   20 
   21 module Main (main) where
   22 
   23 import System.IO ( hSetBinaryMode)
   24 import System.IO ( stdin, stdout )
   25 import System.Exit ( exitWith, ExitCode(..) )
   26 import System.Environment ( getArgs )
   27 import Control.Exception ( Exception( AssertionFailed ), handleJust, catchDyn )
   28 
   29 import Darcs.RunCommand ( run_the_command )
   30 import Darcs.Flags ( DarcsFlag(Verbose) )
   31 import Darcs.Commands.Help ( help_cmd, list_available_commands, print_version )
   32 import ThisVersion ( darcs_version )
   33 import Darcs.SignalHandler ( withSignalsHandled )
   34 import Context ( context )
   35 import Darcs.Global ( with_atexit )
   36 import Preproc( preproc_main )
   37 import Exec ( ExecException(..) )
   38 #include "impossible.h"
   39 
   40 assertions :: Control.Exception.Exception -> Maybe String
   41 assertions (AssertionFailed s) = Just s
   42 assertions _ = Nothing
   43 
   44 execExceptionHandler :: ExecException -> IO a
   45 execExceptionHandler (ExecException cmd args redirects reason) =
   46     do putStrLn $ "Failed to execute external command: " ++ unwords (cmd:args) ++ "\n"
   47                     ++ "Lowlevel error: " ++ reason ++ "\n"
   48                     ++ "Redirects: " ++ show redirects ++"\n"
   49        exitWith $ ExitFailure 3
   50 
   51 main :: IO ()
   52 main = with_atexit $ withSignalsHandled $
   53   flip catchDyn execExceptionHandler $
   54   handleJust assertions bug $ do                                                                                   
   55   argv <- getArgs
   56   case argv of
   57     -- User called "darcs" without arguments.
   58     []                  -> print_version >> help_cmd [] []
   59     -- User called "darcs --foo" for some special foo.
   60     ["-h"]              -> help_cmd [] []
   61     ["--help"]          -> help_cmd [] []
   62     ["--overview"]      -> help_cmd [Verbose] []
   63     ["--commands"]      -> list_available_commands
   64     ["-v"]              -> putStrLn darcs_version
   65     ["--version"]       -> putStrLn darcs_version
   66     ["--exact-version"] -> do
   67               putStrLn $ "darcs compiled on "++__DATE__++", at "++__TIME__
   68               putStrLn context
   69     ("--preprocess-manual":rest) -> preproc_main rest
   70     -- User called a normal darcs command, "darcs foo [args]".
   71     _ -> do
   72       hSetBinaryMode stdin True
   73       hSetBinaryMode stdout True
   74       run_the_command (head argv) (tail argv)