--  Copyright (C) 2002-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.

module Darcs.UI.RunHook
    ( runPosthook
    , runPrehook
    )
where

import Darcs.Prelude

import System.Directory ( withCurrentDirectory )
import System.Exit ( ExitCode(..) )
import System.Process ( system )
import System.IO ( hPutStrLn, stderr )
import Control.Monad ( when )

import Darcs.UI.Options.All ( HookConfig(..), Verbosity(..) )

import Darcs.Util.Path ( AbsolutePath, toFilePath )
import Darcs.Util.Prompt ( promptYorn )

runPosthook :: HookConfig -> Verbosity -> AbsolutePath -> IO ExitCode
runPosthook :: HookConfig -> Verbosity -> AbsolutePath -> IO ExitCode
runPosthook (HookConfig Maybe String
mPostHook Bool
askPostHook) Verbosity
verb AbsolutePath
repodir
    = do Maybe String
ph <- String -> Maybe String -> Bool -> IO (Maybe String)
getHook String
"Posthook" Maybe String
mPostHook Bool
askPostHook
         String -> IO ExitCode -> IO ExitCode
forall a. String -> IO a -> IO a
withCurrentDirectory (AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
repodir) (IO ExitCode -> IO ExitCode) -> IO ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> Maybe String -> IO ExitCode
runHook Verbosity
verb String
"Posthook" Maybe String
ph

runPrehook :: HookConfig -> Verbosity -> AbsolutePath -> IO ExitCode
runPrehook :: HookConfig -> Verbosity -> AbsolutePath -> IO ExitCode
runPrehook (HookConfig Maybe String
mPreHookCmd Bool
askPreHook) Verbosity
verb AbsolutePath
repodir =
    do Maybe String
ph <- String -> Maybe String -> Bool -> IO (Maybe String)
getHook String
"Prehook" Maybe String
mPreHookCmd Bool
askPreHook
       String -> IO ExitCode -> IO ExitCode
forall a. String -> IO a -> IO a
withCurrentDirectory (AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
repodir) (IO ExitCode -> IO ExitCode) -> IO ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> Maybe String -> IO ExitCode
runHook Verbosity
verb String
"Prehook" Maybe String
ph

getHook :: String -> Maybe String -> Bool -> IO (Maybe String)
getHook :: String -> Maybe String -> Bool -> IO (Maybe String)
getHook String
name Maybe String
mPostHookCmd Bool
askHook =
 case Maybe String
mPostHookCmd of
   Maybe String
Nothing -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
   Just String
command ->
     if Bool
askHook
      then do Bool
yorn <-
                String -> IO Bool
promptYorn
                  (String
"The following command is set to execute:\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
commandString -> String -> String
forall a. [a] -> [a] -> [a]
++
                   String
"\nExecute this command now?")
              if Bool
yorn
                then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
command
                else String -> IO ()
putStrLn (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" cancelled...") IO () -> IO (Maybe String) -> IO (Maybe String)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
      else Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
command

runHook :: Verbosity -> String -> Maybe String -> IO ExitCode
runHook :: Verbosity -> String -> Maybe String -> IO ExitCode
runHook Verbosity
_ String
_ Maybe String
Nothing = ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
runHook Verbosity
verb String
cname (Just String
command) =
    do ExitCode
ec <- String -> IO ExitCode
system String
command
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
/= Verbosity
Quiet) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         if ExitCode
ec ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
         then String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
cnameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" ran successfully."
         else Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
cnameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" failed!"
       ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ec