module Git
  ( ensureRepo
  , updateRepo
  , getCurrentBranch
  ) where

import System.Directory (doesDirectoryExist, createDirectoryIfMissing)
import System.FilePath (takeDirectory)
import System.Process (readProcess, callProcess)
import System.Exit (exitFailure)
import Control.Exception (catch, SomeException)
import Control.Monad (unless)

stackageSnapshotsUrl :: String
stackageSnapshotsUrl :: String
stackageSnapshotsUrl = String
"https://github.com/commercialhaskell/stackage-snapshots"

-- | Ensure the repository exists, cloning it if necessary
ensureRepo :: FilePath -> IO ()
ensureRepo :: String -> IO ()
ensureRepo String
repoPath = do
  exists <- String -> IO Bool
doesDirectoryExist String
repoPath
  unless exists $ cloneRepo repoPath

-- | Clone the stackage-snapshots repository
cloneRepo :: FilePath -> IO ()
cloneRepo :: String -> IO ()
cloneRepo String
repoPath = do
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
repoPath)
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Downloading repo " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
stackageSnapshotsUrl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" as shallow clone to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
repoPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
  String -> [String] -> IO ()
callProcess String
"git" [String
"clone", String
"--depth", String
"1", String
stackageSnapshotsUrl, String
repoPath]
  String -> IO ()
putStrLn String
"Clone complete."

-- | Get the current branch name
getCurrentBranch :: FilePath -> IO String
getCurrentBranch :: String -> IO String
getCurrentBranch String
repoPath = do
  String -> String
trim (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"git" [String
"-C", String
repoPath, String
"rev-parse", String
"--abbrev-ref", String
"HEAD"] String
""

-- | Update the repository by pulling
updateRepo :: FilePath -> IO ()
updateRepo :: String -> IO ()
updateRepo String
repoPath = do
  branch <- String -> IO String
getCurrentBranch String
repoPath
  if branch /= "master"
    then do
      putStrLn $ "Error: Repository is on branch '" ++ branch ++ "', not 'master'."
      putStrLn "Cannot update repository when not on master branch."
      exitFailure
    else do
      putStrLn $ "Updating repository at " ++ repoPath ++ "..."
      catch
        (callProcess "git" ["-C", repoPath, "pull"])
        (\(SomeException
e :: SomeException) -> do
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Warning: Failed to update repository: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
          () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      putStrLn "Update complete."

-- | Trim whitespace from a string
trim :: String -> String
trim :: String -> String
trim = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" \t\n\r") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" \t\n\r")