-- Copyright (C) 2002-2005,2007 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.

{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Darcs.Repository.ApplyPatches
    ( runTolerantly
    , runSilently
    , DefaultIO, runDefault
    ) where

import Control.Exception ( IOException, SomeException, catch )
import Control.Monad ( unless )
import Control.Monad.Catch ( MonadThrow )
import qualified Data.ByteString as B ( empty, null, readFile )
import Data.Char ( toLower )
import Data.List ( isSuffixOf )
import System.Directory
    ( createDirectory
    , doesDirectoryExist
    , doesFileExist
    , removeDirectory
    , removeFile
    , renamePath
    )
import System.IO ( hPutStrLn, stderr )
import System.IO.Error
    ( catchIOError
    , isAlreadyExistsError
    , isDoesNotExistError
    , isPermissionError
    )

import Darcs.Prelude

import Darcs.Patch.ApplyMonad ( ApplyMonad(..), ApplyMonadTree(..) )
import Darcs.Repository.Prefs ( changePrefval )
import Darcs.Util.Exception ( prettyException )
import Darcs.Util.File ( backupByCopying, backupByRenaming )
import Darcs.Util.Lock ( writeAtomicFilePS )
import Darcs.Util.Path ( AnchoredPath, realPath )
import Darcs.Util.Tree ( Tree )

newtype DefaultIO a = DefaultIO { forall a. DefaultIO a -> IO a
runDefaultIO :: IO a }
    deriving ((forall a b. (a -> b) -> DefaultIO a -> DefaultIO b)
-> (forall a b. a -> DefaultIO b -> DefaultIO a)
-> Functor DefaultIO
forall a b. a -> DefaultIO b -> DefaultIO a
forall a b. (a -> b) -> DefaultIO a -> DefaultIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> DefaultIO a -> DefaultIO b
fmap :: forall a b. (a -> b) -> DefaultIO a -> DefaultIO b
$c<$ :: forall a b. a -> DefaultIO b -> DefaultIO a
<$ :: forall a b. a -> DefaultIO b -> DefaultIO a
Functor, Functor DefaultIO
Functor DefaultIO =>
(forall a. a -> DefaultIO a)
-> (forall a b. DefaultIO (a -> b) -> DefaultIO a -> DefaultIO b)
-> (forall a b c.
    (a -> b -> c) -> DefaultIO a -> DefaultIO b -> DefaultIO c)
-> (forall a b. DefaultIO a -> DefaultIO b -> DefaultIO b)
-> (forall a b. DefaultIO a -> DefaultIO b -> DefaultIO a)
-> Applicative DefaultIO
forall a. a -> DefaultIO a
forall a b. DefaultIO a -> DefaultIO b -> DefaultIO a
forall a b. DefaultIO a -> DefaultIO b -> DefaultIO b
forall a b. DefaultIO (a -> b) -> DefaultIO a -> DefaultIO b
forall a b c.
(a -> b -> c) -> DefaultIO a -> DefaultIO b -> DefaultIO c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> DefaultIO a
pure :: forall a. a -> DefaultIO a
$c<*> :: forall a b. DefaultIO (a -> b) -> DefaultIO a -> DefaultIO b
<*> :: forall a b. DefaultIO (a -> b) -> DefaultIO a -> DefaultIO b
$cliftA2 :: forall a b c.
(a -> b -> c) -> DefaultIO a -> DefaultIO b -> DefaultIO c
liftA2 :: forall a b c.
(a -> b -> c) -> DefaultIO a -> DefaultIO b -> DefaultIO c
$c*> :: forall a b. DefaultIO a -> DefaultIO b -> DefaultIO b
*> :: forall a b. DefaultIO a -> DefaultIO b -> DefaultIO b
$c<* :: forall a b. DefaultIO a -> DefaultIO b -> DefaultIO a
<* :: forall a b. DefaultIO a -> DefaultIO b -> DefaultIO a
Applicative, Applicative DefaultIO
Applicative DefaultIO =>
(forall a b. DefaultIO a -> (a -> DefaultIO b) -> DefaultIO b)
-> (forall a b. DefaultIO a -> DefaultIO b -> DefaultIO b)
-> (forall a. a -> DefaultIO a)
-> Monad DefaultIO
forall a. a -> DefaultIO a
forall a b. DefaultIO a -> DefaultIO b -> DefaultIO b
forall a b. DefaultIO a -> (a -> DefaultIO b) -> DefaultIO b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. DefaultIO a -> (a -> DefaultIO b) -> DefaultIO b
>>= :: forall a b. DefaultIO a -> (a -> DefaultIO b) -> DefaultIO b
$c>> :: forall a b. DefaultIO a -> DefaultIO b -> DefaultIO b
>> :: forall a b. DefaultIO a -> DefaultIO b -> DefaultIO b
$creturn :: forall a. a -> DefaultIO a
return :: forall a. a -> DefaultIO a
Monad, Monad DefaultIO
Monad DefaultIO =>
(forall e a. (HasCallStack, Exception e) => e -> DefaultIO a)
-> MonadThrow DefaultIO
forall e a. (HasCallStack, Exception e) => e -> DefaultIO a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> DefaultIO a
throwM :: forall e a. (HasCallStack, Exception e) => e -> DefaultIO a
MonadThrow)

instance ApplyMonad Tree DefaultIO where

instance ApplyMonadTree DefaultIO where
    mDoesDirectoryExist :: AnchoredPath -> DefaultIO Bool
mDoesDirectoryExist = IO Bool -> DefaultIO Bool
forall a. IO a -> DefaultIO a
DefaultIO (IO Bool -> DefaultIO Bool)
-> (AnchoredPath -> IO Bool) -> AnchoredPath -> DefaultIO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesDirectoryExist (String -> IO Bool)
-> (AnchoredPath -> String) -> AnchoredPath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> String
realPath
    mChangePref :: String -> String -> String -> DefaultIO ()
mChangePref String
a String
b String
c = IO () -> DefaultIO ()
forall a. IO a -> DefaultIO a
DefaultIO (IO () -> DefaultIO ()) -> IO () -> DefaultIO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> IO ()
changePrefval String
a String
b String
c
    mModifyFilePS :: AnchoredPath
-> (ByteString -> DefaultIO ByteString) -> DefaultIO ()
mModifyFilePS AnchoredPath
f ByteString -> DefaultIO ByteString
j = IO () -> DefaultIO ()
forall a. IO a -> DefaultIO a
DefaultIO (IO () -> DefaultIO ()) -> IO () -> DefaultIO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
B.readFile (AnchoredPath -> String
realPath AnchoredPath
f) IO ByteString -> (ByteString -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DefaultIO ByteString -> IO ByteString
forall a. DefaultIO a -> IO a
runDefaultIO (DefaultIO ByteString -> IO ByteString)
-> (ByteString -> DefaultIO ByteString)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DefaultIO ByteString
j IO ByteString -> (ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeAtomicFilePS (AnchoredPath -> String
realPath AnchoredPath
f)
    mCreateDirectory :: AnchoredPath -> DefaultIO ()
mCreateDirectory = IO () -> DefaultIO ()
forall a. IO a -> DefaultIO a
DefaultIO (IO () -> DefaultIO ())
-> (AnchoredPath -> IO ()) -> AnchoredPath -> DefaultIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
createDirectory (String -> IO ())
-> (AnchoredPath -> String) -> AnchoredPath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> String
realPath
    mCreateFile :: AnchoredPath -> DefaultIO ()
mCreateFile AnchoredPath
f = IO () -> DefaultIO ()
forall a. IO a -> DefaultIO a
DefaultIO (IO () -> DefaultIO ()) -> IO () -> DefaultIO ()
forall a b. (a -> b) -> a -> b
$
                    do Bool
exf <- String -> IO Bool
doesFileExist (AnchoredPath -> String
realPath AnchoredPath
f)
                       if Bool
exf then String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"File '"String -> String -> String
forall a. [a] -> [a] -> [a]
++AnchoredPath -> String
realPath AnchoredPath
fString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"' already exists!"
                              else do Bool
exd <- String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> String
realPath AnchoredPath
f
                                      if Bool
exd then String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"File '"String -> String -> String
forall a. [a] -> [a] -> [a]
++AnchoredPath -> String
realPath AnchoredPath
fString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"' already exists!"
                                             else String -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeAtomicFilePS (AnchoredPath -> String
realPath AnchoredPath
f) ByteString
B.empty
    mRemoveFile :: AnchoredPath -> DefaultIO ()
mRemoveFile AnchoredPath
f = IO () -> DefaultIO ()
forall a. IO a -> DefaultIO a
DefaultIO (IO () -> DefaultIO ()) -> IO () -> DefaultIO ()
forall a b. (a -> b) -> a -> b
$
                    do let fp :: String
fp = AnchoredPath -> String
realPath AnchoredPath
f
                       ByteString
x <- String -> IO ByteString
B.readFile String
fp
                       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
x) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                            String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Cannot remove non-empty file "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fp
                       String -> IO ()
removeFile String
fp
    mRemoveDirectory :: AnchoredPath -> DefaultIO ()
mRemoveDirectory = IO () -> DefaultIO ()
forall a. IO a -> DefaultIO a
DefaultIO (IO () -> DefaultIO ())
-> (AnchoredPath -> IO ()) -> AnchoredPath -> DefaultIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
removeDirectory (String -> IO ())
-> (AnchoredPath -> String) -> AnchoredPath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredPath -> String
realPath
    mRename :: AnchoredPath -> AnchoredPath -> DefaultIO ()
mRename AnchoredPath
a AnchoredPath
b = IO () -> DefaultIO ()
forall a. IO a -> DefaultIO a
DefaultIO (IO () -> DefaultIO ()) -> IO () -> DefaultIO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
renamePath String
x String
y
      where x :: String
x = AnchoredPath -> String
realPath AnchoredPath
a
            y :: String
y = AnchoredPath -> String
realPath AnchoredPath
b

class (Functor m, MonadThrow m) => TolerantMonad m where
    warning :: IO () -> m ()
    runIO :: m a -> IO a
    runTM :: IO a -> m a

newtype TolerantIO a = TIO { forall a. TolerantIO a -> IO a
runTIO :: IO a }
    deriving ((forall a b. (a -> b) -> TolerantIO a -> TolerantIO b)
-> (forall a b. a -> TolerantIO b -> TolerantIO a)
-> Functor TolerantIO
forall a b. a -> TolerantIO b -> TolerantIO a
forall a b. (a -> b) -> TolerantIO a -> TolerantIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TolerantIO a -> TolerantIO b
fmap :: forall a b. (a -> b) -> TolerantIO a -> TolerantIO b
$c<$ :: forall a b. a -> TolerantIO b -> TolerantIO a
<$ :: forall a b. a -> TolerantIO b -> TolerantIO a
Functor, Functor TolerantIO
Functor TolerantIO =>
(forall a. a -> TolerantIO a)
-> (forall a b.
    TolerantIO (a -> b) -> TolerantIO a -> TolerantIO b)
-> (forall a b c.
    (a -> b -> c) -> TolerantIO a -> TolerantIO b -> TolerantIO c)
-> (forall a b. TolerantIO a -> TolerantIO b -> TolerantIO b)
-> (forall a b. TolerantIO a -> TolerantIO b -> TolerantIO a)
-> Applicative TolerantIO
forall a. a -> TolerantIO a
forall a b. TolerantIO a -> TolerantIO b -> TolerantIO a
forall a b. TolerantIO a -> TolerantIO b -> TolerantIO b
forall a b. TolerantIO (a -> b) -> TolerantIO a -> TolerantIO b
forall a b c.
(a -> b -> c) -> TolerantIO a -> TolerantIO b -> TolerantIO c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> TolerantIO a
pure :: forall a. a -> TolerantIO a
$c<*> :: forall a b. TolerantIO (a -> b) -> TolerantIO a -> TolerantIO b
<*> :: forall a b. TolerantIO (a -> b) -> TolerantIO a -> TolerantIO b
$cliftA2 :: forall a b c.
(a -> b -> c) -> TolerantIO a -> TolerantIO b -> TolerantIO c
liftA2 :: forall a b c.
(a -> b -> c) -> TolerantIO a -> TolerantIO b -> TolerantIO c
$c*> :: forall a b. TolerantIO a -> TolerantIO b -> TolerantIO b
*> :: forall a b. TolerantIO a -> TolerantIO b -> TolerantIO b
$c<* :: forall a b. TolerantIO a -> TolerantIO b -> TolerantIO a
<* :: forall a b. TolerantIO a -> TolerantIO b -> TolerantIO a
Applicative, Applicative TolerantIO
Applicative TolerantIO =>
(forall a b. TolerantIO a -> (a -> TolerantIO b) -> TolerantIO b)
-> (forall a b. TolerantIO a -> TolerantIO b -> TolerantIO b)
-> (forall a. a -> TolerantIO a)
-> Monad TolerantIO
forall a. a -> TolerantIO a
forall a b. TolerantIO a -> TolerantIO b -> TolerantIO b
forall a b. TolerantIO a -> (a -> TolerantIO b) -> TolerantIO b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. TolerantIO a -> (a -> TolerantIO b) -> TolerantIO b
>>= :: forall a b. TolerantIO a -> (a -> TolerantIO b) -> TolerantIO b
$c>> :: forall a b. TolerantIO a -> TolerantIO b -> TolerantIO b
>> :: forall a b. TolerantIO a -> TolerantIO b -> TolerantIO b
$creturn :: forall a. a -> TolerantIO a
return :: forall a. a -> TolerantIO a
Monad, Monad TolerantIO
Monad TolerantIO =>
(forall e a. (HasCallStack, Exception e) => e -> TolerantIO a)
-> MonadThrow TolerantIO
forall e a. (HasCallStack, Exception e) => e -> TolerantIO a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> TolerantIO a
throwM :: forall e a. (HasCallStack, Exception e) => e -> TolerantIO a
MonadThrow)

instance TolerantMonad TolerantIO where
    warning :: IO () -> TolerantIO ()
warning IO ()
io = IO () -> TolerantIO ()
forall a. IO a -> TolerantIO a
TIO (IO () -> TolerantIO ()) -> IO () -> TolerantIO ()
forall a b. (a -> b) -> a -> b
$ IO ()
io IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Warning: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
prettyException SomeException
e
    runIO :: forall a. TolerantIO a -> IO a
runIO (TIO IO a
io) = IO a
io
    runTM :: forall a. IO a -> TolerantIO a
runTM = IO a -> TolerantIO a
forall a. IO a -> TolerantIO a
TIO

newtype SilentIO a = SIO { forall a. SilentIO a -> IO a
runSIO :: IO a }
    deriving ((forall a b. (a -> b) -> SilentIO a -> SilentIO b)
-> (forall a b. a -> SilentIO b -> SilentIO a) -> Functor SilentIO
forall a b. a -> SilentIO b -> SilentIO a
forall a b. (a -> b) -> SilentIO a -> SilentIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SilentIO a -> SilentIO b
fmap :: forall a b. (a -> b) -> SilentIO a -> SilentIO b
$c<$ :: forall a b. a -> SilentIO b -> SilentIO a
<$ :: forall a b. a -> SilentIO b -> SilentIO a
Functor, Functor SilentIO
Functor SilentIO =>
(forall a. a -> SilentIO a)
-> (forall a b. SilentIO (a -> b) -> SilentIO a -> SilentIO b)
-> (forall a b c.
    (a -> b -> c) -> SilentIO a -> SilentIO b -> SilentIO c)
-> (forall a b. SilentIO a -> SilentIO b -> SilentIO b)
-> (forall a b. SilentIO a -> SilentIO b -> SilentIO a)
-> Applicative SilentIO
forall a. a -> SilentIO a
forall a b. SilentIO a -> SilentIO b -> SilentIO a
forall a b. SilentIO a -> SilentIO b -> SilentIO b
forall a b. SilentIO (a -> b) -> SilentIO a -> SilentIO b
forall a b c.
(a -> b -> c) -> SilentIO a -> SilentIO b -> SilentIO c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> SilentIO a
pure :: forall a. a -> SilentIO a
$c<*> :: forall a b. SilentIO (a -> b) -> SilentIO a -> SilentIO b
<*> :: forall a b. SilentIO (a -> b) -> SilentIO a -> SilentIO b
$cliftA2 :: forall a b c.
(a -> b -> c) -> SilentIO a -> SilentIO b -> SilentIO c
liftA2 :: forall a b c.
(a -> b -> c) -> SilentIO a -> SilentIO b -> SilentIO c
$c*> :: forall a b. SilentIO a -> SilentIO b -> SilentIO b
*> :: forall a b. SilentIO a -> SilentIO b -> SilentIO b
$c<* :: forall a b. SilentIO a -> SilentIO b -> SilentIO a
<* :: forall a b. SilentIO a -> SilentIO b -> SilentIO a
Applicative, Applicative SilentIO
Applicative SilentIO =>
(forall a b. SilentIO a -> (a -> SilentIO b) -> SilentIO b)
-> (forall a b. SilentIO a -> SilentIO b -> SilentIO b)
-> (forall a. a -> SilentIO a)
-> Monad SilentIO
forall a. a -> SilentIO a
forall a b. SilentIO a -> SilentIO b -> SilentIO b
forall a b. SilentIO a -> (a -> SilentIO b) -> SilentIO b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. SilentIO a -> (a -> SilentIO b) -> SilentIO b
>>= :: forall a b. SilentIO a -> (a -> SilentIO b) -> SilentIO b
$c>> :: forall a b. SilentIO a -> SilentIO b -> SilentIO b
>> :: forall a b. SilentIO a -> SilentIO b -> SilentIO b
$creturn :: forall a. a -> SilentIO a
return :: forall a. a -> SilentIO a
Monad, Monad SilentIO
Monad SilentIO =>
(forall e a. (HasCallStack, Exception e) => e -> SilentIO a)
-> MonadThrow SilentIO
forall e a. (HasCallStack, Exception e) => e -> SilentIO a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> SilentIO a
throwM :: forall e a. (HasCallStack, Exception e) => e -> SilentIO a
MonadThrow)

instance TolerantMonad SilentIO where
    warning :: IO () -> SilentIO ()
warning IO ()
io = IO () -> SilentIO ()
forall a. IO a -> SilentIO a
SIO (IO () -> SilentIO ()) -> IO () -> SilentIO ()
forall a b. (a -> b) -> a -> b
$ IO ()
io IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
_ :: SomeException) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    runIO :: forall a. SilentIO a -> IO a
runIO (SIO IO a
io) = IO a
io
    runTM :: forall a. IO a -> SilentIO a
runTM = IO a -> SilentIO a
forall a. IO a -> SilentIO a
SIO

newtype TolerantWrapper m a = TolerantWrapper { forall (m :: * -> *) a. TolerantWrapper m a -> m a
runTolerantWrapper :: m a }
    deriving ((forall a b.
 (a -> b) -> TolerantWrapper m a -> TolerantWrapper m b)
-> (forall a b. a -> TolerantWrapper m b -> TolerantWrapper m a)
-> Functor (TolerantWrapper m)
forall a b. a -> TolerantWrapper m b -> TolerantWrapper m a
forall a b. (a -> b) -> TolerantWrapper m a -> TolerantWrapper m b
forall (m :: * -> *) a b.
Functor m =>
a -> TolerantWrapper m b -> TolerantWrapper m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TolerantWrapper m a -> TolerantWrapper m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TolerantWrapper m a -> TolerantWrapper m b
fmap :: forall a b. (a -> b) -> TolerantWrapper m a -> TolerantWrapper m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> TolerantWrapper m b -> TolerantWrapper m a
<$ :: forall a b. a -> TolerantWrapper m b -> TolerantWrapper m a
Functor, Functor (TolerantWrapper m)
Functor (TolerantWrapper m) =>
(forall a. a -> TolerantWrapper m a)
-> (forall a b.
    TolerantWrapper m (a -> b)
    -> TolerantWrapper m a -> TolerantWrapper m b)
-> (forall a b c.
    (a -> b -> c)
    -> TolerantWrapper m a
    -> TolerantWrapper m b
    -> TolerantWrapper m c)
-> (forall a b.
    TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b)
-> (forall a b.
    TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m a)
-> Applicative (TolerantWrapper m)
forall a. a -> TolerantWrapper m a
forall a b.
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m a
forall a b.
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b
forall a b.
TolerantWrapper m (a -> b)
-> TolerantWrapper m a -> TolerantWrapper m b
forall a b c.
(a -> b -> c)
-> TolerantWrapper m a
-> TolerantWrapper m b
-> TolerantWrapper m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (TolerantWrapper m)
forall (m :: * -> *) a. Applicative m => a -> TolerantWrapper m a
forall (m :: * -> *) a b.
Applicative m =>
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m a
forall (m :: * -> *) a b.
Applicative m =>
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b
forall (m :: * -> *) a b.
Applicative m =>
TolerantWrapper m (a -> b)
-> TolerantWrapper m a -> TolerantWrapper m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> TolerantWrapper m a
-> TolerantWrapper m b
-> TolerantWrapper m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> TolerantWrapper m a
pure :: forall a. a -> TolerantWrapper m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
TolerantWrapper m (a -> b)
-> TolerantWrapper m a -> TolerantWrapper m b
<*> :: forall a b.
TolerantWrapper m (a -> b)
-> TolerantWrapper m a -> TolerantWrapper m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> TolerantWrapper m a
-> TolerantWrapper m b
-> TolerantWrapper m c
liftA2 :: forall a b c.
(a -> b -> c)
-> TolerantWrapper m a
-> TolerantWrapper m b
-> TolerantWrapper m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b
*> :: forall a b.
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m a
<* :: forall a b.
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m a
Applicative, Applicative (TolerantWrapper m)
Applicative (TolerantWrapper m) =>
(forall a b.
 TolerantWrapper m a
 -> (a -> TolerantWrapper m b) -> TolerantWrapper m b)
-> (forall a b.
    TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b)
-> (forall a. a -> TolerantWrapper m a)
-> Monad (TolerantWrapper m)
forall a. a -> TolerantWrapper m a
forall a b.
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b
forall a b.
TolerantWrapper m a
-> (a -> TolerantWrapper m b) -> TolerantWrapper m b
forall (m :: * -> *). Monad m => Applicative (TolerantWrapper m)
forall (m :: * -> *) a. Monad m => a -> TolerantWrapper m a
forall (m :: * -> *) a b.
Monad m =>
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b
forall (m :: * -> *) a b.
Monad m =>
TolerantWrapper m a
-> (a -> TolerantWrapper m b) -> TolerantWrapper m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
TolerantWrapper m a
-> (a -> TolerantWrapper m b) -> TolerantWrapper m b
>>= :: forall a b.
TolerantWrapper m a
-> (a -> TolerantWrapper m b) -> TolerantWrapper m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b
>> :: forall a b.
TolerantWrapper m a -> TolerantWrapper m b -> TolerantWrapper m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> TolerantWrapper m a
return :: forall a. a -> TolerantWrapper m a
Monad, Functor (TolerantWrapper m)
MonadThrow (TolerantWrapper m)
(Functor (TolerantWrapper m), MonadThrow (TolerantWrapper m)) =>
(IO () -> TolerantWrapper m ())
-> (forall a. TolerantWrapper m a -> IO a)
-> (forall a. IO a -> TolerantWrapper m a)
-> TolerantMonad (TolerantWrapper m)
IO () -> TolerantWrapper m ()
forall a. IO a -> TolerantWrapper m a
forall a. TolerantWrapper m a -> IO a
forall (m :: * -> *).
(Functor m, MonadThrow m) =>
(IO () -> m ())
-> (forall a. m a -> IO a)
-> (forall a. IO a -> m a)
-> TolerantMonad m
forall (m :: * -> *).
TolerantMonad m =>
Functor (TolerantWrapper m)
forall (m :: * -> *).
TolerantMonad m =>
MonadThrow (TolerantWrapper m)
forall (m :: * -> *).
TolerantMonad m =>
IO () -> TolerantWrapper m ()
forall (m :: * -> *) a.
TolerantMonad m =>
IO a -> TolerantWrapper m a
forall (m :: * -> *) a.
TolerantMonad m =>
TolerantWrapper m a -> IO a
$cwarning :: forall (m :: * -> *).
TolerantMonad m =>
IO () -> TolerantWrapper m ()
warning :: IO () -> TolerantWrapper m ()
$crunIO :: forall (m :: * -> *) a.
TolerantMonad m =>
TolerantWrapper m a -> IO a
runIO :: forall a. TolerantWrapper m a -> IO a
$crunTM :: forall (m :: * -> *) a.
TolerantMonad m =>
IO a -> TolerantWrapper m a
runTM :: forall a. IO a -> TolerantWrapper m a
TolerantMonad)

deriving instance MonadThrow m => MonadThrow (TolerantWrapper m)

-- | Apply patches, emitting warnings if there are any IO errors
runTolerantly :: TolerantWrapper TolerantIO a -> IO a
runTolerantly :: forall a. TolerantWrapper TolerantIO a -> IO a
runTolerantly = TolerantIO a -> IO a
forall a. TolerantIO a -> IO a
runTIO (TolerantIO a -> IO a)
-> (TolerantWrapper TolerantIO a -> TolerantIO a)
-> TolerantWrapper TolerantIO a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TolerantWrapper TolerantIO a -> TolerantIO a
forall (m :: * -> *) a. TolerantWrapper m a -> m a
runTolerantWrapper

-- | Apply patches, ignoring all errors
runSilently :: TolerantWrapper SilentIO a -> IO a
runSilently :: forall a. TolerantWrapper SilentIO a -> IO a
runSilently = SilentIO a -> IO a
forall a. SilentIO a -> IO a
runSIO (SilentIO a -> IO a)
-> (TolerantWrapper SilentIO a -> SilentIO a)
-> TolerantWrapper SilentIO a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TolerantWrapper SilentIO a -> SilentIO a
forall (m :: * -> *) a. TolerantWrapper m a -> m a
runTolerantWrapper

-- | The default mode of applying patches: fail if the directory is not
-- as we expect
runDefault :: DefaultIO a -> IO a
runDefault :: forall a. DefaultIO a -> IO a
runDefault DefaultIO a
action =
  IO a -> (IOError -> IO a) -> IO a
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (DefaultIO a -> IO a
forall a. DefaultIO a -> IO a
runDefaultIO DefaultIO a
action) ((IOError -> IO a) -> IO a) -> (IOError -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \IOError
e ->
    String -> IO a
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"Cannot apply some patch:\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++IOError -> String
forall a. Show a => a -> String
show IOError
eString -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"\nYou may want to run 'darcs check' to find out if there are broken"String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"\npatches in your repo, and perhaps 'darcs repair' to fix them."

instance TolerantMonad m => ApplyMonad Tree (TolerantWrapper m) where

instance TolerantMonad m => ApplyMonadTree (TolerantWrapper m) where
    mDoesDirectoryExist :: AnchoredPath -> TolerantWrapper m Bool
mDoesDirectoryExist AnchoredPath
d = IO Bool -> TolerantWrapper m Bool
forall a. IO a -> TolerantWrapper m a
forall (m :: * -> *) a. TolerantMonad m => IO a -> m a
runTM (IO Bool -> TolerantWrapper m Bool)
-> IO Bool -> TolerantWrapper m Bool
forall a b. (a -> b) -> a -> b
$ DefaultIO Bool -> IO Bool
forall a. DefaultIO a -> IO a
runDefaultIO (DefaultIO Bool -> IO Bool) -> DefaultIO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> DefaultIO Bool
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m Bool
mDoesDirectoryExist AnchoredPath
d
    mReadFilePS :: AnchoredPath -> TolerantWrapper m ByteString
mReadFilePS AnchoredPath
f = IO ByteString -> TolerantWrapper m ByteString
forall a. IO a -> TolerantWrapper m a
forall (m :: * -> *) a. TolerantMonad m => IO a -> m a
runTM (IO ByteString -> TolerantWrapper m ByteString)
-> IO ByteString -> TolerantWrapper m ByteString
forall a b. (a -> b) -> a -> b
$ DefaultIO ByteString -> IO ByteString
forall a. DefaultIO a -> IO a
runDefaultIO (DefaultIO ByteString -> IO ByteString)
-> DefaultIO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> DefaultIO ByteString
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> m ByteString
mReadFilePS AnchoredPath
f
    mChangePref :: String -> String -> String -> TolerantWrapper m ()
mChangePref String
a String
b String
c = IO () -> TolerantWrapper m ()
forall (m :: * -> *). TolerantMonad m => IO () -> m ()
warning (IO () -> TolerantWrapper m ()) -> IO () -> TolerantWrapper m ()
forall a b. (a -> b) -> a -> b
$ DefaultIO () -> IO ()
forall a. DefaultIO a -> IO a
runDefaultIO (DefaultIO () -> IO ()) -> DefaultIO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> DefaultIO ()
forall (m :: * -> *).
ApplyMonadTree m =>
String -> String -> String -> m ()
mChangePref String
a String
b String
c
    mModifyFilePS :: AnchoredPath
-> (ByteString -> TolerantWrapper m ByteString)
-> TolerantWrapper m ()
mModifyFilePS AnchoredPath
f ByteString -> TolerantWrapper m ByteString
j = IO () -> TolerantWrapper m ()
forall (m :: * -> *). TolerantMonad m => IO () -> m ()
warning (IO () -> TolerantWrapper m ()) -> IO () -> TolerantWrapper m ()
forall a b. (a -> b) -> a -> b
$ DefaultIO () -> IO ()
forall a. DefaultIO a -> IO a
runDefaultIO (DefaultIO () -> IO ()) -> DefaultIO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AnchoredPath
-> (ByteString -> DefaultIO ByteString) -> DefaultIO ()
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> (ByteString -> m ByteString) -> m ()
mModifyFilePS AnchoredPath
f (IO ByteString -> DefaultIO ByteString
forall a. IO a -> DefaultIO a
DefaultIO (IO ByteString -> DefaultIO ByteString)
-> (ByteString -> IO ByteString)
-> ByteString
-> DefaultIO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TolerantWrapper m ByteString -> IO ByteString
forall a. TolerantWrapper m a -> IO a
forall (m :: * -> *) a. TolerantMonad m => m a -> IO a
runIO (TolerantWrapper m ByteString -> IO ByteString)
-> (ByteString -> TolerantWrapper m ByteString)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> TolerantWrapper m ByteString
j)
    mCreateFile :: AnchoredPath -> TolerantWrapper m ()
mCreateFile AnchoredPath
f = IO () -> TolerantWrapper m ()
forall (m :: * -> *). TolerantMonad m => IO () -> m ()
warning (IO () -> TolerantWrapper m ()) -> IO () -> TolerantWrapper m ()
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> IO ()
backup AnchoredPath
f IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DefaultIO () -> IO ()
forall a. DefaultIO a -> IO a
runDefaultIO (AnchoredPath -> DefaultIO ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mCreateFile AnchoredPath
f)
    mCreateDirectory :: AnchoredPath -> TolerantWrapper m ()
mCreateDirectory AnchoredPath
d = IO () -> TolerantWrapper m ()
forall (m :: * -> *). TolerantMonad m => IO () -> m ()
warning (IO () -> TolerantWrapper m ()) -> IO () -> TolerantWrapper m ()
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> IO ()
backup AnchoredPath
d IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DefaultIO () -> IO ()
forall a. DefaultIO a -> IO a
runDefaultIO (AnchoredPath -> DefaultIO ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mCreateDirectory AnchoredPath
d)
    mRemoveFile :: AnchoredPath -> TolerantWrapper m ()
mRemoveFile AnchoredPath
f = IO () -> TolerantWrapper m ()
forall (m :: * -> *). TolerantMonad m => IO () -> m ()
warning (IO () -> TolerantWrapper m ()) -> IO () -> TolerantWrapper m ()
forall a b. (a -> b) -> a -> b
$ DefaultIO () -> IO ()
forall a. DefaultIO a -> IO a
runDefaultIO (AnchoredPath -> DefaultIO ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mRemoveFile AnchoredPath
f)
    mRemoveDirectory :: AnchoredPath -> TolerantWrapper m ()
mRemoveDirectory AnchoredPath
d = IO () -> TolerantWrapper m ()
forall (m :: * -> *). TolerantMonad m => IO () -> m ()
warning (IO () -> TolerantWrapper m ()) -> IO () -> TolerantWrapper m ()
forall a b. (a -> b) -> a -> b
$ IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
                                 (DefaultIO () -> IO ()
forall a. DefaultIO a -> IO a
runDefaultIO (AnchoredPath -> DefaultIO ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mRemoveDirectory AnchoredPath
d))
                                 (\(IOError
e :: IOException) ->
                                   if String
"(Directory not empty)" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` IOError -> String
forall a. Show a => a -> String
show IOError
e
                                   then IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
                                            String
"Not deleting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
realPath AnchoredPath
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" because it is not empty."
                                   else IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
                                            String
"Not deleting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
realPath AnchoredPath
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" because:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOError -> String
forall a. Show a => a -> String
show IOError
e)
    mRename :: AnchoredPath -> AnchoredPath -> TolerantWrapper m ()
mRename AnchoredPath
a AnchoredPath
b = IO () -> TolerantWrapper m ()
forall (m :: * -> *). TolerantMonad m => IO () -> m ()
warning (IO () -> TolerantWrapper m ()) -> IO () -> TolerantWrapper m ()
forall a b. (a -> b) -> a -> b
$ IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
                          (let do_backup :: IO ()
do_backup = if (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
y
                                           then String -> IO ()
backupByCopying (AnchoredPath -> String
realPath AnchoredPath
b) -- avoid making the original vanish
                                           else String -> IO ()
backupByRenaming (AnchoredPath -> String
realPath AnchoredPath
b)
                           in IO ()
do_backup IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DefaultIO () -> IO ()
forall a. DefaultIO a -> IO a
runDefaultIO (AnchoredPath -> AnchoredPath -> DefaultIO ()
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> AnchoredPath -> m ()
mRename AnchoredPath
a AnchoredPath
b))
                          (\IOError
e -> case () of
                                 ()
_ | IOError -> Bool
isPermissionError IOError
e -> IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
                                       String
couldNotRename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
                                   | IOError -> Bool
isDoesNotExistError IOError
e -> IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
                                       String
couldNotRename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" because " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not exist."
                                   | IOError -> Bool
isAlreadyExistsError IOError
e -> IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
                                       String
couldNotRename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" because " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" already exists."
                                   | Bool
otherwise -> IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e
                          )
       where
        x :: String
x = AnchoredPath -> String
realPath AnchoredPath
a
        y :: String
y = AnchoredPath -> String
realPath AnchoredPath
b
        couldNotRename :: String
couldNotRename = String
"Could not rename " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y

backup :: AnchoredPath -> IO ()
backup :: AnchoredPath -> IO ()
backup AnchoredPath
f = String -> IO ()
backupByRenaming (AnchoredPath -> String
realPath AnchoredPath
f)