module Darcs.Repository.Repair ( replayRepository, checkIndex,
                                 replayRepositoryInTemp,
                                 RepositoryConsistency(..) )
       where

import Prelude ()
import Darcs.Prelude

import Control.Monad ( when, unless )
import Control.Monad.Trans ( liftIO )
import Control.Exception ( catch, finally, IOException )
import Data.Maybe ( catMaybes )
import Data.List ( sort, (\\) )
import System.Directory ( createDirectoryIfMissing, getCurrentDirectory,
                          setCurrentDirectory )
import System.FilePath ( (</>) )
import Darcs.Util.Path( anchorPath, AbsolutePath, ioAbsolute, toFilePath )
import Darcs.Patch.PatchInfoAnd ( hopefully, PatchInfoAnd, info, winfo, WPatchInfo, unWPatchInfo, compareWPatchInfo )

import Darcs.Patch.Witnesses.Eq ( EqCheck(..) )
import Darcs.Patch.Witnesses.Ordered
    ( FL(..), RL(..), lengthFL, reverseFL,
    mapRL, nullFL, (:||:)(..) )
import Darcs.Patch.Witnesses.Sealed ( Sealed2(..), Sealed(..), unFreeLeft )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Repair ( Repair(applyAndTryToFix) )
import Darcs.Patch.Info ( displayPatchInfo )
import Darcs.Patch.Set ( Origin, PatchSet(..), patchSet2FL, patchSet2RL )
import Darcs.Patch ( RepoPatch, IsRepoType, PrimOf, isInconsistent )

import Darcs.Repository.Flags
    ( Verbosity(..), Compression, DiffAlgorithm )
import Darcs.Repository.Format ( identifyRepoFormat,
                                 RepoProperty ( HashedInventory ), formatHas )
import Darcs.Repository.Cache ( HashedDir( HashedPristineDir ) )
import Darcs.Repository.HashedIO ( cleanHashdir )
import Darcs.Repository.Hashed ( readHashedPristineRoot, writeAndReadPatch )
import Darcs.Repository.InternalTypes ( Repository, repoCache, repoLocation )
import Darcs.Repository.Prefs ( filetypeFunction )
import Darcs.Repository.Hashed ( readRepo )
import Darcs.Repository.State
    ( readRecorded
    , readIndex
    , readRecordedAndPending
    )
import Darcs.Repository.Diff( treeDiff )

import Darcs.Util.Progress ( debugMessage, beginTedious, endTedious, tediousSize, finishedOneIO )
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Lock( rmRecursive, withTempDir )
import Darcs.Util.Printer ( Doc, putDocLn, text )
import Darcs.Util.Printer.Color ( showDoc )

import Darcs.Util.Hash( Hash(NoHash), encodeBase16 )
import Darcs.Util.Tree( Tree, emptyTree, list, restrict, expand, itemHash, zipTrees )
import Darcs.Util.Tree.Monad( TreeIO )
import Darcs.Util.Tree.Hashed( darcsUpdateHashes, hashedTreeIO )
import Darcs.Util.Tree.Plain( readPlainTree )
import Darcs.Util.Index( updateIndex )

import qualified Data.ByteString.Char8 as BC

replaceInFL :: FL (PatchInfoAnd rt a) wX wY
            -> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
            -> FL (PatchInfoAnd rt a) wX wY
replaceInFL :: FL (PatchInfoAnd rt a) wX wY
-> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
-> FL (PatchInfoAnd rt a) wX wY
replaceInFL orig :: FL (PatchInfoAnd rt a) wX wY
orig [] = FL (PatchInfoAnd rt a) wX wY
orig
replaceInFL NilFL _ = FL (PatchInfoAnd rt a) wX wY
forall a. a
impossible
replaceInFL (o :: PatchInfoAnd rt a wX wY
o:>:orig :: FL (PatchInfoAnd rt a) wY wY
orig) ch :: [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
ch@(Sealed2 (o' :: WPatchInfo wX wY
o':||:c :: PatchInfoAnd rt a wX wY
c):ch_rest :: [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
ch_rest)
    | EqCheck (wX, wY) (wX, wY)
IsEq <- PatchInfoAnd rt a wX wY -> WPatchInfo wX wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WPatchInfo wA wB
winfo PatchInfoAnd rt a wX wY
o WPatchInfo wX wY -> WPatchInfo wX wY -> EqCheck (wX, wY) (wX, wY)
forall wA wB wC wD.
WPatchInfo wA wB -> WPatchInfo wC wD -> EqCheck (wA, wB) (wC, wD)
`compareWPatchInfo` WPatchInfo wX wY
o' = PatchInfoAnd rt a wX wY
cPatchInfoAnd rt a wX wY
-> FL (PatchInfoAnd rt a) wY wY -> FL (PatchInfoAnd rt a) wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL (PatchInfoAnd rt a) wY wY
-> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
-> FL (PatchInfoAnd rt a) wY wY
forall (rt :: RepoType) (a :: * -> * -> *) wX wY.
FL (PatchInfoAnd rt a) wX wY
-> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
-> FL (PatchInfoAnd rt a) wX wY
replaceInFL FL (PatchInfoAnd rt a) wY wY
orig [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
ch_rest
    | Bool
otherwise = PatchInfoAnd rt a wX wY
oPatchInfoAnd rt a wX wY
-> FL (PatchInfoAnd rt a) wY wY -> FL (PatchInfoAnd rt a) wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:FL (PatchInfoAnd rt a) wY wY
-> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
-> FL (PatchInfoAnd rt a) wY wY
forall (rt :: RepoType) (a :: * -> * -> *) wX wY.
FL (PatchInfoAnd rt a) wX wY
-> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
-> FL (PatchInfoAnd rt a) wX wY
replaceInFL FL (PatchInfoAnd rt a) wY wY
orig [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
ch

applyAndFix :: forall rt p wR wU wT. (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
            => Repository rt p wR wU wT -> Compression -> FL (PatchInfoAnd rt p) Origin wR
            -> TreeIO (FL (PatchInfoAnd rt p) Origin wR, Bool)
applyAndFix :: Repository rt p wR wU wT
-> Compression
-> FL (PatchInfoAnd rt p) Origin wR
-> TreeIO (FL (PatchInfoAnd rt p) Origin wR, Bool)
applyAndFix _ _ NilFL = (FL (PatchInfoAnd rt p) Origin Origin, Bool)
-> RWST
     AnchoredPath
     ()
     (TreeState IO)
     IO
     (FL (PatchInfoAnd rt p) Origin Origin, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (PatchInfoAnd rt p) Origin Origin
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL, Bool
True)
applyAndFix r :: Repository rt p wR wU wT
r compr :: Compression
compr psin :: FL (PatchInfoAnd rt p) Origin wR
psin =
    do IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RWST AnchoredPath () (TreeState IO) IO ())
-> IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
beginTedious String
k
       IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RWST AnchoredPath () (TreeState IO) IO ())
-> IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> IO ()
tediousSize String
k (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ FL (PatchInfoAnd rt p) Origin wR -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (PatchInfoAnd rt p) Origin wR
psin
       (repaired :: [Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)]
repaired, ok :: Bool
ok) <- FL (PatchInfoAnd rt p) Origin wR
-> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
forall wW wZ.
FL (PatchInfoAnd rt p) wW wZ
-> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
aaf FL (PatchInfoAnd rt p) Origin wR
psin
       IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RWST AnchoredPath () (TreeState IO) IO ())
-> IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
endTedious String
k
       FL (PatchInfoAnd rt p) Origin wR
orig <- IO (FL (PatchInfoAnd rt p) Origin wR)
-> RWST
     AnchoredPath
     ()
     (TreeState IO)
     IO
     (FL (PatchInfoAnd rt p) Origin wR)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FL (PatchInfoAnd rt p) Origin wR)
 -> RWST
      AnchoredPath
      ()
      (TreeState IO)
      IO
      (FL (PatchInfoAnd rt p) Origin wR))
-> IO (FL (PatchInfoAnd rt p) Origin wR)
-> RWST
     AnchoredPath
     ()
     (TreeState IO)
     IO
     (FL (PatchInfoAnd rt p) Origin wR)
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR -> FL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL (PatchSet rt p Origin wR -> FL (PatchInfoAnd rt p) Origin wR)
-> IO (PatchSet rt p Origin wR)
-> IO (FL (PatchInfoAnd rt p) Origin wR)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
r
       (FL (PatchInfoAnd rt p) Origin wR, Bool)
-> TreeIO (FL (PatchInfoAnd rt p) Origin wR, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (PatchInfoAnd rt p) Origin wR
-> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)]
-> FL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (a :: * -> * -> *) wX wY.
FL (PatchInfoAnd rt a) wX wY
-> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt a)]
-> FL (PatchInfoAnd rt a) wX wY
replaceInFL FL (PatchInfoAnd rt p) Origin wR
orig [Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)]
repaired, Bool
ok)
    where k :: String
k = "Replaying patch"
          aaf :: FL (PatchInfoAnd rt p) wW wZ -> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
          aaf :: FL (PatchInfoAnd rt p) wW wZ
-> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
aaf NilFL = ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
-> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Bool
True)
          aaf (p :: PatchInfoAnd rt p wW wY
p:>:ps :: FL (PatchInfoAnd rt p) wY wZ
ps) = do
            Maybe (String, PatchInfoAnd rt p wW wY)
mp' <- PatchInfoAnd rt p wW wY
-> RWST
     AnchoredPath
     ()
     (TreeState IO)
     IO
     (Maybe (String, PatchInfoAnd rt p wW wY))
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Repair p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m (Maybe (String, p wX wY))
applyAndTryToFix PatchInfoAnd rt p wW wY
p
            case WrappedNamed rt p wW wY -> Maybe Doc
forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc
isInconsistent (WrappedNamed rt p wW wY -> Maybe Doc)
-> (PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY)
-> PatchInfoAnd rt p wW wY
-> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd rt p wW wY -> WrappedNamed rt p wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WrappedNamed rt p wA wB
hopefully (PatchInfoAnd rt p wW wY -> Maybe Doc)
-> PatchInfoAnd rt p wW wY -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd rt p wW wY
p of
              Just err :: Doc
err -> IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RWST AnchoredPath () (TreeState IO) IO ())
-> IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> IO ()
putDocLn Doc
err
              Nothing -> () -> RWST AnchoredPath () (TreeState IO) IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            let !winfp :: WPatchInfo wW wY
winfp = PatchInfoAnd rt p wW wY -> WPatchInfo wW wY
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> WPatchInfo wA wB
winfo PatchInfoAnd rt p wW wY
p -- assure that 'p' can be garbage collected.
            IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RWST AnchoredPath () (TreeState IO) IO ())
-> IO () -> RWST AnchoredPath () (TreeState IO) IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
finishedOneIO String
k (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> String
showDoc (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Doc
displayPatchInfo (PatchInfo -> Doc) -> PatchInfo -> Doc
forall a b. (a -> b) -> a -> b
$ WPatchInfo wW wY -> PatchInfo
forall wA wB. WPatchInfo wA wB -> PatchInfo
unWPatchInfo WPatchInfo wW wY
winfp
            (ps' :: [Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)]
ps', restok :: Bool
restok) <- FL (PatchInfoAnd rt p) wY wZ
-> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
forall wW wZ.
FL (PatchInfoAnd rt p) wW wZ
-> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
aaf FL (PatchInfoAnd rt p) wY wZ
ps
            case Maybe (String, PatchInfoAnd rt p wW wY)
mp' of
              Nothing -> ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
-> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)]
ps', Bool
restok)
              Just (e :: String
e,pp :: PatchInfoAnd rt p wW wY
pp) -> IO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
-> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
 -> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool))
-> IO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
-> TreeIO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
forall a b. (a -> b) -> a -> b
$ do
                String -> IO ()
putStrLn String
e
                PatchInfoAnd rt p wW wY
p' <- String
-> IO (PatchInfoAnd rt p wW wY) -> IO (PatchInfoAnd rt p wW wY)
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
r) (IO (PatchInfoAnd rt p wW wY) -> IO (PatchInfoAnd rt p wW wY))
-> IO (PatchInfoAnd rt p wW wY) -> IO (PatchInfoAnd rt p wW wY)
forall a b. (a -> b) -> a -> b
$
                  Cache
-> Compression
-> PatchInfoAnd rt p wW wY
-> IO (PatchInfoAnd rt p wW wY)
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(IsRepoType rt, RepoPatch p) =>
Cache
-> Compression
-> PatchInfoAnd rt p wX wY
-> IO (PatchInfoAnd rt p wX wY)
writeAndReadPatch (Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r) Compression
compr PatchInfoAnd rt p wW wY
pp
                ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
-> IO ([Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)], Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:||:) WPatchInfo (PatchInfoAnd rt p) wW wY
-> Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 (WPatchInfo wW wY
winfp WPatchInfo wW wY
-> PatchInfoAnd rt p wW wY
-> (:||:) WPatchInfo (PatchInfoAnd rt p) wW wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY.
a1 wX wY -> a2 wX wY -> (:||:) a1 a2 wX wY
:||: PatchInfoAnd rt p wW wY
p')Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)
-> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)]
-> [Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)]
forall a. a -> [a] -> [a]
:[Sealed2 (WPatchInfo :||: PatchInfoAnd rt p)]
ps', Bool
False)

data RepositoryConsistency rt p wX =
    RepositoryConsistent
  | BrokenPristine (Tree IO)
  | BrokenPatches (Tree IO) (PatchSet rt p Origin wX)

checkUniqueness :: (IsRepoType rt, RepoPatch p)
                => (Doc -> IO ()) -> (Doc -> IO ()) -> Repository rt p wR wU wT -> IO ()
checkUniqueness :: (Doc -> IO ())
-> (Doc -> IO ()) -> Repository rt p wR wU wT -> IO ()
checkUniqueness putVerbose :: Doc -> IO ()
putVerbose putInfo :: Doc -> IO ()
putInfo repository :: Repository rt p wR wU wT
repository =
    do Doc -> IO ()
putVerbose (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Checking that patch names are unique..."
       PatchSet rt p Origin wR
r <- Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
repository
       case [PatchInfo] -> Maybe PatchInfo
forall a. Ord a => [a] -> Maybe a
hasDuplicate ([PatchInfo] -> Maybe PatchInfo) -> [PatchInfo] -> Maybe PatchInfo
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. PatchInfoAnd rt p wW wZ -> PatchInfo)
-> RL (PatchInfoAnd rt p) Origin wR -> [PatchInfo]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall wW wZ. PatchInfoAnd rt p wW wZ -> PatchInfo
forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAnd rt p wA wB -> PatchInfo
info (RL (PatchInfoAnd rt p) Origin wR -> [PatchInfo])
-> RL (PatchInfoAnd rt p) Origin wR -> [PatchInfo]
forall a b. (a -> b) -> a -> b
$ PatchSet rt p Origin wR -> RL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet rt p Origin wR
r of
         Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just pinf :: PatchInfo
pinf -> do Doc -> IO ()
putInfo (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Error! Duplicate patch name:"
                         Doc -> IO ()
putInfo (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ PatchInfo -> Doc
displayPatchInfo PatchInfo
pinf
                         String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Duplicate patches found."

hasDuplicate :: Ord a => [a] -> Maybe a
hasDuplicate :: [a] -> Maybe a
hasDuplicate li :: [a]
li = [a] -> Maybe a
forall a. Eq a => [a] -> Maybe a
hd ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. Ord a => [a] -> [a]
sort [a]
li
    where hd :: [a] -> Maybe a
hd [_] = Maybe a
forall a. Maybe a
Nothing
          hd [] = Maybe a
forall a. Maybe a
Nothing
          hd (x1 :: a
x1:x2 :: a
x2:xs :: [a]
xs) | a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 = a -> Maybe a
forall a. a -> Maybe a
Just a
x1
                        | Bool
otherwise = [a] -> Maybe a
hd (a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
replayRepository' ::
    forall rt p wR wU wT . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
               => DiffAlgorithm -> AbsolutePath -> Repository rt p wR wU wT -> Compression -> Verbosity -> IO (RepositoryConsistency rt p wR)
replayRepository' :: DiffAlgorithm
-> AbsolutePath
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> IO (RepositoryConsistency rt p wR)
replayRepository' dflag :: DiffAlgorithm
dflag whereToReplay' :: AbsolutePath
whereToReplay' repo :: Repository rt p wR wU wT
repo compr :: Compression
compr verbosity :: Verbosity
verbosity = do
  let whereToReplay :: String
whereToReplay = AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
whereToReplay'
      putVerbose :: Doc -> IO ()
putVerbose s :: Doc
s = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> IO ()
putDocLn Doc
s
      putInfo :: Doc -> IO ()
putInfo s :: Doc
s = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Quiet) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> IO ()
putDocLn Doc
s
  (Doc -> IO ())
-> (Doc -> IO ()) -> Repository rt p wR wU wT -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
(Doc -> IO ())
-> (Doc -> IO ()) -> Repository rt p wR wU wT -> IO ()
checkUniqueness Doc -> IO ()
putVerbose Doc -> IO ()
putInfo Repository rt p wR wU wT
repo
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
whereToReplay
  Doc -> IO ()
putVerbose (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Reading recorded state..."
  Tree IO
pris <- Repository rt p wR wU wT -> IO (Tree IO)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wT
repo IO (Tree IO) -> (IOException -> IO (Tree IO)) -> IO (Tree IO)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
_ :: IOException) -> Tree IO -> IO (Tree IO)
forall (m :: * -> *) a. Monad m => a -> m a
return Tree IO
forall (m :: * -> *). Tree m
emptyTree
  Doc -> IO ()
putVerbose (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Applying patches..."
  PatchSet rt p Origin wR
patches <- Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository rt p wR wU wT
repo
  String -> IO ()
debugMessage "Fixing any broken patches..."
  let psin :: FL (PatchInfoAnd rt p) Origin wR
psin = PatchSet rt p Origin wR -> FL (PatchInfoAnd rt p) Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL PatchSet rt p Origin wR
patches
      repair :: TreeIO (FL (PatchInfoAnd rt p) Origin wR, Bool)
repair = Repository rt p wR wU wT
-> Compression
-> FL (PatchInfoAnd rt p) Origin wR
-> TreeIO (FL (PatchInfoAnd rt p) Origin wR, Bool)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> Compression
-> FL (PatchInfoAnd rt p) Origin wR
-> TreeIO (FL (PatchInfoAnd rt p) Origin wR, Bool)
applyAndFix Repository rt p wR wU wT
repo Compression
compr FL (PatchInfoAnd rt p) Origin wR
psin

  ((ps :: FL (PatchInfoAnd rt p) Origin wR
ps, patches_ok :: Bool
patches_ok), newpris :: Tree IO
newpris) <- TreeIO (FL (PatchInfoAnd rt p) Origin wR, Bool)
-> Tree IO
-> String
-> IO ((FL (PatchInfoAnd rt p) Origin wR, Bool), Tree IO)
forall a. TreeIO a -> Tree IO -> String -> IO (a, Tree IO)
hashedTreeIO TreeIO (FL (PatchInfoAnd rt p) Origin wR, Bool)
repair Tree IO
forall (m :: * -> *). Tree m
emptyTree String
whereToReplay
  String -> IO ()
debugMessage "Done fixing broken patches..."
  let newpatches :: PatchSet rt p Origin wR
newpatches = RL (Tagged rt p) Origin Origin
-> RL (PatchInfoAnd rt p) Origin wR -> PatchSet rt p Origin wR
forall (rt :: RepoType) (p :: * -> * -> *) wStart wX wY.
RL (Tagged rt p) wStart wX
-> RL (PatchInfoAnd rt p) wX wY -> PatchSet rt p wStart wY
PatchSet RL (Tagged rt p) Origin Origin
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL (FL (PatchInfoAnd rt p) Origin wR
-> RL (PatchInfoAnd rt p) Origin wR
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL (PatchInfoAnd rt p) Origin wR
ps)

  String -> IO ()
debugMessage "Checking pristine against slurpy"
  String -> FileType
ftf <- IO (String -> FileType)
filetypeFunction
  Bool
is_same <- do Sealed diff :: FL (PrimOf p) wR wX
diff <- FreeLeft (FL (PrimOf p)) -> Sealed (FL (PrimOf p) wR)
forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft (FreeLeft (FL (PrimOf p)) -> Sealed (FL (PrimOf p) wR))
-> IO (FreeLeft (FL (PrimOf p))) -> IO (Sealed (FL (PrimOf p) wR))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DiffAlgorithm
-> (String -> FileType)
-> Tree IO
-> Tree IO
-> IO (FreeLeft (FL (PrimOf p)))
forall (m :: * -> *) (w :: (* -> * -> *) -> *)
       (prim :: * -> * -> *).
(Monad m, Gap w, PrimPatch prim) =>
DiffAlgorithm
-> (String -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff DiffAlgorithm
dflag String -> FileType
ftf Tree IO
pris Tree IO
newpris :: IO (Sealed (FL (PrimOf p) wR))
                Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wR wX -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (PrimOf p) wR wX
diff
              IO Bool -> IO Bool -> IO Bool
forall a. IO a -> IO a -> IO a
`catchall` Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  -- TODO is the latter condition needed? Does a broken patch imply pristine
  -- difference? Why, or why not?
  RepositoryConsistency rt p wR -> IO (RepositoryConsistency rt p wR)
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
is_same Bool -> Bool -> Bool
&& Bool
patches_ok
     then RepositoryConsistency rt p wR
forall (rt :: RepoType) (p :: * -> * -> *) wX.
RepositoryConsistency rt p wX
RepositoryConsistent
     else if Bool
patches_ok
            then Tree IO -> RepositoryConsistency rt p wR
forall (rt :: RepoType) (p :: * -> * -> *) wX.
Tree IO -> RepositoryConsistency rt p wX
BrokenPristine Tree IO
newpris
            else Tree IO -> PatchSet rt p Origin wR -> RepositoryConsistency rt p wR
forall (rt :: RepoType) (p :: * -> * -> *) wX.
Tree IO -> PatchSet rt p Origin wX -> RepositoryConsistency rt p wX
BrokenPatches Tree IO
newpris PatchSet rt p Origin wR
newpatches)

cleanupRepositoryReplay :: Repository rt p wR wU wT -> IO ()
cleanupRepositoryReplay :: Repository rt p wR wU wT -> IO ()
cleanupRepositoryReplay r :: Repository rt p wR wU wT
r = do
  let c :: Cache
c = Repository rt p wR wU wT -> Cache
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wT
r
  RepoFormat
rf <- String -> IO RepoFormat
identifyRepoFormat "."
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory RepoFormat
rf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> IO ()
rmRecursive (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
darcsdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/pristine.hashed"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory RepoFormat
rf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
       Maybe String
current <- Repository rt p wR wU wT -> IO (Maybe String)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Maybe String)
readHashedPristineRoot Repository rt p wR wU wT
r
       Cache -> HashedDir -> [String] -> IO ()
cleanHashdir Cache
c HashedDir
HashedPristineDir ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [Maybe String
current]

replayRepositoryInTemp :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                       => DiffAlgorithm -> Repository rt p wR wU wT -> Compression -> Verbosity
                          -> IO (RepositoryConsistency rt p wR)
replayRepositoryInTemp :: DiffAlgorithm
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> IO (RepositoryConsistency rt p wR)
replayRepositoryInTemp dflag :: DiffAlgorithm
dflag r :: Repository rt p wR wU wT
r compr :: Compression
compr verb :: Verbosity
verb = do
  String
repodir <- IO String
getCurrentDirectory
  String
-> (AbsolutePath -> IO (RepositoryConsistency rt p wR))
-> IO (RepositoryConsistency rt p wR)
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir "darcs-check" ((AbsolutePath -> IO (RepositoryConsistency rt p wR))
 -> IO (RepositoryConsistency rt p wR))
-> (AbsolutePath -> IO (RepositoryConsistency rt p wR))
-> IO (RepositoryConsistency rt p wR)
forall a b. (a -> b) -> a -> b
$ \tmpDir :: AbsolutePath
tmpDir -> do
    String -> IO ()
setCurrentDirectory String
repodir
    DiffAlgorithm
-> AbsolutePath
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> IO (RepositoryConsistency rt p wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
DiffAlgorithm
-> AbsolutePath
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> IO (RepositoryConsistency rt p wR)
replayRepository' DiffAlgorithm
dflag AbsolutePath
tmpDir Repository rt p wR wU wT
r Compression
compr Verbosity
verb

replayRepository :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                 => DiffAlgorithm -> Repository rt p wR wU wT -> Compression -> Verbosity
                 -> (RepositoryConsistency rt p wR -> IO a) -> IO a
replayRepository :: DiffAlgorithm
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> (RepositoryConsistency rt p wR -> IO a)
-> IO a
replayRepository dflag :: DiffAlgorithm
dflag r :: Repository rt p wR wU wT
r compr :: Compression
compr verb :: Verbosity
verb f :: RepositoryConsistency rt p wR -> IO a
f =
  IO a
run IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` Repository rt p wR wU wT -> IO ()
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO ()
cleanupRepositoryReplay Repository rt p wR wU wT
r
    where run :: IO a
run = do
            Bool -> String -> IO ()
createDirectoryIfMissing Bool
False (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
darcsdir String -> String -> String
</> "pristine.hashed"
            AbsolutePath
hashedPristine <- String -> IO AbsolutePath
ioAbsolute (String -> IO AbsolutePath) -> String -> IO AbsolutePath
forall a b. (a -> b) -> a -> b
$ String
darcsdir String -> String -> String
</> "pristine.hashed"
            RepositoryConsistency rt p wR
st <- DiffAlgorithm
-> AbsolutePath
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> IO (RepositoryConsistency rt p wR)
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
DiffAlgorithm
-> AbsolutePath
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> IO (RepositoryConsistency rt p wR)
replayRepository' DiffAlgorithm
dflag AbsolutePath
hashedPristine Repository rt p wR wU wT
r Compression
compr Verbosity
verb
            RepositoryConsistency rt p wR -> IO a
f RepositoryConsistency rt p wR
st

checkIndex :: (RepoPatch p, ApplyState p ~ Tree) => Repository rt p wR wU wT -> Bool -> IO Bool
checkIndex :: Repository rt p wR wU wT -> Bool -> IO Bool
checkIndex repo :: Repository rt p wR wU wT
repo quiet :: Bool
quiet = do
  Tree IO
index <- Index -> IO (Tree IO)
updateIndex (Index -> IO (Tree IO)) -> IO Index -> IO (Tree IO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Repository rt p wR wU wT -> IO Index
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> IO Index
readIndex Repository rt p wR wU wT
repo
  Tree IO
pristine <- Tree IO -> IO (Tree IO)
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand (Tree IO -> IO (Tree IO)) -> IO (Tree IO) -> IO (Tree IO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Repository rt p wR wU wT -> IO (Tree IO)
forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT -> IO (Tree IO)
readRecordedAndPending Repository rt p wR wU wT
repo
  Tree IO
working <- Tree IO -> IO (Tree IO)
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand (Tree IO -> IO (Tree IO)) -> IO (Tree IO) -> IO (Tree IO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Tree IO -> Tree IO -> Tree IO
forall (t :: (* -> *) -> *) (m :: * -> *) (n :: * -> *).
FilterTree t m =>
Tree n -> t m -> t m
restrict Tree IO
pristine (Tree IO -> Tree IO) -> IO (Tree IO) -> IO (Tree IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Tree IO)
readPlainTree "."
  Tree IO
working_hashed <- Tree IO -> IO (Tree IO)
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
darcsUpdateHashes Tree IO
working
  let index_paths :: [AnchoredPath]
index_paths = [ AnchoredPath
p | (p :: AnchoredPath
p, _) <- Tree IO -> [(AnchoredPath, TreeItem IO)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree IO
index ]
      working_paths :: [AnchoredPath]
working_paths = [ AnchoredPath
p | (p :: AnchoredPath
p, _) <- Tree IO -> [(AnchoredPath, TreeItem IO)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree IO
working ]
      index_extra :: [AnchoredPath]
index_extra = [AnchoredPath]
index_paths [AnchoredPath] -> [AnchoredPath] -> [AnchoredPath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [AnchoredPath]
working_paths
      working_extra :: [AnchoredPath]
working_extra = [AnchoredPath]
working_paths [AnchoredPath] -> [AnchoredPath] -> [AnchoredPath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [AnchoredPath]
index_paths
      gethashes :: a -> Maybe (TreeItem m) -> Maybe (TreeItem m) -> (a, Hash, Hash)
gethashes p :: a
p (Just i1 :: TreeItem m
i1) (Just i2 :: TreeItem m
i2) = (a
p, TreeItem m -> Hash
forall (m :: * -> *). TreeItem m -> Hash
itemHash TreeItem m
i1, TreeItem m -> Hash
forall (m :: * -> *). TreeItem m -> Hash
itemHash TreeItem m
i2)
      gethashes p :: a
p (Just i1 :: TreeItem m
i1) Nothing   = (a
p, TreeItem m -> Hash
forall (m :: * -> *). TreeItem m -> Hash
itemHash TreeItem m
i1, Hash
NoHash)
      gethashes p :: a
p   Nothing (Just i2 :: TreeItem m
i2) = (a
p,      Hash
NoHash, TreeItem m -> Hash
forall (m :: * -> *). TreeItem m -> Hash
itemHash TreeItem m
i2)
      gethashes p :: a
p   Nothing Nothing   = String -> (a, Hash, Hash)
forall a. HasCallStack => String -> a
error (String -> (a, Hash, Hash)) -> String -> (a, Hash, Hash)
forall a b. (a -> b) -> a -> b
$ "Bad case at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
p
      mismatches :: [(AnchoredPath, Hash, Hash)]
mismatches = [ (AnchoredPath, Hash, Hash)
miss | miss :: (AnchoredPath, Hash, Hash)
miss@(_, h1 :: Hash
h1, h2 :: Hash
h2) <- (AnchoredPath
 -> Maybe (TreeItem IO)
 -> Maybe (TreeItem IO)
 -> (AnchoredPath, Hash, Hash))
-> Tree IO -> Tree IO -> [(AnchoredPath, Hash, Hash)]
forall (m :: * -> *) a.
(AnchoredPath -> Maybe (TreeItem m) -> Maybe (TreeItem m) -> a)
-> Tree m -> Tree m -> [a]
zipTrees AnchoredPath
-> Maybe (TreeItem IO)
-> Maybe (TreeItem IO)
-> (AnchoredPath, Hash, Hash)
forall a (m :: * -> *) (m :: * -> *).
Show a =>
a -> Maybe (TreeItem m) -> Maybe (TreeItem m) -> (a, Hash, Hash)
gethashes Tree IO
index Tree IO
working_hashed, Hash
h1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash
h2 ]

      format :: [AnchoredPath] -> String
format paths :: [AnchoredPath]
paths = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (AnchoredPath -> String) -> [AnchoredPath] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (("  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (AnchoredPath -> String) -> AnchoredPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AnchoredPath -> String
anchorPath "") [AnchoredPath]
paths
      mismatches_disp :: String
mismatches_disp = [String] -> String
unlines [ String -> AnchoredPath -> String
anchorPath "" AnchoredPath
p String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                    "\n    index: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BC.unpack (Hash -> ByteString
encodeBase16 Hash
h1) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                    "\n  working: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BC.unpack (Hash -> ByteString
encodeBase16 Hash
h2)
                                  | (p :: AnchoredPath
p, h1 :: Hash
h1, h2 :: Hash
h2) <- [(AnchoredPath, Hash, Hash)]
mismatches ]
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
quiet Bool -> Bool -> Bool
|| [AnchoredPath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnchoredPath]
index_extra) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Extra items in index!\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [AnchoredPath] -> String
format [AnchoredPath]
index_extra
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
quiet Bool -> Bool -> Bool
|| [AnchoredPath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnchoredPath]
working_extra) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Missing items in index!\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [AnchoredPath] -> String
format [AnchoredPath]
working_extra
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
quiet Bool -> Bool -> Bool
|| [(AnchoredPath, Hash, Hash)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(AnchoredPath, Hash, Hash)]
mismatches) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Hash mismatch(es)!\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mismatches_disp
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ [AnchoredPath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnchoredPath]
index_extra Bool -> Bool -> Bool
&& [AnchoredPath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnchoredPath]
working_extra Bool -> Bool -> Bool
&& [(AnchoredPath, Hash, Hash)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(AnchoredPath, Hash, Hash)]
mismatches