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
|
{- git-annex command infrastructure
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command (
module Types.Command,
module Seek,
module Checks,
module Options,
command,
next,
stop,
prepCommand,
doCommand,
notAnnexed,
isAnnexed,
notBareRepo,
isBareRepo,
autoCopies
) where
import Common.Annex
import qualified Backend
import qualified Annex
import qualified Git
import Types.Command
import Logs.Trust
import Logs.Location
import Config
import Seek
import Checks
import Options
{- Generates a command with the common checks. -}
command :: String -> String -> [CommandSeek] -> String -> Command
command = Command commonChecks
{- For start and perform stages to indicate what step to run next. -}
next :: a -> Annex (Maybe a)
next a = return $ Just a
{- Or to indicate nothing needs to be done. -}
stop :: Annex (Maybe a)
stop = return Nothing
{- Prepares a list of actions to run to perform a command, based on
- the parameters passed to it. -}
prepCommand :: Command -> [String] -> Annex [Annex Bool]
prepCommand cmd ps = return . map doCommand =<< seekCommand cmd ps
{- Runs a command through the seek stage. -}
seekCommand :: Command -> [String] -> Annex [CommandStart]
seekCommand Command { cmdseek = seek } ps = concat <$> mapM (\s -> s ps) seek
{- Runs a command through the start, perform and cleanup stages -}
doCommand :: CommandStart -> CommandCleanup
doCommand = start
where
start = stage $ maybe success perform
perform = stage $ maybe failure cleanup
cleanup = stage $ \r -> showEndResult r >> return r
stage = (=<<)
success = return True
failure = showEndFail >> return False
notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
notBareRepo :: Annex a -> Annex a
notBareRepo a = do
whenM isBareRepo $
error "You cannot run this subcommand in a bare repository."
a
isBareRepo :: Annex Bool
isBareRepo = Git.repoIsLocalBare <$> gitRepo
{- Used for commands that have an auto mode that checks the number of known
- copies of a key.
-
- In auto mode, first checks that the number of known
- copies of the key is > or < than the numcopies setting, before running
- the action. -}
autoCopies :: Key -> (Int -> Int -> Bool) -> Maybe Int -> CommandStart -> CommandStart
autoCopies key vs numcopiesattr a = do
auto <- Annex.getState Annex.auto
if auto
then do
needed <- getNumCopies numcopiesattr
(_, have) <- trustPartition UnTrusted =<< keyLocations key
if length have `vs` needed then a else stop
else a
|
