split remaining assistant types
This commit is contained in:
parent
f78ca9bc58
commit
68118b8986
19 changed files with 192 additions and 146 deletions
21
Assistant/Types/NamedThread.hs
Normal file
21
Assistant/Types/NamedThread.hs
Normal 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
|
29
Assistant/Types/TransferQueue.hs
Normal file
29
Assistant/Types/TransferQueue.hs
Normal 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 []
|
40
Assistant/Types/TransferSlots.hs
Normal file
40
Assistant/Types/TransferSlots.hs
Normal 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
|
Loading…
Add table
Add a link
Reference in a new issue