File: LsFiles.hs

package info (click to toggle)
git-repair 1.20151215-1.2
  • links: PTS
  • area: main
  • in suites: buster
  • size: 548 kB
  • sloc: haskell: 4,574; makefile: 29; sh: 19
file content (258 lines) | stat: -rw-r--r-- 7,665 bytes parent folder | download | duplicates (3)
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
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
{- git ls-files interface
 -
 - Copyright 2010,2012 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Git.LsFiles (
	inRepo,
	notInRepo,
	allFiles,
	deleted,
	modified,
	modifiedOthers,
	staged,
	stagedNotDeleted,
	stagedOthersDetails,
	stagedDetails,
	typeChanged,
	typeChangedStaged,
	Conflicting(..),
	Unmerged(..),
	unmerged,
	StagedDetails,
) 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 $ 
	Param "ls-files" :
	Param "--cached" :
	Param "-z" :
	Param "--" :
	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 = concat
		[ [ Param "ls-files", Param "--others"]
		, exclude
		, [ Param "-z", Param "--" ]
		, 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 $
	Param "ls-files" :
	Param "--cached" :
	Param "--others" :
	Param "-z" :
	Param "--" :
	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 =
		Param "ls-files" :
		Param "--deleted" :
		Param "-z" :
		Param "--" :
		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 = 
		Param "ls-files" :
		Param "--modified" :
		Param "-z" :
		Param "--" :
		map File l

{- Files that have been modified or are not checked into git (and are not
 - ignored). -}
modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
modifiedOthers l repo = pipeNullSplit params repo
  where
	params = 
		Param "ls-files" :
		Param "--modified" :
		Param "--others" :
		Param "--exclude-standard" :
		Param "-z" :
		Param "--" :
		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 = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]
	suffix = Param "--" : map File l

type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode)

{- 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 ([StagedDetails], IO Bool)
stagedOthersDetails = stagedDetails' [Param "--others", Param "--exclude-standard"]

{- Returns details about all files that are staged in the index. -}
stagedDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
stagedDetails = stagedDetails' []

{- Gets details about staged files, including the Sha of their staged
 - contents. -}
stagedDetails' :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
stagedDetails' ps l repo = do
	(ls, cleanup) <- pipeNullSplit params repo
	return (map parse ls, cleanup)
  where
	params = Param "ls-files" : Param "--stage" : Param "-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.
	top <- absPath (repoPath repo)
	currdir <- getCurrentDirectory
	return (map (\f -> relPathDirToFileAbs currdir $ top </> f) fs, cleanup)
  where
	prefix = 
		[ Param "diff"
		, Param "--name-only"
		, Param "--diff-filter=T"
		, Param "-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 = 
		Param "ls-files" :
		Param "--unmerged" :
		Param "-z" :
		Param "--" :
		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
			if stage /= 2 && stage /= 3
				then Nothing
				else do
					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
		}