{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DoAndIfThenElse #-}
module Data.FileStore.Git
( gitFileStore
)
where
import Data.FileStore.Types
import Data.Maybe (fromMaybe, mapMaybe)
import Data.List.Split (endByOneOf)
import System.Exit
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.FileStore.Utils (withSanityCheck, hashsMatch, runShellCommand, escapeRegexSpecialChars, withVerifyDir, encodeArg)
import Data.ByteString.Lazy.UTF8 (toString)
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad (when)
import System.FilePath ((</>), splitFileName)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, executable, getPermissions, setPermissions)
import Control.Exception (throwIO)
import qualified Control.Exception as E
gitFileStore :: FilePath -> FileStore
gitFileStore :: FilePath -> FileStore
gitFileStore FilePath
repo = FileStore :: IO ()
-> (forall a.
Contents a =>
FilePath -> Author -> FilePath -> a -> IO ())
-> (forall a. Contents a => FilePath -> Maybe FilePath -> IO a)
-> (FilePath -> Author -> FilePath -> IO ())
-> (FilePath -> FilePath -> Author -> FilePath -> IO ())
-> ([FilePath] -> TimeRange -> Maybe Int -> IO [Revision])
-> (FilePath -> IO FilePath)
-> (FilePath -> IO Revision)
-> IO [FilePath]
-> (FilePath -> IO [Resource])
-> (FilePath -> FilePath -> Bool)
-> (SearchQuery -> IO [SearchMatch])
-> FileStore
FileStore {
initialize :: IO ()
initialize = FilePath -> IO ()
gitInit FilePath
repo
, save :: forall a.
Contents a =>
FilePath -> Author -> FilePath -> a -> IO ()
save = FilePath -> FilePath -> Author -> FilePath -> a -> IO ()
forall a.
Contents a =>
FilePath -> FilePath -> Author -> FilePath -> a -> IO ()
gitSave FilePath
repo
, retrieve :: forall a. Contents a => FilePath -> Maybe FilePath -> IO a
retrieve = FilePath -> FilePath -> Maybe FilePath -> IO a
forall a.
Contents a =>
FilePath -> FilePath -> Maybe FilePath -> IO a
gitRetrieve FilePath
repo
, delete :: FilePath -> Author -> FilePath -> IO ()
delete = FilePath -> FilePath -> Author -> FilePath -> IO ()
gitDelete FilePath
repo
, rename :: FilePath -> FilePath -> Author -> FilePath -> IO ()
rename = FilePath -> FilePath -> FilePath -> Author -> FilePath -> IO ()
gitMove FilePath
repo
, history :: [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
history = FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
gitLog FilePath
repo
, latest :: FilePath -> IO FilePath
latest = FilePath -> FilePath -> IO FilePath
gitLatestRevId FilePath
repo
, revision :: FilePath -> IO Revision
revision = FilePath -> FilePath -> IO Revision
gitGetRevision FilePath
repo
, index :: IO [FilePath]
index = FilePath -> IO [FilePath]
gitIndex FilePath
repo
, directory :: FilePath -> IO [Resource]
directory = FilePath -> FilePath -> IO [Resource]
gitDirectory FilePath
repo
, search :: SearchQuery -> IO [SearchMatch]
search = FilePath -> SearchQuery -> IO [SearchMatch]
gitSearch FilePath
repo
, idsMatch :: FilePath -> FilePath -> Bool
idsMatch = (FilePath -> FilePath -> Bool)
-> FilePath -> FilePath -> FilePath -> Bool
forall a b. a -> b -> a
const FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
hashsMatch FilePath
repo
}
runGitCommand :: FilePath -> String -> [String] -> IO (ExitCode, String, B.ByteString)
runGitCommand :: FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand = [(FilePath, FilePath)]
-> FilePath
-> FilePath
-> [FilePath]
-> IO (ExitCode, FilePath, ByteString)
runGitCommandWithEnv []
runGitCommandWithEnv :: [(String, String)] -> FilePath -> String -> [String] -> IO (ExitCode, String, B.ByteString)
runGitCommandWithEnv :: [(FilePath, FilePath)]
-> FilePath
-> FilePath
-> [FilePath]
-> IO (ExitCode, FilePath, ByteString)
runGitCommandWithEnv [(FilePath, FilePath)]
givenEnv FilePath
repo FilePath
command [FilePath]
args = do
let env :: Maybe [(FilePath, FilePath)]
env = [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just ([(FilePath
"GIT_DIFF_OPTS", FilePath
"-u100000")] [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
givenEnv)
(ExitCode
status, ByteString
err, ByteString
out) <- FilePath
-> Maybe [(FilePath, FilePath)]
-> FilePath
-> [FilePath]
-> IO (ExitCode, ByteString, ByteString)
runShellCommand FilePath
repo Maybe [(FilePath, FilePath)]
env FilePath
"git" (FilePath
command FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
args)
(ExitCode, FilePath, ByteString)
-> IO (ExitCode, FilePath, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
status, ByteString -> FilePath
toString ByteString
err, ByteString
out)
gitInit :: FilePath -> IO ()
gitInit :: FilePath -> IO ()
gitInit FilePath
repo = do
Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
repo
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
withVerifyDir FilePath
repo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileStoreError
RepositoryExists
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
repo
(ExitCode
status, FilePath
err, ByteString
_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"init" []
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then do
let postupdatedir :: FilePath
postupdatedir = FilePath
repo FilePath -> FilePath -> FilePath
</> FilePath
".git" FilePath -> FilePath -> FilePath
</> FilePath
"hooks"
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
postupdatedir
let postupdate :: FilePath
postupdate = FilePath
postupdatedir FilePath -> FilePath -> FilePath
</> FilePath
"post-update"
FilePath -> ByteString -> IO ()
B.writeFile FilePath
postupdate ByteString
postUpdate
Permissions
perms <- FilePath -> IO Permissions
getPermissions FilePath
postupdate
FilePath -> Permissions -> IO ()
setPermissions FilePath
postupdate (Permissions
perms {executable :: Bool
executable = Bool
True})
(ExitCode
status', FilePath
err', ByteString
_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"config" [FilePath
"receive.denyCurrentBranch",FilePath
"ignore"]
if ExitCode
status' ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"git config failed:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err'
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"git-init failed:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
gitCommit :: FilePath -> [FilePath] -> Author -> String -> IO ()
gitCommit :: FilePath -> [FilePath] -> Author -> FilePath -> IO ()
gitCommit FilePath
repo [FilePath]
names Author
author FilePath
logMsg = do
let env :: [(FilePath, FilePath)]
env = [(FilePath
"GIT_COMMITTER_NAME", Author -> FilePath
authorName Author
author),
(FilePath
"GIT_COMMITTER_EMAIL", Author -> FilePath
authorEmail Author
author)]
(ExitCode
statusCommit, FilePath
errCommit, ByteString
_) <- [(FilePath, FilePath)]
-> FilePath
-> FilePath
-> [FilePath]
-> IO (ExitCode, FilePath, ByteString)
runGitCommandWithEnv [(FilePath, FilePath)]
env FilePath
repo FilePath
"commit" ([FilePath] -> IO (ExitCode, FilePath, ByteString))
-> [FilePath] -> IO (ExitCode, FilePath, ByteString)
forall a b. (a -> b) -> a -> b
$ [FilePath
"--author", Author -> FilePath
authorName Author
author FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" <" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
Author -> FilePath
authorEmail Author
author FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
">", FilePath
"-m", FilePath
logMsg] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
names
if ExitCode
statusCommit ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
errCommit
then FileStoreError
Unchanged
else FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not git commit " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
names FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errCommit
gitSave :: Contents a => FilePath -> FilePath -> Author -> Description -> a -> IO ()
gitSave :: FilePath -> FilePath -> Author -> FilePath -> a -> IO ()
gitSave FilePath
repo FilePath
name Author
author FilePath
logMsg a
contents = do
FilePath -> [FilePath] -> FilePath -> IO () -> IO ()
forall b. FilePath -> [FilePath] -> FilePath -> IO b -> IO b
withSanityCheck FilePath
repo [FilePath
".git"] FilePath
name (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
B.writeFile (FilePath
repo FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
encodeArg FilePath
name) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Contents a => a -> ByteString
toByteString a
contents
(ExitCode
statusAdd, FilePath
errAdd, ByteString
_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"add" [FilePath
name]
if ExitCode
statusAdd ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then FilePath -> [FilePath] -> Author -> FilePath -> IO ()
gitCommit FilePath
repo [FilePath
name] Author
author FilePath
logMsg
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not git add '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errAdd
isSymlink :: FilePath -> FilePath -> Maybe RevisionId -> IO Bool
isSymlink :: FilePath -> FilePath -> Maybe FilePath -> IO Bool
isSymlink FilePath
repo FilePath
name Maybe FilePath
revid = do
(ExitCode
_, FilePath
_, ByteString
out) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"ls-tree" [FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"HEAD" Maybe FilePath
revid, FilePath
name]
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
6 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
B.unpack ByteString
out) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"120000"
targetContents :: Contents a => FilePath -> FilePath -> a -> IO (Maybe a)
targetContents :: FilePath -> FilePath -> a -> IO (Maybe a)
targetContents FilePath
repo FilePath
linkName a
linkContent = do
let (FilePath
dirName, FilePath
_) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
linkName
targetName :: FilePath
targetName = FilePath
repo FilePath -> FilePath -> FilePath
</> FilePath
dirName FilePath -> FilePath -> FilePath
</> (ByteString -> FilePath
B.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Contents a => a -> ByteString
toByteString a
linkContent)
Either SomeException ByteString
result <- IO ByteString -> IO (Either SomeException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO ByteString -> IO (Either SomeException ByteString))
-> IO ByteString -> IO (Either SomeException ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile FilePath
targetName
case Either SomeException ByteString
result of
Left (SomeException
_ :: E.SomeException) -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Right ByteString
contents -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (ByteString -> a
forall a. Contents a => ByteString -> a
fromByteString ByteString
contents)
gitRetrieve :: Contents a
=> FilePath
-> FilePath
-> Maybe RevisionId
-> IO a
gitRetrieve :: FilePath -> FilePath -> Maybe FilePath -> IO a
gitRetrieve FilePath
repo FilePath
name Maybe FilePath
revid = do
let objectName :: FilePath
objectName = case Maybe FilePath
revid of
Maybe FilePath
Nothing -> FilePath
"HEAD:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name
Just FilePath
rev -> FilePath
rev FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name
(ExitCode
_, FilePath
_, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"cat-file" [FilePath
"-t", FilePath
objectName]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
4 (ByteString -> FilePath
toString ByteString
output) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"blob") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
(ExitCode
status', FilePath
err', ByteString
output') <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"cat-file" [FilePath
"-p", FilePath
objectName]
if ExitCode
status' ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then do
Bool
isLink <- FilePath -> FilePath -> Maybe FilePath -> IO Bool
isSymlink FilePath
repo FilePath
name Maybe FilePath
revid
if Bool
isLink
then do
Maybe ByteString
contents <- FilePath -> FilePath -> ByteString -> IO (Maybe ByteString)
forall a. Contents a => FilePath -> FilePath -> a -> IO (Maybe a)
targetContents FilePath
repo FilePath
name ByteString
output'
case Maybe ByteString
contents of
Maybe ByteString
Nothing -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall a. Contents a => ByteString -> a
fromByteString ByteString
output'
Just ByteString
bs -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall a. Contents a => ByteString -> a
fromByteString ByteString
bs
else a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall a. Contents a => ByteString -> a
fromByteString ByteString
output'
else FileStoreError -> IO a
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO a) -> FileStoreError -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"Error in git cat-file:\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err'
gitDelete :: FilePath -> FilePath -> Author -> Description -> IO ()
gitDelete :: FilePath -> FilePath -> Author -> FilePath -> IO ()
gitDelete FilePath
repo FilePath
name Author
author FilePath
logMsg = FilePath -> [FilePath] -> FilePath -> IO () -> IO ()
forall b. FilePath -> [FilePath] -> FilePath -> IO b -> IO b
withSanityCheck FilePath
repo [FilePath
".git"] FilePath
name (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(ExitCode
statusAdd, FilePath
errRm, ByteString
_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"rm" [FilePath
name]
if ExitCode
statusAdd ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then FilePath -> [FilePath] -> Author -> FilePath -> IO ()
gitCommit FilePath
repo [FilePath
name] Author
author FilePath
logMsg
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not git rm '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errRm
gitMove :: FilePath -> FilePath -> FilePath -> Author -> Description -> IO ()
gitMove :: FilePath -> FilePath -> FilePath -> Author -> FilePath -> IO ()
gitMove FilePath
repo FilePath
oldName FilePath
newName Author
author FilePath
logMsg = do
FilePath
_ <- FilePath -> FilePath -> IO FilePath
gitLatestRevId FilePath
repo FilePath
oldName
(ExitCode
statusAdd, FilePath
err, ByteString
_) <- FilePath
-> [FilePath]
-> FilePath
-> IO (ExitCode, FilePath, ByteString)
-> IO (ExitCode, FilePath, ByteString)
forall b. FilePath -> [FilePath] -> FilePath -> IO b -> IO b
withSanityCheck FilePath
repo [FilePath
".git"] FilePath
newName (IO (ExitCode, FilePath, ByteString)
-> IO (ExitCode, FilePath, ByteString))
-> IO (ExitCode, FilePath, ByteString)
-> IO (ExitCode, FilePath, ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"mv" [FilePath
oldName, FilePath
newName]
if ExitCode
statusAdd ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then FilePath -> [FilePath] -> Author -> FilePath -> IO ()
gitCommit FilePath
repo [FilePath
oldName, FilePath
newName] Author
author FilePath
logMsg
else FileStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO ()) -> FileStoreError -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not git mv " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
oldName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
newName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
gitLatestRevId :: FilePath -> FilePath -> IO RevisionId
gitLatestRevId :: FilePath -> FilePath -> IO FilePath
gitLatestRevId FilePath
repo FilePath
name = do
(ExitCode
revListStatus, FilePath
_, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"rev-list" [FilePath
"--max-count=1", FilePath
"HEAD", FilePath
"--", FilePath
name]
(ExitCode
catStatus,FilePath
_, ByteString
_) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"cat-file" [FilePath
"-e", FilePath
"HEAD:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name]
if ExitCode
revListStatus ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
&& ExitCode
catStatus ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then do
let result :: FilePath
result = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` FilePath
"\n\r \t") (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
toString ByteString
output
if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
result
then FileStoreError -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
else FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
result
else FileStoreError -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
gitGetRevision :: FilePath -> RevisionId -> IO Revision
gitGetRevision :: FilePath -> FilePath -> IO Revision
gitGetRevision FilePath
repo FilePath
revid = do
(ExitCode
status, FilePath
_, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"whatchanged" [FilePath
"-z",FilePath
"--pretty=format:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
gitLogFormat, FilePath
"--max-count=1", FilePath
revid]
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then ByteString -> IO Revision
parseLogEntry (ByteString -> IO Revision) -> ByteString -> IO Revision
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
B.drop Int64
1 ByteString
output
else FileStoreError -> IO Revision
forall e a. Exception e => e -> IO a
throwIO FileStoreError
NotFound
gitIndex :: FilePath ->IO [FilePath]
gitIndex :: FilePath -> IO [FilePath]
gitIndex FilePath
repo = FilePath -> IO [FilePath] -> IO [FilePath]
forall a. FilePath -> IO a -> IO a
withVerifyDir FilePath
repo (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
(ExitCode
status, FilePath
_err, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"ls-tree" [FilePath
"-r",FilePath
"-t",FilePath
"-z",FilePath
"HEAD"]
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([FilePath] -> Maybe FilePath
lineToFilename ([FilePath] -> Maybe FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words) ([FilePath] -> [FilePath])
-> (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
endByOneOf [Char
'\0'] (FilePath -> [FilePath])
-> (ByteString -> FilePath) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
toString (ByteString -> [FilePath]) -> ByteString -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString
output
else [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
where lineToFilename :: [FilePath] -> Maybe FilePath
lineToFilename (FilePath
_:FilePath
"blob":FilePath
_:[FilePath]
rest) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath]
rest
lineToFilename [FilePath]
_ = Maybe FilePath
forall a. Maybe a
Nothing
gitDirectory :: FilePath -> FilePath -> IO [Resource]
gitDirectory :: FilePath -> FilePath -> IO [Resource]
gitDirectory FilePath
repo FilePath
dir = FilePath -> IO [Resource] -> IO [Resource]
forall a. FilePath -> IO a -> IO a
withVerifyDir (FilePath
repo FilePath -> FilePath -> FilePath
</> FilePath
dir) (IO [Resource] -> IO [Resource]) -> IO [Resource] -> IO [Resource]
forall a b. (a -> b) -> a -> b
$ do
(ExitCode
status, FilePath
_err, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"ls-tree" [FilePath
"-z",FilePath
"HEAD:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir]
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then [Resource] -> IO [Resource]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Resource] -> IO [Resource]) -> [Resource] -> IO [Resource]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Resource) -> [FilePath] -> [Resource]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> Resource
lineToResource ([FilePath] -> Resource)
-> (FilePath -> [FilePath]) -> FilePath -> Resource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words) ([FilePath] -> [Resource]) -> [FilePath] -> [Resource]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
endByOneOf [Char
'\0'] (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
toString ByteString
output
else [Resource] -> IO [Resource]
forall (m :: * -> *) a. Monad m => a -> m a
return []
where lineToResource :: [FilePath] -> Resource
lineToResource (FilePath
_:FilePath
"blob":FilePath
_:[FilePath]
rest) = FilePath -> Resource
FSFile (FilePath -> Resource) -> FilePath -> Resource
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath]
rest
lineToResource (FilePath
_:FilePath
"tree":FilePath
_:[FilePath]
rest) = FilePath -> Resource
FSDirectory (FilePath -> Resource) -> FilePath -> Resource
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath]
rest
lineToResource [FilePath]
_ = FilePath -> Resource
forall a. HasCallStack => FilePath -> a
error FilePath
"Encountered an item that is neither blob nor tree in git ls-tree"
gitSearch :: FilePath -> SearchQuery -> IO [SearchMatch]
gitSearch :: FilePath -> SearchQuery -> IO [SearchMatch]
gitSearch FilePath
repo SearchQuery
query = do
let opts :: [FilePath]
opts = [FilePath
"-I",FilePath
"-n",FilePath
"--null"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath
"--ignore-case" | SearchQuery -> Bool
queryIgnoreCase SearchQuery
query] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath
"--all-match" | SearchQuery -> Bool
queryMatchAll SearchQuery
query] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath
"--word-regexp" | SearchQuery -> Bool
queryWholeWords SearchQuery
query]
(ExitCode
status, FilePath
errOutput, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"grep" ([FilePath]
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
(FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\FilePath
term -> [FilePath
"-e", FilePath -> FilePath
escapeRegexSpecialChars FilePath
term]) (SearchQuery -> [FilePath]
queryPatterns SearchQuery
query))
case ExitCode
status of
ExitCode
ExitSuccess -> [SearchMatch] -> IO [SearchMatch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SearchMatch] -> IO [SearchMatch])
-> [SearchMatch] -> IO [SearchMatch]
forall a b. (a -> b) -> a -> b
$ (FilePath -> SearchMatch) -> [FilePath] -> [SearchMatch]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> SearchMatch
parseMatchLine ([FilePath] -> [SearchMatch]) -> [FilePath] -> [SearchMatch]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
toString ByteString
output
ExitFailure Int
1 -> [SearchMatch] -> IO [SearchMatch]
forall (m :: * -> *) a. Monad m => a -> m a
return []
ExitFailure Int
_ -> FileStoreError -> IO [SearchMatch]
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO [SearchMatch])
-> FileStoreError -> IO [SearchMatch]
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"git grep returned error status.\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errOutput
parseMatchLine :: String -> SearchMatch
parseMatchLine :: FilePath -> SearchMatch
parseMatchLine FilePath
str =
SearchMatch :: FilePath -> Integer -> FilePath -> SearchMatch
SearchMatch{ matchResourceName :: FilePath
matchResourceName = FilePath
fname
, matchLineNumber :: Integer
matchLineNumber = if Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
ln)
then FilePath -> Integer
forall a. Read a => FilePath -> a
read FilePath
ln
else FilePath -> Integer
forall a. HasCallStack => FilePath -> a
error (FilePath -> Integer) -> FilePath -> Integer
forall a b. (a -> b) -> a -> b
$ FilePath
"parseMatchLine: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
str
, matchLine :: FilePath
matchLine = FilePath
cont}
where (FilePath
fname,FilePath
xs) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\NUL') FilePath
str
rest :: FilePath
rest = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
xs
(FilePath
ln,FilePath
ys) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0'..Char
'9']) FilePath
rest
cont :: FilePath
cont = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
ys
gitLogFormat :: String
gitLogFormat :: FilePath
gitLogFormat = FilePath
"%x01%H%x00%ct%x00%an%x00%ae%x00%B%n%x00"
gitLog :: FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
gitLog :: FilePath -> [FilePath] -> TimeRange -> Maybe Int -> IO [Revision]
gitLog FilePath
repo [FilePath]
names (TimeRange Maybe UTCTime
mbSince Maybe UTCTime
mbUntil) Maybe Int
mblimit = do
(ExitCode
status, FilePath
err, ByteString
output) <- FilePath
-> FilePath -> [FilePath] -> IO (ExitCode, FilePath, ByteString)
runGitCommand FilePath
repo FilePath
"whatchanged" ([FilePath] -> IO (ExitCode, FilePath, ByteString))
-> [FilePath] -> IO (ExitCode, FilePath, ByteString)
forall a b. (a -> b) -> a -> b
$
[FilePath
"-z",FilePath
"--pretty=format:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
gitLogFormat] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
(case Maybe UTCTime
mbSince of
Just UTCTime
since -> [FilePath
"--since='" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UTCTime -> FilePath
forall a. Show a => a -> FilePath
show UTCTime
since FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"]
Maybe UTCTime
Nothing -> []) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
(case Maybe UTCTime
mbUntil of
Just UTCTime
til -> [FilePath
"--until='" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UTCTime -> FilePath
forall a. Show a => a -> FilePath
show UTCTime
til FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"'"]
Maybe UTCTime
Nothing -> []) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
(case Maybe Int
mblimit of
Just Int
lim -> [FilePath
"-n", Int -> FilePath
forall a. Show a => a -> FilePath
show Int
lim]
Maybe Int
Nothing -> []) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[FilePath
"--"] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
names
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then ByteString -> IO [Revision]
parseGitLog ByteString
output
else FileStoreError -> IO [Revision]
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO [Revision])
-> FileStoreError -> IO [Revision]
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"git whatchanged returned error status.\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err
parseGitLog :: B.ByteString -> IO [Revision]
parseGitLog :: ByteString -> IO [Revision]
parseGitLog = (ByteString -> IO Revision) -> [ByteString] -> IO [Revision]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> IO Revision
parseLogEntry ([ByteString] -> IO [Revision])
-> (ByteString -> [ByteString]) -> ByteString -> IO [Revision]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitEntries
splitEntries :: B.ByteString -> [B.ByteString]
splitEntries :: ByteString -> [ByteString]
splitEntries = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ByteString -> Bool
B.null ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
B.split Char
'\1'
parseLogEntry :: B.ByteString -> IO Revision
parseLogEntry :: ByteString -> IO Revision
parseLogEntry ByteString
entry = do
let (ByteString
rev : ByteString
date' : ByteString
author : ByteString
email : ByteString
subject : [ByteString]
rest) = Char -> ByteString -> [ByteString]
B.split Char
'\0' ByteString
entry
Integer
date <- case ByteString -> Maybe (Integer, ByteString)
B.readInteger ByteString
date' of
Just (Integer
x,ByteString
_) -> Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
x
Maybe (Integer, ByteString)
Nothing -> FileStoreError -> IO Integer
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO Integer) -> FileStoreError -> IO Integer
forall a b. (a -> b) -> a -> b
$ FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError) -> FilePath -> FileStoreError
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not read date"
[Change]
changes <- [ByteString] -> IO [Change]
parseChanges ([ByteString] -> IO [Change]) -> [ByteString] -> IO [Change]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null) [ByteString]
rest
Revision -> IO Revision
forall (m :: * -> *) a. Monad m => a -> m a
return Revision :: FilePath -> UTCTime -> Author -> FilePath -> [Change] -> Revision
Revision {
revId :: FilePath
revId = ByteString -> FilePath
toString ByteString
rev
, revDateTime :: UTCTime
revDateTime = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
date
, revAuthor :: Author
revAuthor = Author :: FilePath -> FilePath -> Author
Author{ authorName :: FilePath
authorName = ByteString -> FilePath
toString ByteString
author
, authorEmail :: FilePath
authorEmail = ByteString -> FilePath
toString ByteString
email }
, revDescription :: FilePath
revDescription = ByteString -> FilePath
toString (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
stripTrailingNewlines ByteString
subject
, revChanges :: [Change]
revChanges = [Change]
changes }
stripTrailingNewlines :: B.ByteString -> B.ByteString
stripTrailingNewlines :: ByteString -> ByteString
stripTrailingNewlines = ByteString -> ByteString
B.reverse (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.reverse
parseChanges :: [B.ByteString] -> IO [Change]
parseChanges :: [ByteString] -> IO [Change]
parseChanges (ByteString
x:ByteString
y:[ByteString]
zs) = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
B.null ByteString
x) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. FilePath -> IO a
pcErr FilePath
"found empty change description"
let changeType :: Char
changeType = ByteString -> Char
B.head (ByteString -> Char) -> ByteString -> Char
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. [a] -> a
last ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
B.words ByteString
x
let file' :: FilePath
file' = ByteString -> FilePath
toString ByteString
y
if Char
changeType Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'R'
then [ByteString] -> IO [Change]
parseChanges ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail [ByteString]
zs) IO [Change] -> ([Change] -> IO [Change]) -> IO [Change]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
[Change] -> IO [Change]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Change] -> IO [Change])
-> ([Change] -> [Change]) -> [Change] -> IO [Change]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Change] -> [Change] -> [Change]
forall a. [a] -> [a] -> [a]
(++) (FilePath -> Change
Deleted FilePath
file' Change -> [Change] -> [Change]
forall a. a -> [a] -> [a]
: FilePath -> Change
Added (ByteString -> FilePath
toString (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
zs) Change -> [Change] -> [Change]
forall a. a -> [a] -> [a]
: [])
else
do Change
next <- case Char
changeType of
Char
'A' -> Change -> IO Change
forall (m :: * -> *) a. Monad m => a -> m a
return (Change -> IO Change) -> Change -> IO Change
forall a b. (a -> b) -> a -> b
$ FilePath -> Change
Added FilePath
file'
Char
'M' -> Change -> IO Change
forall (m :: * -> *) a. Monad m => a -> m a
return (Change -> IO Change) -> Change -> IO Change
forall a b. (a -> b) -> a -> b
$ FilePath -> Change
Modified FilePath
file'
Char
'D' -> Change -> IO Change
forall (m :: * -> *) a. Monad m => a -> m a
return (Change -> IO Change) -> Change -> IO Change
forall a b. (a -> b) -> a -> b
$ FilePath -> Change
Deleted FilePath
file'
Char
_ -> FilePath -> IO Change
forall a. FilePath -> IO a
pcErr (FilePath
"found unknown changeType '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
(Char -> FilePath
forall a. Show a => a -> FilePath
show Char
changeType) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
"' in: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
x) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" on " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
y))
[Change]
rest <- [ByteString] -> IO [Change]
parseChanges [ByteString]
zs
[Change] -> IO [Change]
forall (m :: * -> *) a. Monad m => a -> m a
return (Change
nextChange -> [Change] -> [Change]
forall a. a -> [a] -> [a]
:[Change]
rest)
parseChanges [ByteString
_] =
FilePath -> IO [Change]
forall a. FilePath -> IO a
pcErr FilePath
"encountered odd number of fields"
parseChanges [] = [Change] -> IO [Change]
forall (m :: * -> *) a. Monad m => a -> m a
return []
pcErr :: forall a. String -> IO a
pcErr :: FilePath -> IO a
pcErr = FileStoreError -> IO a
forall e a. Exception e => e -> IO a
throwIO (FileStoreError -> IO a)
-> (FilePath -> FileStoreError) -> FilePath -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FileStoreError
UnknownError (FilePath -> FileStoreError)
-> (FilePath -> FilePath) -> FilePath -> FileStoreError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
(++) FilePath
"filestore parseChanges "
postUpdate :: B.ByteString
postUpdate :: ByteString
postUpdate =
FilePath -> ByteString
B.pack
FilePath
"#!/bin/bash\n\
\#\n\
\# This hook does two things:\n\
\#\n\
\# 1. update the \"info\" files that allow the list of references to be\n\
\# queries over dumb transports such as http\n\
\#\n\
\# 2. if this repository looks like it is a non-bare repository, and\n\
\# the checked-out branch is pushed to, then update the working copy.\n\
\# This makes \"push\" function somewhat similarly to darcs and bzr.\n\
\#\n\
\# To enable this hook, make this file executable by \"chmod +x post-update\".\n\
\\n\
\git-update-server-info\n\
\\n\
\is_bare=$(git-config --get --bool core.bare)\n\
\\n\
\if [ -z \"$is_bare\" ]\n\
\then\n\
\ # for compatibility's sake, guess\n\
\ git_dir_full=$(cd $GIT_DIR; pwd)\n\
\ case $git_dir_full in */.git) is_bare=false;; *) is_bare=true;; esac\n\
\fi\n\
\\n\
\update_wc() {\n\
\ ref=$1\n\
\ echo \"Push to checked out branch $ref\" >&2\n\
\ if [ ! -f $GIT_DIR/logs/HEAD ]\n\
\ then\n\
\ echo \"E:push to non-bare repository requires a HEAD reflog\" >&2\n\
\ exit 1\n\
\ fi\n\
\ if (cd $GIT_WORK_TREE; git-diff-files -q --exit-code >/dev/null)\n\
\ then\n\
\ wc_dirty=0\n\
\ else\n\
\ echo \"W:unstaged changes found in working copy\" >&2\n\
\ wc_dirty=1\n\
\ desc=\"working copy\"\n\
\ fi\n\
\ if git diff-index --cached HEAD@{1} >/dev/null\n\
\ then\n\
\ index_dirty=0\n\
\ else\n\
\ echo \"W:uncommitted, staged changes found\" >&2\n\
\ index_dirty=1\n\
\ if [ -n \"$desc\" ]\n\
\ then\n\
\ desc=\"$desc and index\"\n\
\ else\n\
\ desc=\"index\"\n\
\ fi\n\
\ fi\n\
\ if [ \"$wc_dirty\" -ne 0 -o \"$index_dirty\" -ne 0 ]\n\
\ then\n\
\ new=$(git rev-parse HEAD)\n\
\ echo \"W:stashing dirty $desc - see git-stash(1)\" >&2\n\
\ ( trap 'echo trapped $$; git symbolic-ref HEAD \"'\"$ref\"'\"' 2 3 13 15 ERR EXIT\n\
\ git-update-ref --no-deref HEAD HEAD@{1}\n\
\ cd $GIT_WORK_TREE\n\
\ git stash save \"dirty $desc before update to $new\";\n\
\ git-symbolic-ref HEAD \"$ref\"\n\
\ )\n\
\ fi\n\
\\n\
\ # eye candy - show the WC updates :)\n\
\ echo \"Updating working copy\" >&2\n\
\ (cd $GIT_WORK_TREE\n\
\ git-diff-index -R --name-status HEAD >&2\n\
\ git-reset --hard HEAD)\n\
\}\n\
\\n\
\if [ \"$is_bare\" = \"false\" ]\n\
\then\n\
\ active_branch=`git-symbolic-ref HEAD`\n\
\ export GIT_DIR=$(cd $GIT_DIR; pwd)\n\
\ GIT_WORK_TREE=${GIT_WORK_TREE-..}\n\
\ for ref\n\
\ do\n\
\ if [ \"$ref\" = \"$active_branch\" ]\n\
\ then\n\
\ update_wc $ref\n\
\ fi\n\
\ done\n\
\fi"