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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
{- git ls-files interface
-
- Copyright 2010,2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Git.LsFiles (
inRepo,
notInRepo,
allFiles,
deleted,
modified,
staged,
stagedNotDeleted,
stagedOthersDetails,
stagedDetails,
typeChanged,
typeChangedStaged,
Conflicting(..),
Unmerged(..),
unmerged,
) where
import Common
import Git
import Git.Command
import Git.Types
import Git.Sha
import Numeric
import System.Posix.Types
{- Scans for files that are checked into git at the specified locations. -}
inRepo :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l
{- Scans for files at the specified locations that are not checked into git. -}
notInRepo :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
notInRepo include_ignored l repo = pipeNullSplit params repo
where
params = [Params "ls-files --others"] ++ exclude ++
[Params "-z --"] ++ map File l
exclude
| include_ignored = []
| otherwise = [Param "--exclude-standard"]
{- Finds all files in the specified locations, whether checked into git or
- not. -}
allFiles :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
allFiles l = pipeNullSplit $ Params "ls-files --cached --others -z --" : map File l
{- Returns a list of files in the specified locations that have been
- deleted. -}
deleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
deleted l repo = pipeNullSplit params repo
where
params = [Params "ls-files --deleted -z --"] ++ map File l
{- Returns a list of files in the specified locations that have been
- modified. -}
modified :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
modified l repo = pipeNullSplit params repo
where
params = [Params "ls-files --modified -z --"] ++ map File l
{- Returns a list of all files that are staged for commit. -}
staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
staged = staged' []
{- Returns a list of the files, staged for commit, that are being added,
- moved, or changed (but not deleted), from the specified locations. -}
stagedNotDeleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]
staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
where
prefix = [Params "diff --cached --name-only -z"]
suffix = Param "--" : map File l
{- Returns details about files that are staged in the index,
- as well as files not yet in git. Skips ignored files. -}
stagedOthersDetails :: [FilePath] -> Repo -> IO ([(FilePath, Maybe Sha, Maybe FileMode)], IO Bool)
stagedOthersDetails = stagedDetails' [Params "--others --exclude-standard"]
{- Returns details about all files that are staged in the index. -}
stagedDetails :: [FilePath] -> Repo -> IO ([(FilePath, Maybe Sha, Maybe FileMode)], IO Bool)
stagedDetails = stagedDetails' []
{- Gets details about staged files, including the Sha of their staged
- contents. -}
stagedDetails' :: [CommandParam] -> [FilePath] -> Repo -> IO ([(FilePath, Maybe Sha, Maybe FileMode)], IO Bool)
stagedDetails' ps l repo = do
(ls, cleanup) <- pipeNullSplit params repo
return (map parse ls, cleanup)
where
params = Params "ls-files --stage -z" : ps ++
Param "--" : map File l
parse s
| null file = (s, Nothing, Nothing)
| otherwise = (file, extractSha $ take shaSize rest, readmode mode)
where
(metadata, file) = separate (== '\t') s
(mode, rest) = separate (== ' ') metadata
readmode = fst <$$> headMaybe . readOct
{- Returns a list of the files in the specified locations that are staged
- for commit, and whose type has changed. -}
typeChangedStaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
typeChangedStaged = typeChanged' [Param "--cached"]
{- Returns a list of the files in the specified locations whose type has
- changed. Files only staged for commit will not be included. -}
typeChanged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
typeChanged = typeChanged' []
typeChanged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
typeChanged' ps l repo = do
(fs, cleanup) <- pipeNullSplit (prefix ++ ps ++ suffix) repo
-- git diff returns filenames relative to the top of the git repo;
-- convert to filenames relative to the cwd, like git ls-files.
let top = repoPath repo
cwd <- getCurrentDirectory
return (map (\f -> relPathDirToFile cwd $ top </> f) fs, cleanup)
where
prefix = [Params "diff --name-only --diff-filter=T -z"]
suffix = Param "--" : (if null l then [File "."] else map File l)
{- A item in conflict has two possible values.
- Either can be Nothing, when that side deleted the file. -}
data Conflicting v = Conflicting
{ valUs :: Maybe v
, valThem :: Maybe v
} deriving (Show)
data Unmerged = Unmerged
{ unmergedFile :: FilePath
, unmergedBlobType :: Conflicting BlobType
, unmergedSha :: Conflicting Sha
} deriving (Show)
{- Returns a list of the files in the specified locations that have
- unresolved merge conflicts.
-
- ls-files outputs multiple lines per conflicting file, each with its own
- stage number:
- 1 = old version, can be ignored
- 2 = us
- 3 = them
- If a line is omitted, that side removed the file.
-}
unmerged :: [FilePath] -> Repo -> IO ([Unmerged], IO Bool)
unmerged l repo = do
(fs, cleanup) <- pipeNullSplit params repo
return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup)
where
params = Params "ls-files --unmerged -z --" : map File l
data InternalUnmerged = InternalUnmerged
{ isus :: Bool
, ifile :: FilePath
, iblobtype :: Maybe BlobType
, isha :: Maybe Sha
} deriving (Show)
parseUnmerged :: String -> Maybe InternalUnmerged
parseUnmerged s
| null file = Nothing
| otherwise = case words metadata of
(rawblobtype:rawsha:rawstage:_) -> do
stage <- readish rawstage :: Maybe Int
unless (stage == 2 || stage == 3) $
fail undefined -- skip stage 1
blobtype <- readBlobType rawblobtype
sha <- extractSha rawsha
return $ InternalUnmerged (stage == 2) file
(Just blobtype) (Just sha)
_ -> Nothing
where
(metadata, file) = separate (== '\t') s
reduceUnmerged :: [Unmerged] -> [InternalUnmerged] -> [Unmerged]
reduceUnmerged c [] = c
reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
where
(rest, sibi) = findsib i is
(blobtypeA, blobtypeB, shaA, shaB)
| isus i = (iblobtype i, iblobtype sibi, isha i, isha sibi)
| otherwise = (iblobtype sibi, iblobtype i, isha sibi, isha i)
new = Unmerged
{ unmergedFile = ifile i
, unmergedBlobType = Conflicting blobtypeA blobtypeB
, unmergedSha = Conflicting shaA shaB
}
findsib templatei [] = ([], removed templatei)
findsib templatei (l:ls)
| ifile l == ifile templatei = (ls, l)
| otherwise = (l:ls, removed templatei)
removed templatei = templatei
{ isus = not (isus templatei)
, iblobtype = Nothing
, isha = Nothing
}
|
