module Git.Vogue.VCS.Git
(
gitVCS,
git
) where
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Data.Char (isSpace)
import Data.List
import Data.Monoid
import System.Directory
import System.FilePath
import System.Posix.Files
import System.Process
import Git.Vogue.Types
import Paths_git_vogue
gitVCS :: (Functor m, MonadIO m) => VCS m
gitVCS = VCS
{ getFiles = gitGetFiles
, installHook = gitAddHook
, removeHook = gitRemoveHook
, checkHook = gitCheckHook
, getTopLevel = gitTopLevel
}
gitGetFiles
:: MonadIO m
=> SearchMode
-> m [FilePath]
gitGetFiles mode = liftIO . existantFiles $
case mode of FindChanged -> git ["diff", "--cached", "--name-only"]
FindAll -> git ["ls-files"]
FindSpecific fs -> pure $ unlines fs
where
existantFiles f = lines <$> f >>= filterM doesFileExist
git :: MonadIO m => [String] -> m String
git args = liftIO $ readProcess "git" args ""
preCommitCommand :: String
preCommitCommand = "git-vogue check"
gitAddHook
:: MonadIO m
=> m ()
gitAddHook = liftIO $ do
template <- getDataFileName "templates/pre-commit"
hook <- gitHookFile
copyFile template hook
perm <- getPermissions hook
setPermissions hook $ perm { executable = True }
gitRemoveHook
:: MonadIO m
=> m ()
gitRemoveHook = liftIO $ do
template_contents <- getDataFileName "templates/pre-commit" >>= readFile
hook <- gitHookFile
hook_contents <- readFile hook
if template_contents == hook_contents then
removeFile hook
else
putStrLn $ "Your pre-commit hook appears to be modified. \n"
<> "Please manually remove:" <> hook
gitCheckHook
:: MonadIO m
=> m Bool
gitCheckHook = liftIO $ do
hook <- gitHookFile
exists <- fileExist hook
if exists
then do
c <- readFile hook
unless (preCommitCommand `isInfixOf` c) .
putStrLn $ "A pre-commit hook already exists at \n\t"
<> hook
<> "\nbut it does not contain the command\n\t"
<> preCommitCommand
<> "\nPlease edit the hook and add this command yourself!"
return True
else return False
gitHookFile
:: MonadIO m
=> m FilePath
gitHookFile = liftIO $ do
dir <- gitTopLevel
return $ dir </> ".git" </> "hooks" </> "pre-commit"
gitTopLevel
:: MonadIO m
=> m FilePath
gitTopLevel = liftIO $ do
let strip = join fmap (reverse . dropWhile isSpace)
strip <$> git ["rev-parse", "--show-toplevel"]