--  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 )
import Control.Exception ( catch, IOException )
import System.Exit ( ExitCode(..), exitWith )
import System.Directory( renameFile )
import System.FilePath ( (<.>) )

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

import Darcs.Repository.Flags ( UpdatePending (..) )
import Darcs.Repository.Paths ( indexPath )
import Darcs.Repository.Repair
    ( replayRepository, checkIndex, replayRepositoryInTemp
    , RepositoryConsistency(..)
    )
import Darcs.Repository
    ( Repository, withRepository, readRecorded, RepoJob(..)
    , withRepoLock, replacePristine, repoCache
    )
import qualified Darcs.Repository.Hashed as HashedRepo
import Darcs.Repository.Prefs ( filetypeFunction )
import Darcs.Repository.Diff( treeDiff )

import Darcs.Patch ( RepoPatch, PrimOf, displayPatch )
import Darcs.Patch.Witnesses.Ordered ( FL(..) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), unFreeLeft )

import Darcs.Util.Printer ( Doc, text )
import Darcs.Util.Tree ( Tree, expand )
import Darcs.Util.Tree.Hashed ( darcsUpdateHashes )


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

repairHelp :: Doc
repairHelp :: Doc
repairHelp = String -> Doc
text 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.UseIndex -> O.DiffAlgorithm -> a)
commonBasicOpts :: forall a.
DarcsOption a (Maybe String -> UseIndex -> DiffAlgorithm -> a)
commonBasicOpts = PrimDarcsOption (Maybe String)
O.repoDir forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UseIndex
O.useIndex forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ 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 = 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
    , [DarcsOptDescr Flag]
[Flag]
[Flag] -> [String]
commandCheckOptions :: [Flag] -> [String]
commandDefaults :: [Flag]
commandAdvancedOptions :: [DarcsOptDescr Flag]
commandBasicOptions :: [DarcsOptDescr Flag]
commandCheckOptions :: [Flag] -> [String]
commandDefaults :: [Flag]
commandBasicOptions :: [DarcsOptDescr Flag]
commandAdvancedOptions :: [DarcsOptDescr Flag]
..
    }
  where
    basicOpts :: OptSpec
  DarcsOptDescr
  Flag
  a
  (Maybe String -> UseIndex -> DiffAlgorithm -> DryRun -> a)
basicOpts = forall a.
DarcsOption a (Maybe String -> UseIndex -> DiffAlgorithm -> a)
commonBasicOpts forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption DryRun
O.dryRun
    advancedOpts :: PrimOptSpec DarcsOptDescr Flag a UMask
advancedOpts = PrimDarcsOption UMask
O.umask
    allOpts :: DarcsOption
  a
  (Maybe String
   -> UseIndex
   -> DiffAlgorithm
   -> DryRun
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
allOpts = forall {a}.
OptSpec
  DarcsOptDescr
  Flag
  a
  (Maybe String -> UseIndex -> DiffAlgorithm -> DryRun -> a)
basicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` PrimDarcsOption UMask
advancedOpts
    commandAdvancedOptions :: [DarcsOptDescr Flag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc PrimDarcsOption UMask
advancedOpts
    commandBasicOptions :: [DarcsOptDescr Flag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
  DarcsOptDescr
  Flag
  a
  (Maybe String -> UseIndex -> DiffAlgorithm -> DryRun -> a)
basicOpts
    commandDefaults :: [Flag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
  a
  (Maybe String
   -> UseIndex
   -> DiffAlgorithm
   -> DryRun
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
allOpts
    commandCheckOptions :: [Flag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
  a
  (Maybe String
   -> UseIndex
   -> DiffAlgorithm
   -> DryRun
   -> Maybe StdCmdAction
   -> Verbosity
   -> UMask
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
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

repairCmd :: [DarcsFlag] -> IO ()
repairCmd :: [Flag] -> IO ()
repairCmd [Flag]
opts
  | forall a. YesNo a => a -> Bool
O.yes (PrimDarcsOption DryRun
O.dryRun forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) = [Flag] -> IO ()
checkCmd [Flag]
opts
  | Bool
otherwise =
    forall a.
DryRun -> UseCache -> UpdatePending -> UMask -> RepoJob a -> IO a
withRepoLock DryRun
O.NoDryRun (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) UpdatePending
YesUpdatePending (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) forall a b. (a -> b) -> a -> b
$
    forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob forall a b. (a -> b) -> a -> b
$ \Repository rt p wR wU wR
repo -> do
      forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT a.
(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
        (PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts)
        Repository rt p wR wU wR
repo
        (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts)
        (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) forall a b. (a -> b) -> a -> b
$ \RepositoryConsistency rt p wR
state ->
        case RepositoryConsistency rt p wR
state of
          RepositoryConsistency rt p wR
RepositoryConsistent ->
            [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"The repository is already consistent, no changes made."
          BrokenPristine Tree IO
tree -> do
            [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Fixing pristine tree..."
            forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Tree IO -> IO ()
replacePristine Repository rt p wR wU wR
repo Tree IO
tree
          BrokenPatches Tree IO
tree PatchSet rt p Origin wR
newps -> do
            [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Writing out repaired patches..."
            forall (p :: * -> * -> *) (rt :: RepoType) wX.
RepoPatch p =>
Cache -> Compression -> PatchSet rt p Origin wX -> IO ()
HashedRepo.writeTentativeInventory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Cache
repoCache Repository rt p wR wU wR
repo) (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) PatchSet rt p Origin wR
newps
            forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> Compression -> IO ()
HashedRepo.finalizeTentativeChanges Repository rt p wR wU wR
repo (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts)
            [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Fixing pristine tree..."
            forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> Tree IO -> IO ()
replacePristine Repository rt p wR wU wR
repo Tree IO
tree
      Bool
index_ok <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> Bool -> IO Bool
checkIndex Repository rt p wR wU wR
repo ([Flag] -> Bool
quiet [Flag]
opts)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
index_ok forall a b. (a -> b) -> a -> b
$ do
        String -> String -> IO ()
renameFile String
indexPath (String
indexPath String -> String -> String
<.> String
"bad")
        [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Bad index discarded."

-- |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 = 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
[DarcsOptDescr Flag]
[Flag]
[Flag] -> [String]
forall {d :: * -> *} {f}. [d f]
commandDescription :: String
commandCheckOptions :: [Flag] -> [String]
commandDefaults :: [Flag]
commandBasicOptions :: [DarcsOptDescr Flag]
commandAdvancedOptions :: forall {d :: * -> *} {f}. [d f]
commandCheckOptions :: [Flag] -> [String]
commandDefaults :: [Flag]
commandAdvancedOptions :: [DarcsOptDescr Flag]
commandBasicOptions :: [DarcsOptDescr Flag]
commandDescription :: String
..
    }
  where
    basicOpts :: DarcsOption a (Maybe String -> UseIndex -> DiffAlgorithm -> a)
basicOpts = forall a.
DarcsOption a (Maybe String -> UseIndex -> DiffAlgorithm -> a)
commonBasicOpts
    advancedOpts :: OptSpec d f a a
advancedOpts = forall (d :: * -> *) f a. OptSpec d f a a
oid
    allOpts :: DarcsOption
  a
  (Maybe String
   -> UseIndex
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
allOpts = forall a.
DarcsOption a (Maybe String -> UseIndex -> DiffAlgorithm -> a)
basicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
     (UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall (d :: * -> *) f a. OptSpec d f a a
advancedOpts
    commandAdvancedOptions :: [d f]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall (d :: * -> *) f a. OptSpec d f a a
advancedOpts
    commandBasicOptions :: [DarcsOptDescr Flag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall a.
DarcsOption a (Maybe String -> UseIndex -> DiffAlgorithm -> a)
basicOpts
    commandDefaults :: [Flag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
  a
  (Maybe String
   -> UseIndex
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
allOpts
    commandCheckOptions :: [Flag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
  a
  (Maybe String
   -> UseIndex
   -> DiffAlgorithm
   -> Maybe StdCmdAction
   -> Verbosity
   -> UseCache
   -> HooksConfig
   -> Bool
   -> Bool
   -> Bool
   -> a)
allOpts
    commandDescription :: String
commandDescription = String
"Alias for `darcs " forall a. [a] -> [a] -> [a]
++ DarcsCommand -> String
commandName DarcsCommand
repair forall a. [a] -> [a] -> [a]
++ String
" --dry-run'."

checkCmd :: [DarcsFlag] -> IO ()
checkCmd :: [Flag] -> IO ()
checkCmd [Flag]
opts = forall a. UseCache -> RepoJob a -> IO a
withRepository (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) forall a b. (a -> b) -> a -> b
$ forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
 (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
 Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob forall a b. (a -> b) -> a -> b
$ \Repository rt p wR wU wR
repository -> do
  RepositoryConsistency rt p wR
state <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
DiffAlgorithm
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> IO (RepositoryConsistency rt p wR)
replayRepositoryInTemp (PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) Repository rt p wR wU wR
repository (PrimDarcsOption Compression
compress forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts)
  Bool
failed <-
    case RepositoryConsistency rt p wR
state of
      RepositoryConsistency rt p wR
RepositoryConsistent -> do
        [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"The repository is consistent!"
        forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      BrokenPristine Tree IO
newpris -> do
        forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
RepoPatch p =>
[Flag] -> Repository rt p wR wU wT -> Tree IO -> IO ()
brokenPristine [Flag]
opts Repository rt p wR wU wR
repository Tree IO
newpris
        forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      BrokenPatches Tree IO
newpris PatchSet rt p Origin wR
_ -> do
        forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
RepoPatch p =>
[Flag] -> Repository rt p wR wU wT -> Tree IO -> IO ()
brokenPristine [Flag]
opts Repository rt p wR wU wR
repository Tree IO
newpris
        [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Found broken patches."
        forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  Bool
bad_index <- if PrimDarcsOption UseIndex
useIndex forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts forall a. Eq a => a -> a -> Bool
== UseIndex
O.IgnoreIndex
                 then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                 else Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> Bool -> IO Bool
checkIndex Repository rt p wR wU wR
repository ([Flag] -> Bool
quiet [Flag]
opts)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
bad_index forall a b. (a -> b) -> a -> b
$ [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Bad index."
  forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ if Bool
failed Bool -> Bool -> Bool
|| Bool
bad_index then Int -> ExitCode
ExitFailure Int
1 else ExitCode
ExitSuccess

brokenPristine
  :: forall rt p wR wU wT . (RepoPatch p)
  => [DarcsFlag] -> Repository rt p wR wU wT -> Tree IO -> IO ()
brokenPristine :: forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
RepoPatch p =>
[Flag] -> Repository rt p wR wU wT -> Tree IO -> IO ()
brokenPristine [Flag]
opts Repository rt p wR wU wT
repository Tree IO
newpris = do
  [Flag] -> Doc -> IO ()
putInfo [Flag]
opts Doc
"Looks like we have a difference..."
  Maybe (Tree IO)
mc' <-
    (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> IO (Tree IO)
readRecorded Repository rt p wR wU wT
repository forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
darcsUpdateHashes))
      forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_ :: IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
  case Maybe (Tree IO)
mc' of
    Maybe (Tree IO)
Nothing -> do
      [Flag] -> Doc -> IO ()
putWarning [Flag]
opts forall a b. (a -> b) -> a -> b
$ Doc
"Unable to read the recorded state, try repair."
    Just Tree IO
mc -> do
      String -> FileType
ftf <- IO (String -> FileType)
filetypeFunction
      Sealed (FL (PrimOf p) wR wX
diff :: FL (PrimOf p) wR wR2)
        <- forall (p :: * -> * -> *) wX. FreeLeft p -> Sealed (p wX)
unFreeLeft forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) (w :: (* -> * -> *) -> *)
       (prim :: * -> * -> *).
(Monad m, Gap w, PrimPatch prim) =>
DiffAlgorithm
-> (String -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
treeDiff (PrimDarcsOption DiffAlgorithm
diffAlgorithm forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [Flag]
opts) String -> FileType
ftf Tree IO
newpris Tree IO
mc :: IO (Sealed (FL (PrimOf p) wR))
      [Flag] -> Doc -> IO ()
putInfo [Flag]
opts forall a b. (a -> b) -> a -> b
$ case FL (PrimOf p) wR wX
diff of
        FL (PrimOf p) wR wX
NilFL -> Doc
"Nothing"
        FL (PrimOf p) wR wX
patch -> forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch FL (PrimOf p) wR wX
patch