03932212ec
The assistant's commit code also always avoids git commit, for simplicity. Indirect mode sync still does a git commit -a to catch unstaged changes. Note that this means that direct mode sync no longer runs the pre-commit hook or any other hooks git commit might call. The git annex pre-commit hook action for direct mode is however explicitly run. (The assistant already ran git commit with hooks disabled, so no change there.)
139 lines
4.2 KiB
Haskell
139 lines
4.2 KiB
Haskell
{- git ref stuff
|
|
-
|
|
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Git.Ref where
|
|
|
|
import Common
|
|
import Git
|
|
import Git.Command
|
|
import Git.Sha
|
|
|
|
import Data.Char (chr)
|
|
|
|
headRef :: Ref
|
|
headRef = Ref "HEAD"
|
|
|
|
{- Converts a fully qualified git ref into a user-visible string. -}
|
|
describe :: Ref -> String
|
|
describe = show . base
|
|
|
|
{- Often git refs are fully qualified (eg: refs/heads/master).
|
|
- Converts such a fully qualified ref into a base ref (eg: master). -}
|
|
base :: Ref -> Ref
|
|
base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show
|
|
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 $ show r)
|
|
|
|
{- 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,
|
|
- such as refs/remotes/origin/master. -}
|
|
underBase :: String -> Ref -> Ref
|
|
underBase dir r = Ref $ dir ++ "/" ++ show (base r)
|
|
|
|
{- 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
|
|
|
|
{- 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 r) f = let (Ref fr) = fileRef f in Ref (r ++ fr)
|
|
|
|
{- Checks if a ref exists. -}
|
|
exists :: Ref -> Repo -> IO Bool
|
|
exists ref = runBool
|
|
[Param "show-ref", Param "--verify", Param "-q", Param $ show ref]
|
|
|
|
{- 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 </> show 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
|
|
|
|
{- 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 $ show branch]
|
|
process [] = Nothing
|
|
process s = Just $ Ref $ firstLine s
|
|
|
|
{- List of (shas, branches) matching a given ref or refs. -}
|
|
matching :: [Ref] -> Repo -> IO [(Sha, Branch)]
|
|
matching refs repo = matching' (map show refs) repo
|
|
|
|
{- Includes HEAD in the output, if asked for it. -}
|
|
matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)]
|
|
matchingWithHEAD refs repo = matching' ("--head" : map show refs) repo
|
|
|
|
{- List of (shas, branches) matching a given ref or refs. -}
|
|
matching' :: [String] -> Repo -> IO [(Sha, Branch)]
|
|
matching' ps repo = map gen . lines <$>
|
|
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.
|
|
- 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. -}
|
|
tree :: Ref -> Repo -> IO (Maybe Sha)
|
|
tree ref = extractSha <$$> pipeReadStrict
|
|
[ Param "rev-parse", Param (show ref ++ ":") ]
|
|
|
|
{- Checks if a String is a legal git ref name.
|
|
-
|
|
- The rules for this are complex; see git-check-ref-format(1) -}
|
|
legal :: Bool -> String -> Bool
|
|
legal allowonelevel s = all (== False) illegal
|
|
where
|
|
illegal =
|
|
[ any ("." `isPrefixOf`) pathbits
|
|
, any (".lock" `isSuffixOf`) pathbits
|
|
, not allowonelevel && length pathbits < 2
|
|
, contains ".."
|
|
, any (\c -> contains [c]) illegalchars
|
|
, begins "/"
|
|
, ends "/"
|
|
, contains "//"
|
|
, ends "."
|
|
, contains "@{"
|
|
, null s
|
|
]
|
|
contains v = v `isInfixOf` s
|
|
ends v = v `isSuffixOf` s
|
|
begins v = v `isPrefixOf` s
|
|
|
|
pathbits = split "/" s
|
|
illegalchars = " ~^:?*[\\" ++ controlchars
|
|
controlchars = chr 0o177 : [chr 0 .. chr (0o40-1)]
|