-- | Git related functions that belong in some other package.

{-# LANGUAGE ScopedTypeVariables #-}

module System.Git
    ( gitResetHard
    , gitResetSubdir
    , gitUnclean
    , gitIsClean
    , withCleanRepo
    ) where

import Control.Exception (catch, SomeException, throw)
import System.Directory (getCurrentDirectory)
import System.Exit (ExitCode(ExitSuccess, ExitFailure))
import System.IO (hPutStrLn, stderr)
import System.Process (readProcessWithExitCode, readProcess)

-- | Do a hard reset of all the files of the repository containing the
-- working directory.
gitResetHard :: IO ()
gitResetHard :: IO ()
gitResetHard = do
  (ExitCode
code, FilePath
_out, FilePath
_err) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
"git" [FilePath
"reset", FilePath
"--hard"] FilePath
""
  case ExitCode
code of
    ExitCode
ExitSuccess -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ExitFailure Int
_n -> forall a. HasCallStack => FilePath -> a
error FilePath
"gitResetHard"

-- | Do a hard reset of all the files of a subdirectory within a git
-- repository.  (Does this every throw an exception?)
gitResetSubdir :: FilePath -> IO ()
gitResetSubdir :: FilePath -> IO ()
gitResetSubdir FilePath
dir = do
  (FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
"git" [FilePath
"checkout", FilePath
"--", FilePath
dir] FilePath
"" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
   FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
"git" [FilePath
"clean", FilePath
"-f", FilePath
dir] FilePath
"" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
e :: SomeException) -> Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"gitResetSubdir " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
" failed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show SomeException
e) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a e. Exception e => e -> a
throw SomeException
e

-- | Determine whether the repository containing the working directory
-- is in a modified state, if so return the messages.
gitUnclean :: IO (Maybe String)
gitUnclean :: IO (Maybe FilePath)
gitUnclean = do
  FilePath
here <- IO FilePath
getCurrentDirectory
  Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath
"here: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
here)
  (ExitCode
code, FilePath
out, FilePath
_err) <- FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
"git" [FilePath
"status", FilePath
"--porcelain"] FilePath
""
  case ExitCode
code of
    ExitFailure Int
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"gitCheckClean failure"
    ExitCode
ExitSuccess | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all FilePath -> Bool
unmodified (FilePath -> [FilePath]
lines FilePath
out) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    ExitCode
ExitSuccess -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just FilePath
out
    where
      unmodified :: FilePath -> Bool
unmodified (Char
a : Char
b : FilePath
_) = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
a FilePath
"?! " Bool -> Bool -> Bool
&& forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
b FilePath
"?! "
      unmodified FilePath
_ = Bool
False

gitIsClean :: IO Bool
gitIsClean :: IO Bool
gitIsClean = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a b. a -> b -> a
const Bool
False) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe FilePath)
gitUnclean

withCleanRepo :: IO a -> IO a
withCleanRepo :: forall a. IO a -> IO a
withCleanRepo IO a
action = do
  IO (Maybe FilePath)
gitUnclean forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO a
action (\FilePath
s -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"withCleanRepo: please commit or revert changes:\n" forall a. [a] -> [a] -> [a]
++ FilePath
s)