Windows: Fix running of the pre-commit-annex hook.
This commit is contained in:
parent
d818e4c06c
commit
6035f94666
5 changed files with 83 additions and 11 deletions
41
Git/Hook.hs
41
Git/Hook.hs
|
@ -1,15 +1,20 @@
|
|||
{- git hooks
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
- Copyright 2013-2015 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Git.Hook where
|
||||
|
||||
import Common
|
||||
import Git
|
||||
import Utility.Tmp
|
||||
#ifndef mingw32_HOST_OS
|
||||
import Utility.FileMode
|
||||
#endif
|
||||
|
||||
data Hook = Hook
|
||||
{ hookName :: FilePath
|
||||
|
@ -56,3 +61,37 @@ expectedContent :: Hook -> Repo -> IO Bool
|
|||
expectedContent h r = do
|
||||
content <- readFile $ hookFile h r
|
||||
return $ content == hookScript h
|
||||
|
||||
hookExists :: Hook -> Repo -> IO Bool
|
||||
hookExists h r = do
|
||||
let f = hookFile h r
|
||||
catchBoolIO $
|
||||
#ifndef mingw32_HOST_OS
|
||||
isExecutable . fileMode <$> getFileStatus f
|
||||
#else
|
||||
doesFileExist f
|
||||
#endif
|
||||
|
||||
runHook :: Hook -> Repo -> IO Bool
|
||||
runHook h r = do
|
||||
let f = hookFile h r
|
||||
(c, ps) <- findcmd f
|
||||
boolSystem c ps
|
||||
where
|
||||
#ifndef mingw32_HOST_OS
|
||||
findcmd = defcmd
|
||||
#else
|
||||
{- Like msysgit, parse the first line of the hook file,
|
||||
- look for "#!", and dispatch the interpreter on the file. -}
|
||||
findcmd f = do
|
||||
l <- headMaybe . lines <$> catchDefaultIO "" (readFile f)
|
||||
case l of
|
||||
Just ('#':'!':rest) -> case words rest of
|
||||
[] -> defcmd f
|
||||
(c:ps) -> do
|
||||
let ps' = map Param (ps ++ [f])
|
||||
ok <- inPath c
|
||||
return (if ok then c else takeFileName c, ps')
|
||||
_ -> defcmd f
|
||||
#endif
|
||||
defcmd f = return (f, [])
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue