Skip to content
This repository was archived by the owner on Jan 3, 2024. It is now read-only.

Fix a number of issues #15

Merged
merged 1 commit into from
Jan 3, 2024
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 11 additions & 7 deletions src/Development/GitRev.hs
Original file line number Diff line number Diff line change
Expand Up @@ -67,21 +67,22 @@ runGit args def useIdx = do
then do
-- a lot of bookkeeping to record the right dependencies
pwd <- runIO getDotGit
let hd = pwd </> ".git" </> "HEAD"
index = pwd </> ".git" </> "index"
packedRefs = pwd </> ".git" </> "packed-refs"
let hd = pwd </> "HEAD"
index = pwd </> "index"
packedRefs = pwd </> "packed-refs"
hdExists <- runIO $ doesFileExist hd
when hdExists $ do
addDependentFile hd
-- the HEAD file either contains the hash of a detached head
-- or a pointer to the file that contains the hash of the head
splitAt 5 `fmap` runIO (readFile hd) >>= \case
-- pointer to ref
("ref: ", relRef) -> do
let ref = pwd </> ".git" </> relRef
let ref = pwd </> tillNewLine relRef
refExists <- runIO $ doesFileExist ref
when refExists $ addDependentFile ref
-- detached head
_hash -> addDependentFile hd
_hash -> return ()
-- add the index if it exists to set the dirty flag
indexExists <- runIO $ doesFileExist index
when (indexExists && useIdx == IdxUsed) $ addDependentFile index
Expand All @@ -93,10 +94,13 @@ runGit args def useIdx = do
runIO $ do
(code, out, _err) <- readProcessWithExitCode "git" args "" `catch` oops
case code of
ExitSuccess -> return (takeWhile (/= '\n') out)
ExitSuccess -> return (tillNewLine out)
ExitFailure _ -> return def
else return def

tillNewLine :: String -> String
tillNewLine = takeWhile (\c -> c /= '\n' && c /= '\r')

-- | Determine where our @.git@ directory is, in case we're in a
-- submodule.
getDotGit :: IO FilePath
Expand Down Expand Up @@ -124,7 +128,7 @@ getGitRoot = do
(code, out, _) <-
readProcessWithExitCode "git" ["rev-parse", "--show-toplevel"] ""
case code of
ExitSuccess -> return $ takeWhile (/= '\n') out
ExitSuccess -> return $ tillNewLine out
ExitFailure _ -> return pwd -- later steps will fail, that's fine

-- | Type to flag if the git index is used or not in a call to runGit
Expand Down