mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Assistant monad, stage 2.5

Browse source 
Converted several threads to run in the monad.

Added a lot of useful combinators for working with the monad.

Now the monad includes the name of the thread.

Some debugging messages are disabled pending converting other threads.
This commit is contained in:
Joey Hess 2012-10-29 02:21:04 -04:00
parent 4e765327ca
commit 4dbdc2b666
29 changed files with 299 additions and 280 deletions
Download patch file Download diff file Expand all files Collapse all files

6
Assistant/Threads/Transferrer.hs
View file

@ -32,7 +32,7 @@ maxTransfers = 1
{- Dispatches transfers from the queue. -}
transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> CommitChan -> NamedThread
transfererThread st dstatus transferqueue slots commitchan = thread $ go =<< readProgramFile
transfererThread st dstatus transferqueue slots commitchan = thread $ liftIO $ go =<< readProgramFile
where
thread = NamedThread thisThread
go program = forever $ inTransferSlot dstatus slots $
@ -47,11 +47,11 @@ startTransfer :: ThreadState -> DaemonStatusHandle -> CommitChan -> FilePath ->
startTransfer st dstatus commitchan program t info = case (transferRemote info, associatedFile info) of
(Just remote, Just file) -> ifM (runThreadState st $ shouldTransfer t info)
( do
debug thisThread [ "Transferring:" , show t ]
brokendebug thisThread [ "Transferring:" , show t ]
notifyTransfer dstatus
return $ Just (t, info, transferprocess remote file)
, do
debug thisThread [ "Skipping unnecessary transfer:" , show t ]
brokendebug thisThread [ "Skipping unnecessary transfer:" , show t ]
void $ removeTransfer dstatus t
return Nothing
)