tweak
This commit is contained in:
parent
1852eddce6
commit
d5a5c05a79
5 changed files with 15 additions and 13 deletions
|
@ -181,8 +181,8 @@ adjustTransfersSTM dstatus a = do
|
||||||
putTMVar dstatus $ s { currentTransfers = a (currentTransfers s) }
|
putTMVar dstatus $ s { currentTransfers = a (currentTransfers s) }
|
||||||
|
|
||||||
{- Alters a transfer's info, if the transfer is in the map. -}
|
{- Alters a transfer's info, if the transfer is in the map. -}
|
||||||
alterTransferInfo :: Transfer -> (TransferInfo -> TransferInfo) -> DaemonStatusHandle -> IO ()
|
alterTransferInfo :: DaemonStatusHandle -> Transfer -> (TransferInfo -> TransferInfo) -> IO ()
|
||||||
alterTransferInfo t a dstatus = updateTransferInfo' dstatus $ M.adjust a t
|
alterTransferInfo dstatus t a = updateTransferInfo' dstatus $ M.adjust a t
|
||||||
|
|
||||||
{- Updates a transfer's info. Adds the transfer to the map if necessary,
|
{- Updates a transfer's info. Adds the transfer to the map if necessary,
|
||||||
- or if already present, updates it while preserving the old transferTid,
|
- or if already present, updates it while preserving the old transferTid,
|
||||||
|
|
|
@ -13,6 +13,7 @@ module Assistant.Monad (
|
||||||
newAssistantData,
|
newAssistantData,
|
||||||
runAssistant,
|
runAssistant,
|
||||||
getAssistant,
|
getAssistant,
|
||||||
|
withAssistant,
|
||||||
liftAnnex,
|
liftAnnex,
|
||||||
(<~>),
|
(<~>),
|
||||||
(<<~),
|
(<<~),
|
||||||
|
@ -111,5 +112,7 @@ asIO2 a = do
|
||||||
(<<~) :: (a -> IO b) -> (AssistantData -> a) -> Assistant b
|
(<<~) :: (a -> IO b) -> (AssistantData -> a) -> Assistant b
|
||||||
io <<~ v = reader v >>= liftIO . io
|
io <<~ v = reader v >>= liftIO . io
|
||||||
|
|
||||||
|
withAssistant v io = io <<~ v
|
||||||
|
|
||||||
daemonStatus :: Assistant DaemonStatus
|
daemonStatus :: Assistant DaemonStatus
|
||||||
daemonStatus = getDaemonStatus <<~ daemonStatusHandle
|
daemonStatus = getDaemonStatus <<~ daemonStatusHandle
|
||||||
|
|
|
@ -52,6 +52,7 @@ transferPollerThread = NamedThread "TransferPoller" $ do
|
||||||
|
|
||||||
newsize t info sz
|
newsize t info sz
|
||||||
| bytesComplete info /= sz && isJust sz =
|
| bytesComplete info /= sz && isJust sz =
|
||||||
alterTransferInfo t (\i -> i { bytesComplete = sz })
|
withAssistant daemonStatusHandle $ \h ->
|
||||||
<<~ daemonStatusHandle
|
alterTransferInfo h t $
|
||||||
|
\i -> i { bytesComplete = sz }
|
||||||
| otherwise = noop
|
| otherwise = noop
|
||||||
|
|
|
@ -79,9 +79,9 @@ onModify file = do
|
||||||
Just t -> go t =<< liftIO (readTransferInfoFile Nothing file)
|
Just t -> go t =<< liftIO (readTransferInfoFile Nothing file)
|
||||||
where
|
where
|
||||||
go _ Nothing = noop
|
go _ Nothing = noop
|
||||||
go t (Just newinfo) = alterTransferInfo t
|
go t (Just newinfo) = withAssistant daemonStatusHandle $ \h ->
|
||||||
(\i -> i { bytesComplete = bytesComplete newinfo })
|
alterTransferInfo h t $
|
||||||
<<~ daemonStatusHandle
|
\i -> i { bytesComplete = bytesComplete newinfo }
|
||||||
|
|
||||||
{- This thread can only watch transfer sizes when the DirWatcher supports
|
{- This thread can only watch transfer sizes when the DirWatcher supports
|
||||||
- tracking modificatons to files. -}
|
- tracking modificatons to files. -}
|
||||||
|
|
|
@ -88,9 +88,8 @@ cancelTransfer pause t = do
|
||||||
maybe noop killproc $ transferPid info
|
maybe noop killproc $ transferPid info
|
||||||
if pause
|
if pause
|
||||||
then void $
|
then void $
|
||||||
alterTransferInfo t
|
alterTransferInfo dstatus t $
|
||||||
(\i -> i { transferPaused = True })
|
\i -> i { transferPaused = True }
|
||||||
dstatus
|
|
||||||
else void $
|
else void $
|
||||||
removeTransfer dstatus t
|
removeTransfer dstatus t
|
||||||
signalthread tid
|
signalthread tid
|
||||||
|
@ -119,9 +118,8 @@ startTransfer t = do
|
||||||
resume tid = do
|
resume tid = do
|
||||||
dstatus <- getAssistantY daemonStatusHandle
|
dstatus <- getAssistantY daemonStatusHandle
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
alterTransferInfo t
|
alterTransferInfo dstatus t $
|
||||||
(\i -> i { transferPaused = False })
|
\i -> i { transferPaused = False }
|
||||||
dstatus
|
|
||||||
throwTo tid ResumeTransfer
|
throwTo tid ResumeTransfer
|
||||||
start info = runAssistantY $ do
|
start info = runAssistantY $ do
|
||||||
program <- liftIO readProgramFile
|
program <- liftIO readProgramFile
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue