1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
{- git ref stuff
-
- Copyright 2011-2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Git.Ref where
import Common
import Git
import Git.Command
import Git.Sha
import Git.Types
import Data.Char (chr)
headRef :: Ref
headRef = Ref "HEAD"
{- 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). -}
base :: Ref -> Ref
base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef
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)
{- 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 ++ "/" ++ fromRef (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
{- 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
{- 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 $ fromRef 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 </> 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
{- 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
{- List of (shas, branches) matching a given ref or refs. -}
matching :: [Ref] -> Repo -> IO [(Sha, Branch)]
matching refs repo = matching' (map fromRef refs) repo
{- Includes HEAD in the output, if asked for it. -}
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. -}
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 (fromRef 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)]
|
