summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Assistant.hs2
-rw-r--r--Assistant/BranchChange.hs17
-rw-r--r--Assistant/Changes.hs66
-rw-r--r--Assistant/Commits.hs22
-rw-r--r--Assistant/Monad.hs11
-rw-r--r--Assistant/ScanRemotes.hs37
-rw-r--r--Assistant/Sync.hs3
-rw-r--r--Assistant/Threads/Committer.hs12
-rw-r--r--Assistant/Threads/ConfigMonitor.hs4
-rw-r--r--Assistant/Threads/Merger.hs2
-rw-r--r--Assistant/Threads/Pusher.hs5
-rw-r--r--Assistant/Threads/TransferScanner.hs8
-rw-r--r--Assistant/Threads/Transferrer.hs2
-rw-r--r--Assistant/Threads/Watcher.hs17
-rw-r--r--Assistant/Threads/WebApp.hs2
-rw-r--r--Assistant/Types/BranchChange.hs19
-rw-r--r--Assistant/Types/Changes.hs54
-rw-r--r--Assistant/Types/Commits.hs17
-rw-r--r--Assistant/Types/ScanRemotes.hs25
-rw-r--r--Assistant/Types/ThreadedMonad.hs (renamed from Assistant/ThreadedMonad.hs)2
20 files changed, 194 insertions, 133 deletions
diff --git a/Assistant.hs b/Assistant.hs
index a8cc0b62e..3ef7c9a11 100644
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -118,8 +118,8 @@
module Assistant where
import Assistant.Common
-import Assistant.ThreadedMonad
import Assistant.DaemonStatus
+import Assistant.Types.ThreadedMonad
import Assistant.Threads.DaemonStatus
import Assistant.Threads.Watcher
import Assistant.Threads.Committer
diff --git a/Assistant/BranchChange.hs b/Assistant/BranchChange.hs
index cf7080f90..c9354544a 100644
--- a/Assistant/BranchChange.hs
+++ b/Assistant/BranchChange.hs
@@ -7,16 +7,13 @@
module Assistant.BranchChange where
-import Control.Concurrent.MSampleVar
-import Common.Annex
-
-newtype BranchChangeHandle = BranchChangeHandle (MSampleVar ())
+import Assistant.Common
+import Assistant.Types.BranchChange
-newBranchChangeHandle :: IO BranchChangeHandle
-newBranchChangeHandle = BranchChangeHandle <$> newEmptySV
+import Control.Concurrent.MSampleVar
-branchChanged :: BranchChangeHandle -> IO ()
-branchChanged (BranchChangeHandle h) = writeSV h ()
+branchChanged :: Assistant ()
+branchChanged = flip writeSV () <<~ (fromBranchChangeHandle . branchChangeHandle)
-waitBranchChange :: BranchChangeHandle -> IO ()
-waitBranchChange (BranchChangeHandle h) = readSV h
+waitBranchChange :: Assistant ()
+waitBranchChange = readSV <<~ (fromBranchChangeHandle . branchChangeHandle)
diff --git a/Assistant/Changes.hs b/Assistant/Changes.hs
index b20dce09a..3d3956899 100644
--- a/Assistant/Changes.hs
+++ b/Assistant/Changes.hs
@@ -7,73 +7,33 @@
module Assistant.Changes where
-import Common.Annex
-import Types.KeySource
+import Assistant.Common
+import Assistant.Types.Changes
import Utility.TSet
import Data.Time.Clock
-data ChangeType = AddChange | LinkChange | RmChange | RmDirChange
- deriving (Show, Eq)
-
-type ChangeChan = TSet Change
-
-data Change
- = Change
- { changeTime :: UTCTime
- , changeFile :: FilePath
- , changeType :: ChangeType
- }
- | PendingAddChange
- { changeTime ::UTCTime
- , changeFile :: FilePath
- }
- | InProcessAddChange
- { changeTime ::UTCTime
- , keySource :: KeySource
- }
- deriving (Show)
-
-newChangeChan :: IO ChangeChan
-newChangeChan = newTSet
-
{- Handlers call this when they made a change that needs to get committed. -}
-madeChange :: FilePath -> ChangeType -> IO (Maybe Change)
-madeChange f t = Just <$> (Change <$> getCurrentTime <*> pure f <*> pure t)
+madeChange :: FilePath -> ChangeType -> Assistant (Maybe Change)
+madeChange f t = Just <$> (Change <$> liftIO getCurrentTime <*> pure f <*> pure t)
-noChange :: IO (Maybe Change)
+noChange :: Assistant (Maybe Change)
noChange = return Nothing
{- Indicates an add needs to be done, but has not started yet. -}
-pendingAddChange :: FilePath -> IO (Maybe Change)
-pendingAddChange f = Just <$> (PendingAddChange <$> getCurrentTime <*> pure f)
-
-isPendingAddChange :: Change -> Bool
-isPendingAddChange (PendingAddChange {}) = True
-isPendingAddChange _ = False
-
-isInProcessAddChange :: Change -> Bool
-isInProcessAddChange (InProcessAddChange {}) = True
-isInProcessAddChange _ = False
-
-finishedChange :: Change -> Change
-finishedChange c@(InProcessAddChange { keySource = ks }) = Change
- { changeTime = changeTime c
- , changeFile = keyFilename ks
- , changeType = AddChange
- }
-finishedChange c = c
+pendingAddChange :: FilePath -> Assistant (Maybe Change)
+pendingAddChange f = Just <$> (PendingAddChange <$> liftIO getCurrentTime <*> pure f)
{- Gets all unhandled changes.
- Blocks until at least one change is made. -}
-getChanges :: ChangeChan -> IO [Change]
-getChanges = getTSet
+getChanges :: Assistant [Change]
+getChanges = getTSet <<~ changeChan
{- Puts unhandled changes back into the channel.
- Note: Original order is not preserved. -}
-refillChanges :: ChangeChan -> [Change] -> IO ()
-refillChanges = putTSet
+refillChanges :: [Change] -> Assistant ()
+refillChanges cs = flip putTSet cs <<~ changeChan
{- Records a change in the channel. -}
-recordChange :: ChangeChan -> Change -> IO ()
-recordChange = putTSet1
+recordChange :: Change -> Assistant ()
+recordChange c = flip putTSet1 c <<~ changeChan
diff --git a/Assistant/Commits.hs b/Assistant/Commits.hs
index 6c27ce3cb..79555fee5 100644
--- a/Assistant/Commits.hs
+++ b/Assistant/Commits.hs
@@ -7,25 +7,21 @@
module Assistant.Commits where
-import Utility.TSet
-
-type CommitChan = TSet Commit
+import Assistant.Common
+import Assistant.Types.Commits
-data Commit = Commit
-
-newCommitChan :: IO CommitChan
-newCommitChan = newTSet
+import Utility.TSet
{- Gets all unhandled commits.
- Blocks until at least one commit is made. -}
-getCommits :: CommitChan -> IO [Commit]
-getCommits = getTSet
+getCommits :: Assistant [Commit]
+getCommits = getTSet <<~ commitChan
{- Puts unhandled commits back into the channel.
- Note: Original order is not preserved. -}
-refillCommits :: CommitChan -> [Commit] -> IO ()
-refillCommits = putTSet
+refillCommits :: [Commit] -> Assistant ()
+refillCommits cs = flip putTSet cs <<~ commitChan
{- Records a commit in the channel. -}
-recordCommit :: CommitChan -> IO ()
-recordCommit = flip putTSet1 Commit
+recordCommit :: Assistant ()
+recordCommit = flip putTSet1 Commit <<~ commitChan
diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs
index 1f8ccacbe..7db6cbc5e 100644
--- a/Assistant/Monad.hs
+++ b/Assistant/Monad.hs
@@ -26,15 +26,15 @@ import "mtl" Control.Monad.Reader
import Control.Monad.Base (liftBase, MonadBase)
import Common.Annex
-import Assistant.ThreadedMonad
+import Assistant.Types.ThreadedMonad
import Assistant.DaemonStatus
-import Assistant.ScanRemotes
+import Assistant.Types.ScanRemotes
import Assistant.TransferQueue
import Assistant.TransferSlots
import Assistant.Types.Pushes
-import Assistant.Commits
-import Assistant.Changes
-import Assistant.BranchChange
+import Assistant.Types.BranchChange
+import Assistant.Types.Commits
+import Assistant.Types.Changes
newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a }
deriving (
@@ -112,6 +112,7 @@ asIO2 a = do
(<<~) :: (a -> IO b) -> (AssistantData -> a) -> Assistant b
io <<~ v = reader v >>= liftIO . io
+withAssistant :: (AssistantData -> a) -> (a -> IO b) -> Assistant b
withAssistant v io = io <<~ v
daemonStatus :: Assistant DaemonStatus
diff --git a/Assistant/ScanRemotes.hs b/Assistant/ScanRemotes.hs
index 661c98095..f367ab745 100644
--- a/Assistant/ScanRemotes.hs
+++ b/Assistant/ScanRemotes.hs
@@ -7,39 +7,32 @@
module Assistant.ScanRemotes where
-import Common.Annex
+import Assistant.Common
+import Assistant.Types.ScanRemotes
import qualified Types.Remote as Remote
import Data.Function
import Control.Concurrent.STM
import qualified Data.Map as M
-data ScanInfo = ScanInfo
- { scanPriority :: Int
- , fullScan :: Bool
- }
-
-type ScanRemoteMap = TMVar (M.Map Remote ScanInfo)
-
-{- The TMVar starts empty, and is left empty when there are no remotes
- - to scan. -}
-newScanRemoteMap :: IO ScanRemoteMap
-newScanRemoteMap = atomically newEmptyTMVar
-
{- Blocks until there is a remote or remotes that need to be scanned.
-
- The list has higher priority remotes listed first. -}
-getScanRemote :: ScanRemoteMap -> IO [(Remote, ScanInfo)]
-getScanRemote v = atomically $
- reverse . sortBy (compare `on` scanPriority . snd) . M.toList
- <$> takeTMVar v
+getScanRemote :: Assistant [(Remote, ScanInfo)]
+getScanRemote = do
+ v <- getAssistant scanRemoteMap
+ liftIO $ atomically $
+ reverse . sortBy (compare `on` scanPriority . snd) . M.toList
+ <$> takeTMVar v
{- Adds new remotes that need scanning. -}
-addScanRemotes :: ScanRemoteMap -> Bool -> [Remote] -> IO ()
-addScanRemotes _ _ [] = noop
-addScanRemotes v full rs = atomically $ do
- m <- fromMaybe M.empty <$> tryTakeTMVar v
- putTMVar v $ M.unionWith merge (M.fromList $ zip rs (map info rs)) m
+addScanRemotes :: Bool -> [Remote] -> Assistant ()
+addScanRemotes _ [] = noop
+addScanRemotes full rs = do
+ v <- getAssistant scanRemoteMap
+ liftIO $ atomically $ do
+ m <- fromMaybe M.empty <$> tryTakeTMVar v
+ putTMVar v $ M.unionWith merge (M.fromList $ zip rs (map info rs)) m
where
info r = ScanInfo (-1 * Remote.cost r) full
merge x y = ScanInfo
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index b16382d82..0bb49973a 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -41,8 +41,7 @@ reconnectRemotes notifypushes rs = void $ do
alertWhile (syncAlert rs) $ do
(ok, diverged) <- sync
=<< liftAnnex (inRepo Git.Branch.current)
- scanremotes <- getAssistant scanRemoteMap
- liftIO $ addScanRemotes scanremotes diverged rs
+ addScanRemotes diverged rs
return ok
where
(gitremotes, _specialremotes) =
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index b3a737872..79b3812ee 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -11,6 +11,7 @@ module Assistant.Threads.Committer where
import Assistant.Common
import Assistant.Changes
+import Assistant.Types.Changes
import Assistant.Commits
import Assistant.Alert
import Assistant.Threads.Watcher
@@ -45,7 +46,7 @@ commitThread = NamedThread "Committer" $ do
-- We already waited one second as a simple rate limiter.
-- Next, wait until at least one change is available for
-- processing.
- changes <- getChanges <<~ changeChan
+ changes <- getChanges
-- Now see if now's a good time to commit.
time <- liftIO getCurrentTime
if shouldCommit time changes
@@ -60,14 +61,14 @@ commitThread = NamedThread "Committer" $ do
]
void $ alertWhile commitAlert $
liftAnnex commitStaged
- recordCommit <<~ commitChan
+ recordCommit
else refill readychanges
else refill changes
where
refill [] = noop
refill cs = do
debug ["delaying commit of", show (length cs), "changes"]
- flip refillChanges cs <<~ changeChan
+ refillChanges cs
commitStaged :: Annex Bool
commitStaged = do
@@ -148,15 +149,14 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
(postponed, toadd) <- partitionEithers <$> safeToAdd delayadd pending' inprocess
unless (null postponed) $
- flip refillChanges postponed <<~ changeChan
+ refillChanges postponed
returnWhen (null toadd) $ do
added <- catMaybes <$> forM toadd add
if DirWatcher.eventsCoalesce || null added
then return $ added ++ otherchanges
else do
- r <- handleAdds delayadd
- =<< getChanges <<~ changeChan
+ r <- handleAdds delayadd =<< getChanges
return $ r ++ added ++ otherchanges
where
(incomplete, otherchanges) = partition (\c -> isPendingAddChange c || isInProcessAddChange c) cs
diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs
index fe98b10e8..ce44105df 100644
--- a/Assistant/Threads/ConfigMonitor.hs
+++ b/Assistant/Threads/ConfigMonitor.hs
@@ -39,7 +39,7 @@ configMonitorThread = NamedThread "ConfigMonitor" $ loop =<< getConfigs
where
loop old = do
liftIO $ threadDelaySeconds (Seconds 60)
- waitBranchChange <<~ branchChangeHandle
+ waitBranchChange
new <- getConfigs
when (old /= new) $ do
let changedconfigs = new `S.difference` old
@@ -48,7 +48,7 @@ configMonitorThread = NamedThread "ConfigMonitor" $ loop =<< getConfigs
reloadConfigs new
{- Record a commit to get this config
- change pushed out to remotes. -}
- recordCommit <<~ commitChan
+ recordCommit
loop new
{- Config files, and their checksums. -}
diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs
index a766c5977..46511701c 100644
--- a/Assistant/Threads/Merger.hs
+++ b/Assistant/Threads/Merger.hs
@@ -66,7 +66,7 @@ onAdd :: Handler
onAdd file
| ".lock" `isSuffixOf` file = noop
| isAnnexBranch file = do
- branchChanged <<~ branchChangeHandle
+ branchChanged
transferqueue <- getAssistant transferQueue
dstatus <- getAssistant daemonStatusHandle
liftAnnex $
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs
index c87df1610..905cf81db 100644
--- a/Assistant/Threads/Pusher.hs
+++ b/Assistant/Threads/Pusher.hs
@@ -9,6 +9,7 @@ module Assistant.Threads.Pusher where
import Assistant.Common
import Assistant.Commits
+import Assistant.Types.Commits
import Assistant.Pushes
import Assistant.Alert
import Assistant.DaemonStatus
@@ -41,7 +42,7 @@ pushThread :: NamedThread
pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do
-- We already waited two seconds as a simple rate limiter.
-- Next, wait until at least one commit has been made
- commits <- getCommits <<~ commitChan
+ commits <- getCommits
-- Now see if now's a good time to push.
if shouldPush commits
then do
@@ -52,7 +53,7 @@ pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do
pushToRemotes now True remotes
else do
debug ["delaying push of", show (length commits), "commits"]
- flip refillCommits commits <<~ commitChan
+ refillCommits commits
where
pushable r
| Remote.specialRemote r = False
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 3e99b60f5..ec0bc0d9b 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -8,6 +8,7 @@
module Assistant.Threads.TransferScanner where
import Assistant.Common
+import Assistant.Types.ScanRemotes
import Assistant.ScanRemotes
import Assistant.TransferQueue
import Assistant.DaemonStatus
@@ -36,7 +37,7 @@ transferScannerThread = NamedThread "TransferScanner" $ do
where
go scanned = do
liftIO $ threadDelaySeconds (Seconds 2)
- (rs, infos) <- unzip <$> getScanRemote <<~ scanRemoteMap
+ (rs, infos) <- unzip <$> getScanRemote
if any fullScan infos || any (`S.notMember` scanned) rs
then do
expensiveScan rs
@@ -56,10 +57,7 @@ transferScannerThread = NamedThread "TransferScanner" $ do
- and then the system (or us) crashed, and that info was
- lost.
-}
- startupScan = do
- scanremotes <- getAssistant scanRemoteMap
- liftIO . addScanRemotes scanremotes True
- =<< syncRemotes <$> daemonStatus
+ startupScan = addScanRemotes True =<< syncRemotes <$> daemonStatus
{- This is a cheap scan for failed transfers involving a remote. -}
failedTransferScan :: Remote -> Assistant ()
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 145abe86d..6bcb05e0e 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -81,7 +81,7 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
liftIO $ void $ addAlert dstatus $
makeAlertFiller True $
transferFileAlert direction True file
- recordCommit <<~ commitChan
+ recordCommit
where
params =
[ Param "transferkey"
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 1c796a521..dee71b731 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -17,6 +17,7 @@ module Assistant.Threads.Watcher (
import Assistant.Common
import Assistant.DaemonStatus
import Assistant.Changes
+import Assistant.Types.Changes
import Assistant.TransferQueue
import Assistant.Alert
import Assistant.Drop
@@ -114,12 +115,12 @@ runHandler handler file filestatus = void $ do
-- Just in case the commit thread is not
-- flushing the queue fast enough.
liftAnnex $ Annex.Queue.flushWhenFull
- flip recordChange change <<~ changeChan
+ recordChange change
onAdd :: Handler
onAdd file filestatus
- | maybe False isRegularFile filestatus = liftIO $ pendingAddChange file
- | otherwise = liftIO $ noChange
+ | maybe False isRegularFile filestatus = pendingAddChange file
+ | otherwise = noChange
{- A symlink might be an arbitrary symlink, which is just added.
- Or, if it is a git-annex symlink, ensure it points to the content
@@ -160,7 +161,7 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file)
| scanComplete daemonstatus = addlink link
| otherwise = case filestatus of
Just s
- | not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> liftIO noChange
+ | not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange
_ -> addlink link
{- For speed, tries to reuse the existing blob for symlink target. -}
@@ -176,7 +177,7 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file)
sha <- inRepo $
Git.HashObject.hashObject BlobObject link
stageSymlink file sha
- liftIO $ madeChange file LinkChange
+ madeChange file LinkChange
{- When a new link appears, or a link is changed, after the startup
- scan, handle getting or dropping the key's content. -}
@@ -197,7 +198,7 @@ onDel file _ = do
liftAnnex $
Annex.Queue.addUpdateIndex =<<
inRepo (Git.UpdateIndex.unstageFile file)
- liftIO $ madeChange file RmChange
+ madeChange file RmChange
{- A directory has been deleted, or moved, so tell git to remove anything
- that was inside it from its cache. Since it could reappear at any time,
@@ -211,7 +212,7 @@ onDelDir dir _ = do
debug ["directory deleted", dir]
liftAnnex $ Annex.Queue.addCommand "rm"
[Params "--quiet -r --cached --ignore-unmatch --"] [dir]
- liftIO $ madeChange dir RmDirChange
+ madeChange dir RmDirChange
{- Called when there's an error with inotify or kqueue. -}
onErr :: Handler
@@ -219,7 +220,7 @@ onErr msg _ = do
liftAnnex $ warning msg
dstatus <- getAssistant daemonStatusHandle
void $ liftIO $ addAlert dstatus $ warningAlert "watcher" msg
- liftIO noChange
+ noChange
{- Adds a symlink to the index, without ever accessing the actual symlink
- on disk. This avoids a race if git add is used, where the symlink is
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 126c78166..be9a9a16f 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -27,7 +27,7 @@ import Assistant.WebApp.Configurators.S3
import Assistant.WebApp.Configurators.XMPP
import Assistant.WebApp.Documentation
import Assistant.WebApp.OtherRepos
-import Assistant.ThreadedMonad
+import Assistant.Types.ThreadedMonad
import Utility.WebApp
import Utility.FileMode
import Utility.TempFile
diff --git a/Assistant/Types/BranchChange.hs b/Assistant/Types/BranchChange.hs
new file mode 100644
index 000000000..399abee54
--- /dev/null
+++ b/Assistant/Types/BranchChange.hs
@@ -0,0 +1,19 @@
+{- git-annex assistant git-annex branch change tracking
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.BranchChange where
+
+import Control.Concurrent.MSampleVar
+import Common.Annex
+
+newtype BranchChangeHandle = BranchChangeHandle (MSampleVar ())
+
+newBranchChangeHandle :: IO BranchChangeHandle
+newBranchChangeHandle = BranchChangeHandle <$> newEmptySV
+
+fromBranchChangeHandle :: BranchChangeHandle -> MSampleVar ()
+fromBranchChangeHandle (BranchChangeHandle v) = v
diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs
new file mode 100644
index 000000000..887aa819e
--- /dev/null
+++ b/Assistant/Types/Changes.hs
@@ -0,0 +1,54 @@
+{- git-annex assistant change tracking
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.Changes where
+
+import Types.KeySource
+import Utility.TSet
+
+import Data.Time.Clock
+
+data ChangeType = AddChange | LinkChange | RmChange | RmDirChange
+ deriving (Show, Eq)
+
+type ChangeChan = TSet Change
+
+data Change
+ = Change
+ { changeTime :: UTCTime
+ , changeFile :: FilePath
+ , changeType :: ChangeType
+ }
+ | PendingAddChange
+ { changeTime ::UTCTime
+ , changeFile :: FilePath
+ }
+ | InProcessAddChange
+ { changeTime ::UTCTime
+ , keySource :: KeySource
+ }
+ deriving (Show)
+
+newChangeChan :: IO ChangeChan
+newChangeChan = newTSet
+
+isPendingAddChange :: Change -> Bool
+isPendingAddChange (PendingAddChange {}) = True
+isPendingAddChange _ = False
+
+isInProcessAddChange :: Change -> Bool
+isInProcessAddChange (InProcessAddChange {}) = True
+isInProcessAddChange _ = False
+
+finishedChange :: Change -> Change
+finishedChange c@(InProcessAddChange { keySource = ks }) = Change
+ { changeTime = changeTime c
+ , changeFile = keyFilename ks
+ , changeType = AddChange
+ }
+finishedChange c = c
+
diff --git a/Assistant/Types/Commits.hs b/Assistant/Types/Commits.hs
new file mode 100644
index 000000000..bb17c578b
--- /dev/null
+++ b/Assistant/Types/Commits.hs
@@ -0,0 +1,17 @@
+{- git-annex assistant commit tracking
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.Commits where
+
+import Utility.TSet
+
+type CommitChan = TSet Commit
+
+data Commit = Commit
+
+newCommitChan :: IO CommitChan
+newCommitChan = newTSet
diff --git a/Assistant/Types/ScanRemotes.hs b/Assistant/Types/ScanRemotes.hs
new file mode 100644
index 000000000..d2f0c588f
--- /dev/null
+++ b/Assistant/Types/ScanRemotes.hs
@@ -0,0 +1,25 @@
+{- git-annex assistant remotes needing scanning
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.ScanRemotes where
+
+import Common.Annex
+
+import Control.Concurrent.STM
+import qualified Data.Map as M
+
+data ScanInfo = ScanInfo
+ { scanPriority :: Int
+ , fullScan :: Bool
+ }
+
+type ScanRemoteMap = TMVar (M.Map Remote ScanInfo)
+
+{- The TMVar starts empty, and is left empty when there are no remotes
+ - to scan. -}
+newScanRemoteMap :: IO ScanRemoteMap
+newScanRemoteMap = atomically newEmptyTMVar
diff --git a/Assistant/ThreadedMonad.hs b/Assistant/Types/ThreadedMonad.hs
index 7b915e12c..1a2aa7eb7 100644
--- a/Assistant/ThreadedMonad.hs
+++ b/Assistant/Types/ThreadedMonad.hs
@@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Assistant.ThreadedMonad where
+module Assistant.Types.ThreadedMonad where
import Common.Annex
import qualified Annex
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-26 01:56:56 +0000