diff options
| -rw-r--r-- | Annex.hs | 2 | ||||
| -rw-r--r-- | Common.hs | 1 | ||||
| -rw-r--r-- | Logs/Presence.hs | 2 | ||||
| -rw-r--r-- | Remote/Directory.hs | 2 | ||||
| -rw-r--r-- | Utility/Applicative.hs | 16 | ||||
| -rw-r--r-- | doc/design/assistant/syncing.mdwn | 40 |
6 files changed, 60 insertions, 3 deletions
@@ -128,7 +128,7 @@ newState gitrepo = AnnexState {- Makes an Annex state object for the specified git repo. - Ensures the config is read, if it was not already. -} new :: Git.Repo -> IO AnnexState -new gitrepo = newState <$> Git.Config.read gitrepo +new = newState <$$> Git.Config.read {- performs an action in the Annex monad -} run :: AnnexState -> Annex a -> IO (a, AnnexState) @@ -26,6 +26,7 @@ import Utility.SafeCommand as X import Utility.Path as X import Utility.Directory as X import Utility.Monad as X +import Utility.Applicative as X import Utility.FileSystemEncoding as X import Utility.PartialPrelude as X diff --git a/Logs/Presence.hs b/Logs/Presence.hs index 933426718..e75e1e4e6 100644 --- a/Logs/Presence.hs +++ b/Logs/Presence.hs @@ -48,7 +48,7 @@ addLog file line = Annex.Branch.change file $ \s -> {- Reads a log file. - Note that the LogLines returned may be in any order. -} readLog :: FilePath -> Annex [LogLine] -readLog file = parseLog <$> Annex.Branch.get file +readLog = parseLog <$$> Annex.Branch.get {- Parses a log file. Unparseable lines are ignored. -} parseLog :: String -> [LogLine] diff --git a/Remote/Directory.hs b/Remote/Directory.hs index a5b0ff2a2..f618f518e 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -272,7 +272,7 @@ retrieveCheap d _ k f = liftIO $ withStoredFiles Nothing d k go remove :: FilePath -> ChunkSize -> Key -> Annex Bool remove d chunksize k = liftIO $ withStoredFiles chunksize d k go where - go files = all id <$> mapM removefile files + go = all id <$$> mapM removefile removefile file = catchBoolIO $ do let dir = parentDir file allowWrite dir diff --git a/Utility/Applicative.hs b/Utility/Applicative.hs new file mode 100644 index 000000000..64400c801 --- /dev/null +++ b/Utility/Applicative.hs @@ -0,0 +1,16 @@ +{- applicative stuff + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.Applicative where + +{- Like <$> , but supports one level of currying. + - + - foo v = bar <$> action v == foo = bar <$$> action + -} +(<$$>) :: Functor f => (a -> b) -> (c -> f a) -> c -> f b +f <$$> v = fmap f . v +infixr 4 <$$> diff --git a/doc/design/assistant/syncing.mdwn b/doc/design/assistant/syncing.mdwn index 8b681ac10..99474928c 100644 --- a/doc/design/assistant/syncing.mdwn +++ b/doc/design/assistant/syncing.mdwn @@ -39,6 +39,46 @@ and with appropriate rate limiting and control facilities. This probably will need lots of refinements to get working well. +### first pass: flood syncing + +Before mapping the network, the best we can do is flood all files out to every +reachable remote. This is worth doing first, since it's the simplest way to +get the basic functionality of the assistant to work. And we'll need this +anyway. + + data ToTransfer = ToUpload Key | ToDownload Key + type ToTransferChan = TChan [ToTransfer] + +* ToUpload added by the watcher thread when it adds content. +* ToDownload added by the watcher thread when it seens new symlinks + that lack content. + +Transfer threads started/stopped as necessary to move data. +May sometimes want multiple threads downloading, or uploading, or even both. + + data TransferID = TransferThread ThreadID | TransferProcess Pid + data Direction = Uploading | Downloading + data Transfer = Transfer Direction Key TransferID EpochTime Integer + -- add [Transfer] to DaemonStatus + +The assistant needs to find out when `git-annex-shell` is receiving or +sending (triggered by another remote), so it can add data for those too. +This is important to avoid uploading content to a remote that is already +downloading it from us, or vice versa, as well as to in future let the web +app manage transfers as user desires. + +For files being received, it can see the temp file, but other than lsof +there's no good way to find the pid (and I'd rather not kill blindly). + +For files being sent, there's no filesystem indication. So git-annex-shell +(and other git-annex transfer processes) should write a status file to disk. + +Can use file locking on these status files to claim upload/download rights, +which will avoid races. + +This status file can also be updated periodically to show amount of transfer +complete (necessary for tracking uploads). + ## other considerations It would be nice if, when a USB drive is connected, |