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
|
module Darcs.UI.Commands.ShowPatchIndex ( showPatchIndex ) where
import Prelude ()
import Darcs.Prelude
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository )
import Darcs.UI.Flags ( DarcsFlag(Verbose), useCache )
import Prelude hiding ( (^) )
import Darcs.UI.Options ( DarcsOption, (^), oid, odesc, ocheck, onormalise, defaultFlags )
import qualified Darcs.UI.Options.All as O
import Darcs.Util.Path ( AbsolutePath )
import Darcs.Repository.InternalTypes ( Repository(..) )
import Darcs.Repository ( withRepository, RepoJob(..) )
import Darcs.Repository.PatchIndex
import Control.Arrow ()
showPatchIndexBasicOpts :: DarcsOption a
(Bool -> Bool -> Bool -> Maybe String -> a)
showPatchIndexBasicOpts = O.files ^ O.directories ^ O.nullFlag ^ O.workingRepoDir
showPatchIndexOpts :: DarcsOption a
(Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe O.StdCmdAction
-> Bool
-> Bool
-> O.Verbosity
-> Bool
-> O.UseCache
-> Maybe String
-> Bool
-> Maybe String
-> Bool
-> a)
showPatchIndexOpts = showPatchIndexBasicOpts `withStdOpts` oid
showPatchIndex :: DarcsCommand [DarcsFlag]
showPatchIndex = DarcsCommand {
commandProgramName = "darcs",
commandName = "patch-index",
commandDescription = "Check integrity of patch index",
commandHelp =
"When given the `--verbose` flag, the command dumps the complete content\n"
++ "of the patch index and checks its integrity.",
commandExtraArgs = 0,
commandExtraArgHelp = [],
commandCommand = showPatchIndexCmd,
commandPrereq = amInHashedRepository,
commandGetArgPossibilities = return [],
commandArgdefaults = nodefaults,
commandAdvancedOptions = [],
commandBasicOptions = odesc showPatchIndexBasicOpts,
commandDefaults = defaultFlags showPatchIndexOpts,
commandCheckOptions = ocheck showPatchIndexOpts,
commandParseOptions = onormalise showPatchIndexOpts }
showPatchIndexCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
showPatchIndexCmd _ opts _
| Verbose `elem` opts = do
withRepository (useCache opts) $ RepoJob $ \repo@(Repo repodir _ _ _) ->
dumpPatchIndex repodir >> piTest repo
| otherwise =
withRepository (useCache opts) $ RepoJob $ \(repo@(Repo repodir _ _ _)) -> do
ex <- doesPatchIndexExist repodir
if ex then do
sy <- isPatchIndexInSync repo
if sy
then putStrLn "Patch Index is in sync with repo."
else putStrLn "Patch Index is outdated. Run darcs optimize enable-patch-index"
else putStrLn "Patch Index is not yet created. Run darcs optimize enable-patch-index"
|
