split remaining assistant types

This commit is contained in:
Joey Hess 2012-10-30 14:34:48 -04:00
parent f78ca9bc58
commit 68118b8986
19 changed files with 192 additions and 146 deletions

View file

@ -0,0 +1,21 @@
{- git-annex assistant named threads.
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Assistant.Types.NamedThread where
import Common.Annex
import Assistant.Monad
import System.Log.Logger
type ThreadName = String
data NamedThread = NamedThread ThreadName (Assistant ())
debug :: [String] -> Assistant ()
debug ws = do
name <- getAssistant threadName
liftIO $ debugM name $ unwords $ (name ++ ":") : ws

View file

@ -0,0 +1,29 @@
{- git-annex assistant pending transfer queue
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Assistant.Types.TransferQueue where
import Common.Annex
import Logs.Transfer
import Types.Remote
import Control.Concurrent.STM
data TransferQueue = TransferQueue
{ queuesize :: TVar Int
, queuelist :: TVar [(Transfer, TransferInfo)]
, deferreddownloads :: TVar [(Key, AssociatedFile)]
}
data Schedule = Next | Later
deriving (Eq)
newTransferQueue :: IO TransferQueue
newTransferQueue = atomically $ TransferQueue
<$> newTVar 0
<*> newTVar []
<*> newTVar []

View file

@ -0,0 +1,40 @@
{- git-annex assistant transfer slots
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE DeriveDataTypeable #-}
module Assistant.Types.TransferSlots where
import Assistant.Types.DaemonStatus
import Logs.Transfer
import qualified Control.Exception as E
import qualified Control.Concurrent.MSemN as MSemN
import Data.Typeable
type TransferSlots = MSemN.MSemN Int
{- A special exception that can be thrown to pause or resume a transfer, while
- keeping its slot in use. -}
data TransferException = PauseTransfer | ResumeTransfer
deriving (Show, Eq, Typeable)
instance E.Exception TransferException
type TransferSlotRunner = DaemonStatusHandle -> TransferSlots -> TransferGenerator -> IO ()
type TransferGenerator = IO (Maybe (Transfer, TransferInfo, IO ()))
{- Number of concurrent transfers allowed to be run from the assistant.
-
- Transfers launched by other means, including by remote assistants,
- do not currently take up slots.
-}
numSlots :: Int
numSlots = 1
newTransferSlots :: IO TransferSlots
newTransferSlots = MSemN.new numSlots