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
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
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