blob: 206b6a25e4be3064f60f88d35393414e24eb5cd7 (
plain)
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
|
{- git-annex command
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Status where
import Common.Annex
import Command
import Annex.CatFile
import Annex.Content.Direct
import Config
import qualified Git.LsFiles as LsFiles
import qualified Git.Ref
import qualified Git
cmd :: [Command]
cmd = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $
command "status" paramPaths seek SectionCommon
"show the working tree status"]
seek :: CommandSeek
seek = withWords start
start :: [FilePath] -> CommandStart
start [] = do
-- Like git status, when run without a directory, behave as if
-- given the path to the top of the repository.
currdir <- liftIO getCurrentDirectory
top <- fromRepo Git.repoPath
start' [relPathDirToFile currdir top]
start locs = start' locs
start' :: [FilePath] -> CommandStart
start' locs = do
(l, cleanup) <- inRepo $ LsFiles.modifiedOthers locs
getstatus <- ifM isDirect
( return statusDirect
, return $ Just <$$> statusIndirect
)
forM_ l $ \f -> maybe noop (showFileStatus f) =<< getstatus f
void $ liftIO cleanup
stop
data Status
= NewFile
| DeletedFile
| ModifiedFile
showStatus :: Status -> String
showStatus NewFile = "?"
showStatus DeletedFile = "D"
showStatus ModifiedFile = "M"
showFileStatus :: FilePath -> Status -> Annex ()
showFileStatus f s = unlessM (showFullJSON [("status", ss), ("file", f)]) $
liftIO $ putStrLn $ ss ++ " " ++ f
where
ss = showStatus s
statusDirect :: FilePath -> Annex (Maybe Status)
statusDirect f = checkstatus =<< liftIO (catchMaybeIO $ getFileStatus f)
where
checkstatus Nothing = return $ Just DeletedFile
checkstatus (Just s)
-- Git thinks that present direct mode files are modifed,
-- so have to check.
| not (isSymbolicLink s) = checkkey s =<< catKeyFile f
| otherwise = Just <$> checkNew f
checkkey s (Just k) = ifM (sameFileStatus k s)
( return Nothing
, return $ Just ModifiedFile
)
checkkey _ Nothing = Just <$> checkNew f
statusIndirect :: FilePath -> Annex Status
statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f))
( checkNew f
, return DeletedFile
)
where
checkNew :: FilePath -> Annex Status
checkNew f = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))
( return ModifiedFile
, return NewFile
)
|
