content: --
  -- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others
  --
  -- The code in this file, and the program it is a part of, is
  -- made available to you by its authors as open source software:
  -- you can redistribute it and/or modify it under the terms of
  -- the 3-clause BSD licence.
  --
  
   -- | Provide a VCS implementation for git repositories
  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 ""
  
  --- | Command string to insert into pre-commit hooks.
  preCommitCommand :: String
  preCommitCommand = "git-vogue check"
  
  -- | Add the git pre-commit hook.
  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 }
  
  -- | Remove the hook iff it is precicely the same as the template.
  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
  
  -- | Use a predicate to check a git commit 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
  
  -- | Where the pre-commit hook lives
  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"]
  