refactor
This commit is contained in:
parent
2917b0ac41
commit
1244eb3770
2 changed files with 21 additions and 13 deletions
|
@ -641,19 +641,8 @@ rsyncOrCopyFile rsyncparams src dest p =
|
||||||
where
|
where
|
||||||
sameDeviceIds a b = (==) <$> getDeviceId a <*> getDeviceId b
|
sameDeviceIds a b = (==) <$> getDeviceId a <*> getDeviceId b
|
||||||
getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
|
getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
|
||||||
docopy = liftIO $ bracket
|
docopy = liftIO $ watchFileSize dest p $
|
||||||
(forkIO $ watchfilesize zeroBytesProcessed)
|
copyFileExternal CopyTimeStamps src dest
|
||||||
(void . tryIO . killThread)
|
|
||||||
(const $ copyFileExternal CopyTimeStamps src dest)
|
|
||||||
watchfilesize oldsz = do
|
|
||||||
threadDelay 500000 -- 0.5 seconds
|
|
||||||
v <- catchMaybeIO $ toBytesProcessed <$> getFileSize dest
|
|
||||||
case v of
|
|
||||||
Just sz
|
|
||||||
| sz /= oldsz -> do
|
|
||||||
p sz
|
|
||||||
watchfilesize sz
|
|
||||||
_ -> watchfilesize oldsz
|
|
||||||
#endif
|
#endif
|
||||||
dorsync = Ssh.rsyncHelper (Just p) $
|
dorsync = Ssh.rsyncHelper (Just p) $
|
||||||
rsyncparams ++ [File src, File dest]
|
rsyncparams ++ [File src, File dest]
|
||||||
|
|
|
@ -18,7 +18,9 @@ import Foreign.Storable (Storable(sizeOf))
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import Data.Int
|
import Data.Int
|
||||||
import Data.Bits.Utils
|
import Data.Bits.Utils
|
||||||
|
import Control.Concurrent
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
|
import Control.Monad.IO.Class (MonadIO)
|
||||||
|
|
||||||
{- An action that can be run repeatedly, updating it on the bytes processed.
|
{- An action that can be run repeatedly, updating it on the bytes processed.
|
||||||
-
|
-
|
||||||
|
@ -149,6 +151,23 @@ defaultChunkSize = 32 * k - chunkOverhead
|
||||||
k = 1024
|
k = 1024
|
||||||
chunkOverhead = 2 * sizeOf (1 :: Int) -- GHC specific
|
chunkOverhead = 2 * sizeOf (1 :: Int) -- GHC specific
|
||||||
|
|
||||||
|
{- Runs an action, watching a file as it grows and updating the meter. -}
|
||||||
|
watchFileSize :: (MonadIO m, MonadMask m) => FilePath -> MeterUpdate -> m a -> m a
|
||||||
|
watchFileSize f p a = bracket
|
||||||
|
(liftIO $ forkIO $ watcher zeroBytesProcessed)
|
||||||
|
(liftIO . void . tryIO . killThread)
|
||||||
|
(const a)
|
||||||
|
where
|
||||||
|
watcher oldsz = do
|
||||||
|
v <- catchMaybeIO $ toBytesProcessed <$> getFileSize f
|
||||||
|
newsz <- case v of
|
||||||
|
Just sz | sz /= oldsz -> do
|
||||||
|
p sz
|
||||||
|
return sz
|
||||||
|
_ -> return oldsz
|
||||||
|
threadDelay 500000 -- 0.5 seconds
|
||||||
|
watcher newsz
|
||||||
|
|
||||||
data OutputHandler = OutputHandler
|
data OutputHandler = OutputHandler
|
||||||
{ quietMode :: Bool
|
{ quietMode :: Bool
|
||||||
, stderrHandler :: String -> IO ()
|
, stderrHandler :: String -> IO ()
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue