diff options
Diffstat (limited to 'Git/Ref.hs')
| -rw-r--r-- | Git/Ref.hs | 90 |
1 files changed, 60 insertions, 30 deletions
@@ -1,6 +1,6 @@ {- git ref stuff - - - Copyright 2011-2019 Joey Hess <id@joeyh.name> + - Copyright 2011-2020 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -} @@ -14,9 +14,11 @@ import Git import Git.Command import Git.Sha import Git.Types +import Git.FilePath import Data.Char (chr, ord) import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as S8 headRef :: Ref headRef = Ref "HEAD" @@ -25,7 +27,7 @@ headFile :: Repo -> FilePath headFile r = fromRawFilePath (localGitDir r) </> "HEAD" setHeadRef :: Ref -> Repo -> IO () -setHeadRef ref r = writeFile (headFile r) ("ref: " ++ fromRef ref) +setHeadRef ref r = S.writeFile (headFile r) ("ref: " <> fromRef' ref) {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String @@ -41,10 +43,11 @@ 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 +removeBase dir r + | prefix `isPrefixOf` rs = Ref $ encodeBS $ drop (length prefix) rs + | otherwise = r where + rs = fromRef r prefix = case end dir of ['/'] -> dir _ -> dir ++ "/" @@ -53,7 +56,7 @@ removeBase dir (Ref r) - refs/heads/master, yields a version of that ref under the directory, - such as refs/remotes/origin/master. -} underBase :: String -> Ref -> Ref -underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r) +underBase dir r = Ref $ encodeBS dir <> "/" <> fromRef' (base r) {- Convert a branch such as "master" into a fully qualified ref. -} branchRef :: Branch -> Ref @@ -61,26 +64,49 @@ 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. + - + - If the input file is located outside the repository, returns Nothing. -} -fileRef :: RawFilePath -> Ref -fileRef f = Ref $ ":./" ++ fromRawFilePath f +fileRef :: RawFilePath -> Repo -> IO (Maybe Ref) +fileRef f repo = do + -- The filename could be absolute, or contain eg "../repo/file", + -- neither of which work in a ref, so convert it to a minimal + -- relative path. + f' <- relPathCwdToFile f + return $ if repoPath repo `dirContains` f' + -- Prefixing the file with ./ makes this work even when in a + -- subdirectory of a repo. Eg, ./foo in directory bar refers + -- to bar/foo, not to foo in the top of the repository. + then Just $ Ref $ ":./" <> toInternalGitPath f' + else Nothing + +{- A Ref that can be used to refer to a file in a particular branch. -} +branchFileRef :: Branch -> RawFilePath -> Ref +branchFileRef branch f = Ref $ fromRef' branch <> ":" <> toInternalGitPath f {- Converts a Ref to refer to the content of the Ref on a given date. -} dateRef :: Ref -> RefDate -> Ref -dateRef (Ref r) (RefDate d) = Ref $ r ++ "@" ++ d +dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS d {- A Ref that can be used to refer to a file in the repository as it - - appears in a given Ref. -} -fileFromRef :: Ref -> RawFilePath -> Ref -fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr) + - appears in a given Ref. + - + - If the file path is located outside the repository, returns Nothing. + -} +fileFromRef :: Ref -> RawFilePath -> Repo -> IO (Maybe Ref) +fileFromRef r f repo = fileRef f repo >>= return . \case + Just (Ref fr) -> Just (Ref (fromRef' r <> fr)) + Nothing -> Nothing -{- Checks if a ref exists. -} +{- Checks if a ref exists. Note that it must be fully qualified, + - eg refs/heads/master rather than master. -} exists :: Ref -> Repo -> IO Bool exists ref = runBool - [Param "show-ref", Param "--verify", Param "-q", Param $ fromRef ref] + [ Param "show-ref" + , Param "--verify" + , Param "-q" + , Param $ fromRef ref + ] {- The file used to record a ref. (Git also stores some refs in a - packed-refs file.) -} @@ -107,26 +133,26 @@ sha branch repo = process <$> showref repo ] process s | S.null s = Nothing - | otherwise = Just $ Ref $ decodeBS' $ firstLine' s + | otherwise = Just $ Ref $ firstLine' s headSha :: Repo -> IO (Maybe Sha) headSha = sha headRef {- List of (shas, branches) matching a given ref or refs. -} matching :: [Ref] -> Repo -> IO [(Sha, Branch)] -matching refs repo = matching' (map fromRef refs) repo +matching = matching' [] {- Includes HEAD in the output, if asked for it. -} matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)] -matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo +matchingWithHEAD = matching' [Param "--head"] -{- List of (shas, branches) matching a given ref spec. -} -matching' :: [String] -> Repo -> IO [(Sha, Branch)] -matching' ps repo = map gen . lines . decodeBS' <$> - pipeReadStrict (Param "show-ref" : map Param ps) repo +matching' :: [CommandParam] -> [Ref] -> Repo -> IO [(Sha, Branch)] +matching' ps rs repo = map gen . S8.lines <$> + pipeReadStrict (Param "show-ref" : ps ++ rps) repo where - gen l = let (r, b) = separate (== ' ') l + gen l = let (r, b) = separate' (== fromIntegral (ord ' ')) l in (Ref r, Ref b) + rps = map (Param . fromRef) rs {- List of (shas, branches) matching a given ref. - Duplicate shas are filtered out. -} @@ -137,7 +163,7 @@ matchingUniq refs repo = nubBy uniqref <$> matching refs repo {- List of all refs. -} list :: Repo -> IO [(Sha, Ref)] -list = matching' [] +list = matching' [] [] {- Deletes a ref. This can delete refs that are not branches, - which git branch --delete refuses to delete. -} @@ -154,13 +180,17 @@ delete oldvalue ref = run - 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 ref) = extractSha . decodeBS <$$> pipeReadStrict - [ Param "rev-parse", Param "--verify", Param "--quiet", Param ref' ] +tree (Ref ref) = extractSha <$$> pipeReadStrict + [ Param "rev-parse" + , Param "--verify" + , Param "--quiet" + , Param (decodeBS ref') + ] where - ref' = if ":" `isInfixOf` ref + ref' = if ":" `S.isInfixOf` ref then ref -- de-reference commit objects to the tree - else ref ++ ":" + else ref <> ":" {- Checks if a String is a legal git ref name. - |