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"