diff options
Diffstat (limited to 'Git/Ref.hs')
| -rw-r--r-- | Git/Ref.hs | 109 |
1 files changed, 76 insertions, 33 deletions
@@ -1,10 +1,12 @@ {- git ref stuff - - - Copyright 2011-2013 Joey Hess <id@joeyh.name> + - Copyright 2011-2019 Joey Hess <id@joeyh.name> - - - Licensed under the GNU GPL version 3 or higher. + - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Git.Ref where import Common @@ -13,29 +15,39 @@ import Git.Command import Git.Sha import Git.Types -import Data.Char (chr) +import Data.Char (chr, ord) +import qualified Data.ByteString as S headRef :: Ref headRef = Ref "HEAD" +headFile :: Repo -> FilePath +headFile r = fromRawFilePath (localGitDir r) </> "HEAD" + +setHeadRef :: Ref -> Repo -> IO () +setHeadRef ref r = writeFile (headFile r) ("ref: " ++ fromRef ref) + {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String describe = fromRef . base -{- Often git refs are fully qualified (eg: refs/heads/master). - - Converts such a fully qualified ref into a base ref (eg: master). -} +{- Often git refs are fully qualified + - (eg refs/heads/master or refs/remotes/origin/master). + - Converts such a fully qualified ref into a base ref + - (eg: master or origin/master). -} base :: Ref -> Ref -base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef +base = removeBase "refs/heads/" . removeBase "refs/remotes/" + +{- Removes a directory such as "refs/heads/master" from a + - fully qualified ref. Any ref not starting with it is left as-is. -} +removeBase :: String -> Ref -> Ref +removeBase dir (Ref r) + | prefix `isPrefixOf` r = Ref (drop (length prefix) r) + | otherwise = Ref r where - remove prefix s - | prefix `isPrefixOf` s = drop (length prefix) s - | otherwise = s - -{- Given a directory and any ref, takes the basename of the ref and puts - - it under the directory. -} -under :: String -> Ref -> Ref -under dir r = Ref $ dir ++ "/" ++ - (reverse $ takeWhile (/= '/') $ reverse $ fromRef r) + prefix = case end dir of + ['/'] -> dir + _ -> dir ++ "/" {- Given a directory such as "refs/remotes/origin", and a ref such as - refs/heads/master, yields a version of that ref under the directory, @@ -43,14 +55,18 @@ under dir r = Ref $ dir ++ "/" ++ underBase :: String -> Ref -> Ref underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r) +{- Convert a branch such as "master" into a fully qualified ref. -} +branchRef :: Branch -> Ref +branchRef = underBase "refs/heads" + {- A Ref that can be used to refer to a file in the repository, as staged - in the index. - - Prefixing the file with ./ makes this work even if in a subdirectory - of a repo. -} -fileRef :: FilePath -> Ref -fileRef f = Ref $ ":./" ++ f +fileRef :: RawFilePath -> Ref +fileRef f = Ref $ ":./" ++ fromRawFilePath f {- Converts a Ref to refer to the content of the Ref on a given date. -} dateRef :: Ref -> RefDate -> Ref @@ -58,7 +74,7 @@ dateRef (Ref r) (RefDate d) = Ref $ r ++ "@" ++ d {- A Ref that can be used to refer to a file in the repository as it - appears in a given Ref. -} -fileFromRef :: Ref -> FilePath -> Ref +fileFromRef :: Ref -> RawFilePath -> Ref fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr) {- Checks if a ref exists. -} @@ -69,24 +85,29 @@ exists ref = runBool {- The file used to record a ref. (Git also stores some refs in a - packed-refs file.) -} file :: Ref -> Repo -> FilePath -file ref repo = localGitDir repo </> fromRef ref +file ref repo = fromRawFilePath (localGitDir repo) </> fromRef ref {- Checks if HEAD exists. It generally will, except for in a repository - that was just created. -} headExists :: Repo -> IO Bool headExists repo = do - ls <- lines <$> pipeReadStrict [Param "show-ref", Param "--head"] repo - return $ any (" HEAD" `isSuffixOf`) ls + ls <- S.split nl <$> pipeReadStrict [Param "show-ref", Param "--head"] repo + return $ any (" HEAD" `S.isSuffixOf`) ls + where + nl = fromIntegral (ord '\n') {- Get the sha of a fully qualified git ref, if it exists. -} sha :: Branch -> Repo -> IO (Maybe Sha) sha branch repo = process <$> showref repo where - showref = pipeReadStrict [Param "show-ref", - Param "--hash", -- get the hash - Param $ fromRef branch] - process [] = Nothing - process s = Just $ Ref $ firstLine s + showref = pipeReadStrict + [ Param "show-ref" + , Param "--hash" -- get the hash + , Param $ fromRef branch + ] + process s + | S.null s = Nothing + | otherwise = Just $ Ref $ decodeBS' $ firstLine' s headSha :: Repo -> IO (Maybe Sha) headSha = sha headRef @@ -99,25 +120,47 @@ matching refs repo = matching' (map fromRef refs) repo matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)] matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo -{- List of (shas, branches) matching a given ref or refs. -} +{- List of (shas, branches) matching a given ref spec. -} matching' :: [String] -> Repo -> IO [(Sha, Branch)] -matching' ps repo = map gen . lines <$> +matching' ps repo = map gen . lines . decodeBS' <$> pipeReadStrict (Param "show-ref" : map Param ps) repo where gen l = let (r, b) = separate (== ' ') l in (Ref r, Ref b) -{- List of (shas, branches) matching a given ref spec. +{- List of (shas, branches) matching a given ref. - Duplicate shas are filtered out. -} matchingUniq :: [Ref] -> Repo -> IO [(Sha, Branch)] matchingUniq refs repo = nubBy uniqref <$> matching refs repo where uniqref (a, _) (b, _) = a == b -{- Gets the sha of the tree a ref uses. -} +{- List of all refs. -} +list :: Repo -> IO [(Sha, Ref)] +list = matching' [] + +{- Deletes a ref. This can delete refs that are not branches, + - which git branch --delete refuses to delete. -} +delete :: Sha -> Ref -> Repo -> IO () +delete oldvalue ref = run + [ Param "update-ref" + , Param "-d" + , Param $ fromRef ref + , Param $ fromRef oldvalue + ] + +{- Gets the sha of the tree a ref uses. + - + - The ref may be something like a branch name, and it could contain + - ":subdir" if a subtree is wanted. -} tree :: Ref -> Repo -> IO (Maybe Sha) -tree ref = extractSha <$$> pipeReadStrict - [ Param "rev-parse", Param (fromRef ref ++ ":") ] +tree (Ref ref) = extractSha . decodeBS <$$> pipeReadStrict + [ Param "rev-parse", Param "--verify", Param "--quiet", Param ref' ] + where + ref' = if ":" `isInfixOf` ref + then ref + -- de-reference commit objects to the tree + else ref ++ ":" {- Checks if a String is a legal git ref name. - @@ -142,6 +185,6 @@ legal allowonelevel s = all (== False) illegal ends v = v `isSuffixOf` s begins v = v `isPrefixOf` s - pathbits = split "/" s + pathbits = splitc '/' s illegalchars = " ~^:?*[\\" ++ controlchars controlchars = chr 0o177 : [chr 0 .. chr (0o40-1)] |