module Darcs.UI.Commands.ShowPatchIndex ( showPatchIndex ) where import Darcs.Prelude import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, amInHashedRepository ) import Darcs.UI.Completion ( noArgs ) import Darcs.UI.Flags ( DarcsFlag, useCache, verbose ) import Darcs.UI.Options ( (^), oid, odesc, ocheck, defaultFlags, (?) ) import qualified Darcs.UI.Options.All as O import Darcs.Util.Path ( AbsolutePath ) import Darcs.Repository ( withRepository, RepoJob(..), repoLocation ) import Darcs.Repository.PatchIndex ( dumpPatchIndex, piTest, doesPatchIndexExist, isPatchIndexInSync) import Darcs.Util.Printer ( Doc, text ) help :: Doc help :: Doc help = String -> Doc text forall a b. (a -> b) -> a -> b $ String "When given the `--verbose` flag, the command dumps the complete content\n" forall a. [a] -> [a] -> [a] ++ String "of the patch index and checks its integrity." showPatchIndex :: DarcsCommand showPatchIndex :: DarcsCommand showPatchIndex = DarcsCommand { commandProgramName :: String commandProgramName = String "darcs" , commandName :: String commandName = String "patch-index" , commandDescription :: String commandDescription = String "Check integrity of patch index" , commandHelp :: Doc commandHelp = Doc help , commandExtraArgs :: Int commandExtraArgs = Int 0 , commandExtraArgHelp :: [String] commandExtraArgHelp = [] , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO () commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO () showPatchIndexCmd , commandPrereq :: [DarcsFlag] -> IO (Either String ()) commandPrereq = [DarcsFlag] -> IO (Either String ()) amInHashedRepository , commandCompleteArgs :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO [String] commandCompleteArgs = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO [String] noArgs , commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String] commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String] nodefaults , commandAdvancedOptions :: [DarcsOptDescr DarcsFlag] commandAdvancedOptions = [] , commandBasicOptions :: [DarcsOptDescr DarcsFlag] commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f] odesc forall {a}. OptSpec DarcsOptDescr DarcsFlag a (Bool -> Maybe String -> a) showPatchIndexBasicOpts , commandDefaults :: [DarcsFlag] commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] defaultFlags forall {a}. DarcsOption a (Bool -> Maybe String -> Maybe StdCmdAction -> Verbosity -> UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) showPatchIndexOpts , commandCheckOptions :: [DarcsFlag] -> [String] commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String] ocheck forall {a}. DarcsOption a (Bool -> Maybe String -> Maybe StdCmdAction -> Verbosity -> UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) showPatchIndexOpts } where showPatchIndexBasicOpts :: OptSpec DarcsOptDescr DarcsFlag a (Bool -> Maybe String -> a) showPatchIndexBasicOpts = PrimDarcsOption Bool O.nullFlag forall (d :: * -> *) f b c a. OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c ^ PrimDarcsOption (Maybe String) O.repoDir showPatchIndexOpts :: DarcsOption a (Bool -> Maybe String -> Maybe StdCmdAction -> Verbosity -> UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) showPatchIndexOpts = forall {a}. OptSpec DarcsOptDescr DarcsFlag a (Bool -> Maybe String -> a) showPatchIndexBasicOpts forall b c a. DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c -> DarcsOption (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b -> DarcsOption a c `withStdOpts` forall (d :: * -> *) f a. OptSpec d f a a oid showPatchIndexCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO () showPatchIndexCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO () showPatchIndexCmd (AbsolutePath, AbsolutePath) _ [DarcsFlag] opts [String] _ | [DarcsFlag] -> Bool verbose [DarcsFlag] opts = forall a. UseCache -> RepoJob a -> IO a withRepository (PrimDarcsOption UseCache useCache forall (d :: * -> *) f v. (forall a. PrimOptSpec d f a v) -> [f] -> v ? [DarcsFlag] opts) forall a b. (a -> b) -> a -> b $ forall a. (forall (rt :: RepoType) (p :: * -> * -> *) wR wU. (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) => Repository rt p wR wU wR -> IO a) -> RepoJob a RepoJob forall a b. (a -> b) -> a -> b $ \Repository rt p wR wU wR repo -> let loc :: String loc = forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT. Repository rt p wR wU wT -> String repoLocation Repository rt p wR wU wR repo in String -> IO () dumpPatchIndex String loc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> String -> IO () piTest String loc | Bool otherwise = forall a. UseCache -> RepoJob a -> IO a withRepository (PrimDarcsOption UseCache useCache forall (d :: * -> *) f v. (forall a. PrimOptSpec d f a v) -> [f] -> v ? [DarcsFlag] opts) forall a b. (a -> b) -> a -> b $ forall a. (forall (rt :: RepoType) (p :: * -> * -> *) wR wU. (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) => Repository rt p wR wU wR -> IO a) -> RepoJob a RepoJob forall a b. (a -> b) -> a -> b $ \Repository rt p wR wU wR repo -> do Bool ex <- String -> IO Bool doesPatchIndexExist (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT. Repository rt p wR wU wT -> String repoLocation Repository rt p wR wU wR repo) if Bool ex then do Bool sy <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT. Repository rt p wR wU wT -> IO Bool isPatchIndexInSync Repository rt p wR wU wR repo if Bool sy then String -> IO () putStrLn String "Patch Index is in sync with repo." else String -> IO () putStrLn String "Patch Index is outdated. Run darcs optimize enable-patch-index" else String -> IO () putStrLn String "Patch Index is not yet created. Run darcs optimize enable-patch-index"