{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}

module TiedoteMD.Git where

-- Most of this is stolen from filestore to implement gitPull, TODO: Upstream

import Codec.Binary.UTF8.String (encodeString)
import Control.Exception (throwIO)
import Control.Monad (liftM2, unless)
import Data.ByteString.Lazy.UTF8 (toString)
import Data.FileStore.Types (FileStoreError(..))
import Data.List (singleton)
import System.Directory (getTemporaryDirectory, removeFile)
import System.Environment (getEnvironment)
import System.Exit (ExitCode(..))
import System.IO (openTempFile)
import System.Process (runProcess, waitForProcess)

import qualified Control.Exception as E
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as B

import TiedoteMD.Types (GitOrigin(..))

gitPull :: FilePath -> GitOrigin -> IO ()
gitPull repo GitOrigin {url, branch} = do
    (exit, err, _) <- runGitCommand repo "fetch" (url : (maybe [] singleton branch))
    unless (exit == ExitSuccess) $ throwIO $ UnknownError $ "git-fetch failed: " <> err
    (exit', err', _) <- runGitCommand repo "reset" ["--hard","FETCH_HEAD"]
    unless (exit' == ExitSuccess) $ throwIO $ UnknownError $ "git-reset failed: " <> err'

runGitCommand :: FilePath -> String -> [String] -> IO (ExitCode, String, B.ByteString)
runGitCommand = runGitCommandWithEnv []

runGitCommandWithEnv :: [(String, String)] -> FilePath -> String -> [String] -> IO (ExitCode, String, B.ByteString)
runGitCommandWithEnv givenEnv repo command args = do
  let env = Just ([("GIT_DIFF_OPTS", "-u100000")] ++ givenEnv)
  (status, err, out) <- runShellCommand repo env "git" (command : args)
  return (status, toString err, out)

runShellCommand :: FilePath                     -- ^ Working directory
                -> Maybe [(String, String)]     -- ^ Environment
                -> String                       -- ^ Command
                -> [String]                     -- ^ Arguments
                -> IO (ExitCode, B.ByteString, B.ByteString)
runShellCommand workingDir environment command optionList = do
  tempPath <- E.catch getTemporaryDirectory (\(_ :: E.SomeException) -> return ".")
  (outputPath, hOut) <- openTempFile tempPath "out"
  (errorPath, hErr) <- openTempFile tempPath "err"
  env <- liftM2 (++) environment . Just <$> getEnvironment
  hProcess <- runProcess (encodeArg command) (map encodeArg optionList) (Just workingDir) env Nothing (Just hOut) (Just hErr)
  status <- waitForProcess hProcess
  errorOutput <- S.readFile errorPath
  output <- S.readFile outputPath
  removeFile errorPath
  removeFile outputPath
  return (status, B.fromChunks [errorOutput], B.fromChunks [output])

encodeArg :: String -> String
encodeArg = encodeString