Windows: Fix running of the pre-commit-annex hook.

1 files changed, 40 insertions, 1 deletions

diff --git a/Git/Hook.hs b/Git/Hook.hs
index 6245a292d..0ea9fd1e7 100644
--- a/Git/Hook.hs
+++ b/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, [])