diff options
Diffstat (limited to 'Assistant/Types')
-rw-r--r-- | Assistant/Types/NamedThread.hs | 21 | ||||
-rw-r--r-- | Assistant/Types/TransferQueue.hs | 29 | ||||
-rw-r--r-- | Assistant/Types/TransferSlots.hs | 40 |
3 files changed, 90 insertions, 0 deletions
diff --git a/Assistant/Types/NamedThread.hs b/Assistant/Types/NamedThread.hs new file mode 100644 index 000000000..569f787d1 --- /dev/null +++ b/Assistant/Types/NamedThread.hs @@ -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 diff --git a/Assistant/Types/TransferQueue.hs b/Assistant/Types/TransferQueue.hs new file mode 100644 index 000000000..6620ebdf6 --- /dev/null +++ b/Assistant/Types/TransferQueue.hs @@ -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 [] diff --git a/Assistant/Types/TransferSlots.hs b/Assistant/Types/TransferSlots.hs new file mode 100644 index 000000000..f8673fcfc --- /dev/null +++ b/Assistant/Types/TransferSlots.hs @@ -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 |