--  Copyright (C) 2002-2005 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands.Repair ( repair, check ) where

import Darcs.Prelude

import Control.Monad ( when, unless, void )
import Data.Maybe ( isJust )
import System.IO.Error ( catchIOError )
import System.Exit ( exitFailure )
import System.Directory( renameFile )
import System.FilePath ( (<.>) )

import Darcs.UI.Commands
    ( DarcsCommand(..), withStdOpts, nodefaults
    , putInfo, putVerbose, putWarning, amInHashedRepository
    )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags
    ( DarcsFlag, verbosity, umask, useIndex
    , useCache, diffAlgorithm, quiet
    )
import Darcs.UI.Options ( DarcsOption, oid, (?), (^) )
import qualified Darcs.UI.Options.All as O

import Darcs.Repository.Paths ( indexPath )
import Darcs.Repository.Repair
    ( replayRepository, checkIndex, replayRepositoryInTemp
    , RepositoryConsistency(..)
    )
import Darcs.Repository
    ( withRepository, RepoJob(..)
    , withRepoLock, writePristine
    , finalizeRepositoryChanges
    )
import Darcs.Repository.Hashed ( writeTentativeInventory )
import Darcs.Repository.Pending ( setTentativePending )

import Darcs.Patch ( displayPatch )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )

import Darcs.Util.Printer ( Doc, text, ($$) )


repairDescription :: String
repairDescription :: String
repairDescription = String
"Repair a corrupted repository."

repairHelp :: Doc
repairHelp :: Doc
repairHelp = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
  String
"The `darcs repair` command attempts to fix corruption in the current\n\
  \repository.\n\
  \It works by successively applying all patches in the repository to an\n\
  \empty tree, each time checking that the patch can be cleanly applied\n\
  \to the current pristine tree. If we detect a problem, we try to repair\n\
  \the patch. Finally we compare the existing pristine with the newly\n\
  \reconstructed one and if they differ, replace the existing one.\n\
  \Any problem encountered is reported.\n\
  \The flag `--dry-run` makes this operation read-only and causes it to\n\
  \exit unsuccessfully (with a non-zero exit status) in case any problems\n\
  \are enountered.\n"

commonBasicOpts :: DarcsOption a
                   (Maybe String -> O.DiffAlgorithm -> a)
commonBasicOpts :: forall a. DarcsOption a (Maybe String -> DiffAlgorithm -> a)
commonBasicOpts = PrimOptSpec DarcsOptDescr Flag (DiffAlgorithm -> a) (Maybe String)
PrimDarcsOption (Maybe String)
O.repoDir PrimOptSpec DarcsOptDescr Flag (DiffAlgorithm -> a) (Maybe String)
-> OptSpec DarcsOptDescr Flag a (DiffAlgorithm -> a)
-> OptSpec
     DarcsOptDescr Flag a (Maybe String -> DiffAlgorithm -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr Flag a (DiffAlgorithm -> a)
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm

repair :: DarcsCommand
repair :: DarcsCommand
repair = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"repair"
    , commandHelp :: Doc
commandHelp = Doc
repairHelp
    , commandDescription :: String
commandDescription = String
repairDescription
    , commandExtraArgs :: Int
commandExtraArgs = Int
0
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = []
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [Flag] -> [String] -> IO ()
commandCommand = ([Flag] -> IO ())
-> (AbsolutePath, AbsolutePath) -> [Flag] -> [String] -> IO ()
forall b d a c. (b -> d) -> a -> b -> c -> d
withFpsAndArgs [Flag] -> IO ()
repairCmd
    , commandPrereq :: [Flag] -> IO (Either String ())
commandPrereq = [Flag] -> IO (Either String ())
amInHashedRepository
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath) -> [Flag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath) -> [Flag] -> [String] -> IO [String]
noArgs
    , commandArgdefaults :: [Flag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [Flag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , CommandOptions
commandOptions :: CommandOptions
commandOptions :: CommandOptions
..
    }
  where
    basicOpts :: OptSpec
  DarcsOptDescr Flag a (Maybe String -> DiffAlgorithm -> DryRun -> a)
basicOpts = DarcsOption
  (DryRun -> a) (Maybe String -> DiffAlgorithm -> DryRun -> a)
forall a. DarcsOption a (Maybe String -> DiffAlgorithm -> a)
commonBasicOpts DarcsOption
  (DryRun -> a) (Maybe String -> DiffAlgorithm -> DryRun -> a)
-> OptSpec DarcsOptDescr Flag a (DryRun -> a)
-> OptSpec
     DarcsOptDescr Flag a (Maybe String -> DiffAlgorithm -> DryRun -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr Flag a (DryRun -> a)
PrimDarcsOption DryRun
O.dryRun
    advancedOpts :: PrimOptSpec DarcsOptDescr Flag a UMask
advancedOpts = PrimOptSpec DarcsOptDescr Flag a UMask
PrimDarcsOption UMask
O.umask
    allOpts :: CommandOptions
allOpts = OptSpec
  DarcsOptDescr
  Flag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [Flag])
  (Maybe String
   -> DiffAlgorithm
   -> DryRun
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [Flag])
forall {a}.
OptSpec
  DarcsOptDescr Flag a (Maybe String -> DiffAlgorithm -> DryRun -> a)
basicOpts OptSpec
  DarcsOptDescr
  Flag
  (Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [Flag])
  (Maybe String
   -> DiffAlgorithm
   -> DryRun
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [Flag])
-> DarcsOption
     (UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag])
     (UMask
      -> UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag]) b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag])
  (UMask
   -> UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag])
PrimDarcsOption UMask
advancedOpts
    commandOptions :: CommandOptions
commandOptions = CommandOptions
allOpts

withFpsAndArgs :: (b -> d) -> a -> b -> c -> d
withFpsAndArgs :: forall b d a c. (b -> d) -> a -> b -> c -> d
withFpsAndArgs b -> d
cmd a
_ b
opts c
_ = b -> d
cmd b
opts

maybeDo :: Monad m => Maybe t -> (t -> m ()) -> m ()
maybeDo :: forall (m :: * -> *) t. Monad m => Maybe t -> (t -> m ()) -> m ()
maybeDo (Just t
x) t -> m ()
f = t -> m ()
f t
x
maybeDo Maybe t
Nothing t -> m ()
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

repairCmd :: [DarcsFlag] -> IO ()
repairCmd :: [Flag] -> IO ()
repairCmd [Flag]
opts
  | DryRun -> Bool
forall a. YesNo a => a -> Bool
O.yes (PrimOptSpec DarcsOptDescr Flag a DryRun
PrimDarcsOption DryRun
O.dryRun PrimDarcsOption DryRun -> [Flag] -> DryRun
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) = [Flag] -> IO ()
checkCmd [Flag]
opts
  | Bool
otherwise =
    UseCache -> UMask -> RepoJob 'RW () -> IO ()
forall a. UseCache -> UMask -> RepoJob 'RW a -> IO a
withRepoLock (PrimOptSpec DarcsOptDescr Flag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [Flag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) (PrimOptSpec DarcsOptDescr Flag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [Flag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) (RepoJob 'RW () -> IO ()) -> RepoJob 'RW () -> IO ()
forall a b. (a -> b) -> a -> b
$
    TreePatchJob 'RW () -> RepoJob 'RW ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RW () -> RepoJob 'RW ())
-> TreePatchJob 'RW () -> RepoJob 'RW ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RW p wU wR
repo -> do
      bad_replay <- DiffAlgorithm
-> Repository 'RW p wU wR
-> Verbosity
-> (RepositoryConsistency p wR -> IO Bool)
-> IO Bool
forall (p :: * -> * -> *) (rt :: AccessType) wU wR a.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffAlgorithm
-> Repository rt p wU wR
-> Verbosity
-> (RepositoryConsistency p wR -> IO a)
-> IO a
replayRepository
        (PrimOptSpec DarcsOptDescr Flag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [Flag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts)
        Repository 'RW p wU wR
repo
        (PrimOptSpec DarcsOptDescr Flag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [Flag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) ((RepositoryConsistency p wR -> IO Bool) -> IO Bool)
-> (RepositoryConsistency p wR -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \RepositoryConsistency {Maybe (Tree IO, Sealed (FL (PrimOf p) wR))
Maybe (Sealed (FL (PrimOf p) wR))
Maybe (PatchSet p Origin wR)
fixedPristine :: Maybe (Tree IO, Sealed (FL (PrimOf p) wR))
fixedPatches :: Maybe (PatchSet p Origin wR)
fixedPending :: Maybe (Sealed (FL (PrimOf p) wR))
fixedPending :: forall (p :: * -> * -> *) wR.
RepositoryConsistency p wR -> Maybe (Sealed (FL (PrimOf p) wR))
fixedPatches :: forall (p :: * -> * -> *) wR.
RepositoryConsistency p wR -> Maybe (PatchSet p Origin wR)
fixedPristine :: forall (p :: * -> * -> *) wR.
RepositoryConsistency p wR
-> Maybe (Tree IO, Sealed (FL (PrimOf p) wR))
..} -> do
          Maybe (PatchSet p Origin wR)
-> (PatchSet p Origin wR -> IO ()) -> IO ()
forall (m :: * -> *) t. Monad m => Maybe t -> (t -> m ()) -> m ()
maybeDo Maybe (PatchSet p Origin wR)
fixedPatches ((PatchSet p Origin wR -> IO ()) -> IO ())
-> (PatchSet p Origin wR -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PatchSet p Origin wR
ps -> do
            [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Writing out repaired patches..."
            Repository 'RW p wU wR -> PatchSet p Origin wR -> IO ()
forall (p :: * -> * -> *) wU wR wX.
RepoPatch p =>
Repository 'RW p wU wR -> PatchSet p Origin wX -> IO ()
writeTentativeInventory Repository 'RW p wU wR
repo PatchSet p Origin wR
ps
          Maybe (Tree IO, Sealed (FL (PrimOf p) wR))
-> ((Tree IO, Sealed (FL (PrimOf p) wR)) -> IO ()) -> IO ()
forall (m :: * -> *) t. Monad m => Maybe t -> (t -> m ()) -> m ()
maybeDo Maybe (Tree IO, Sealed (FL (PrimOf p) wR))
fixedPristine (((Tree IO, Sealed (FL (PrimOf p) wR)) -> IO ()) -> IO ())
-> ((Tree IO, Sealed (FL (PrimOf p) wR)) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Tree IO
tree, Sealed FL (PrimOf p) wR wX
diff) -> do
            [Flag] -> Doc -> IO ()
putVerbose [Flag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc
"Pristine differences:" Doc -> Doc -> Doc
$$ FL (PrimOf p) wR wX -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimOf p) wR wX
diff
            [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Fixing pristine tree..."
            IO PristineHash -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO PristineHash -> IO ()) -> IO PristineHash -> IO ()
forall a b. (a -> b) -> a -> b
$ Repository 'RW p wU wR -> Tree IO -> IO PristineHash
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> Tree IO -> IO PristineHash
writePristine Repository 'RW p wU wR
repo Tree IO
tree
          Maybe (Sealed (FL (PrimOf p) wR))
-> (Sealed (FL (PrimOf p) wR) -> IO ()) -> IO ()
forall (m :: * -> *) t. Monad m => Maybe t -> (t -> m ()) -> m ()
maybeDo Maybe (Sealed (FL (PrimOf p) wR))
fixedPending ((Sealed (FL (PrimOf p) wR) -> IO ()) -> IO ())
-> (Sealed (FL (PrimOf p) wR) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Sealed FL (PrimOf p) wR wX
pend) -> do
            [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Writing out repaired pending..."
            Repository 'RW p wU wR -> FL (PrimOf p) wR wX -> IO ()
forall (p :: * -> * -> *) wU wR wP.
RepoPatch p =>
Repository 'RW p wU wR -> FL (PrimOf p) wR wP -> IO ()
setTentativePending Repository 'RW p wU wR
repo FL (PrimOf p) wR wX
pend
          Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Maybe (PatchSet p Origin wR) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (PatchSet p Origin wR)
fixedPatches Bool -> Bool -> Bool
|| Maybe (Tree IO, Sealed (FL (PrimOf p) wR)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Tree IO, Sealed (FL (PrimOf p) wR))
fixedPristine Bool -> Bool -> Bool
|| Maybe (Sealed (FL (PrimOf p) wR)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Sealed (FL (PrimOf p) wR))
fixedPending
      index_ok <- checkIndex repo (quiet opts)
      unless index_ok $ do
        renameFile indexPath (indexPath <.> "bad")
        putInfo opts "Bad index discarded."
      if bad_replay || not index_ok
        then void $ finalizeRepositoryChanges repo (O.dryRun ? opts)
        else putInfo opts "The repository is already consistent, no changes made."

-- |check is an alias for repair, with implicit DryRun flag.
check :: DarcsCommand
check :: DarcsCommand
check = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"check"
    , commandHelp :: Doc
commandHelp = Doc
"See `darcs repair` for details."
    , commandExtraArgs :: Int
commandExtraArgs = Int
0
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = []
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [Flag] -> [String] -> IO ()
commandCommand = ([Flag] -> IO ())
-> (AbsolutePath, AbsolutePath) -> [Flag] -> [String] -> IO ()
forall b d a c. (b -> d) -> a -> b -> c -> d
withFpsAndArgs [Flag] -> IO ()
checkCmd
    , commandPrereq :: [Flag] -> IO (Either String ())
commandPrereq = [Flag] -> IO (Either String ())
amInHashedRepository
    , commandCompleteArgs :: (AbsolutePath, AbsolutePath) -> [Flag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath) -> [Flag] -> [String] -> IO [String]
noArgs
    , commandArgdefaults :: [Flag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [Flag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
    , String
CommandOptions
commandDescription :: String
commandOptions :: CommandOptions
commandOptions :: CommandOptions
commandDescription :: String
..
    }
  where
    basicOpts :: DarcsOption a (Maybe String -> DiffAlgorithm -> a)
basicOpts = DarcsOption a (Maybe String -> DiffAlgorithm -> a)
forall a. DarcsOption a (Maybe String -> DiffAlgorithm -> a)
commonBasicOpts
    advancedOpts :: OptSpec d f a a
advancedOpts = OptSpec d f a a
forall (d :: * -> *) f a. OptSpec d f a a
oid
    allOpts :: CommandOptions
allOpts = DarcsOption
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [Flag])
  (Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [Flag])
forall a. DarcsOption a (Maybe String -> DiffAlgorithm -> a)
basicOpts DarcsOption
  (Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [Flag])
  (Maybe String
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [Flag])
-> DarcsOption
     (UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag])
     (UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag]) b
-> CommandOptions
`withStdOpts` DarcsOption
  (UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag])
  (UseCache -> UseIndex -> HooksConfig -> Bool -> Bool -> [Flag])
forall (d :: * -> *) f a. OptSpec d f a a
advancedOpts
    commandOptions :: CommandOptions
commandOptions = CommandOptions
allOpts
    commandDescription :: String
commandDescription = String
"Alias for `darcs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand -> String
commandName DarcsCommand
repair String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --dry-run'."

checkCmd :: [DarcsFlag] -> IO ()
checkCmd :: [Flag] -> IO ()
checkCmd [Flag]
opts = UseCache -> RepoJob 'RO () -> IO ()
forall a. UseCache -> RepoJob 'RO a -> IO a
withRepository (PrimOptSpec DarcsOptDescr Flag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [Flag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) (RepoJob 'RO () -> IO ()) -> RepoJob 'RO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO () -> RepoJob 'RO ()
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RO () -> RepoJob 'RO ())
-> TreePatchJob 'RO () -> RepoJob 'RO ()
forall a b. (a -> b) -> a -> b
$ \Repository 'RO p wU wR
repository -> do
  RepositoryConsistency {..} <-
    DiffAlgorithm
-> Repository 'RO p wU wR
-> Verbosity
-> IO (RepositoryConsistency p wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
DiffAlgorithm
-> Repository rt p wU wR
-> Verbosity
-> IO (RepositoryConsistency p wR)
replayRepositoryInTemp (PrimOptSpec DarcsOptDescr Flag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
diffAlgorithm PrimDarcsOption DiffAlgorithm -> [Flag] -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) Repository 'RO p wU wR
repository (PrimOptSpec DarcsOptDescr Flag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [Flag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts)
  maybeDo fixedPatches $ \PatchSet p Origin wR
_ ->
    [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Found broken patches."
  maybeDo fixedPristine $ \(Tree IO
_, Sealed FL (PrimOf p) wR wX
diff) -> do
    [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Found broken pristine tree."
    [Flag] -> Doc -> IO ()
putVerbose [Flag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc
"Differences:" Doc -> Doc -> Doc
$$ FL (PrimOf p) wR wX -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimOf p) wR wX
diff
  maybeDo fixedPending $ \Sealed (FL (PrimOf p) wR)
_ ->
    [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Found broken pending."
  bad_index <-
    if useIndex ? opts == O.IgnoreIndex
      then return False
      else
        not <$> do
          checkIndex repository (quiet opts) `catchIOError` \IOError
e -> do
            [Flag] -> Doc -> IO ()
putWarning [Flag]
opts (Doc
"Warning, cannot access the index:" Doc -> Doc -> Doc
$$ String -> Doc
text (IOError -> String
forall a. Show a => a -> String
show IOError
e))
            Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  when bad_index $ putInfo opts "Bad index."
  if isJust fixedPatches || isJust fixedPristine || isJust fixedPending || bad_index
    then exitFailure
    else putInfo opts "The repository is consistent!"