diff options
author | Joey Hess <joey@kitenet.net> | 2012-09-21 14:50:14 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-09-21 14:50:14 -0400 |
commit | 226781c047a50747f5c60a6cf4920a43cd3a3a73 (patch) | |
tree | 0a5ead6c80110d533630db1875a9ebc10dea176d | |
parent | 6873d785f050cbfb2aa7bd67fcdb29ab585ec291 (diff) |
unify types
-rw-r--r-- | Command/SendKey.hs | 2 | ||||
-rw-r--r-- | Logs/Transfer.hs | 4 | ||||
-rw-r--r-- | Messages.hs | 3 | ||||
-rw-r--r-- | Remote/Bup.hs | 8 | ||||
-rw-r--r-- | Remote/Directory.hs | 4 | ||||
-rw-r--r-- | Remote/Git.hs | 6 | ||||
-rw-r--r-- | Remote/Helper/Encryptable.hs | 2 | ||||
-rw-r--r-- | Remote/Hook.hs | 4 | ||||
-rw-r--r-- | Remote/Rsync.hs | 8 | ||||
-rw-r--r-- | Remote/S3.hs | 8 | ||||
-rw-r--r-- | Remote/Web.hs | 2 | ||||
-rw-r--r-- | Types/Remote.hs | 6 |
12 files changed, 28 insertions, 29 deletions
diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 79cc61876..e5d4c7e6e 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -32,7 +32,7 @@ start key = ifM (inAnnex key) liftIO exitFailure ) -fieldTransfer :: Direction -> Key -> (ProgressCallback -> Annex Bool) -> CommandStart +fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart fieldTransfer direction key a = do afile <- Fields.getField Fields.associatedFile ok <- maybe (a $ const noop) diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index ac2606d8c..3d1040c2c 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -74,7 +74,7 @@ percentComplete :: Transfer -> TransferInfo -> Maybe Percentage percentComplete (Transfer { transferKey = key }) info = percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info) -upload :: UUID -> Key -> AssociatedFile -> (ProgressCallback -> Annex Bool) -> Annex Bool +upload :: UUID -> Key -> AssociatedFile -> (MeterUpdate -> Annex Bool) -> Annex Bool upload u key file a = runTransfer (Transfer Upload u key) file a download :: UUID -> Key -> AssociatedFile -> Annex Bool -> Annex Bool @@ -87,7 +87,7 @@ download u key file a = runTransfer (Transfer Download u key) file (const a) - If the transfer action returns False, the transfer info is - left in the failedTransferDir. -} -runTransfer :: Transfer -> Maybe FilePath -> (ProgressCallback -> Annex Bool) -> Annex Bool +runTransfer :: Transfer -> Maybe FilePath -> (MeterUpdate -> Annex Bool) -> Annex Bool runTransfer t file a = do tfile <- fromRepo $ transferFile t createAnnexDirectory $ takeDirectory tfile diff --git a/Messages.hs b/Messages.hs index 1b48c119b..7f61efb88 100644 --- a/Messages.hs +++ b/Messages.hs @@ -11,7 +11,6 @@ module Messages ( showAction, showProgress, metered, - MeterUpdate, showSideAction, doSideAction, doQuietSideAction, @@ -42,6 +41,7 @@ import Common import Types import Types.Messages import Types.Key +import Types.Remote import qualified Annex import qualified Messages.JSON as JSON @@ -63,7 +63,6 @@ showProgress = handle q $ {- Shows a progress meter while performing a transfer of a key. - The action is passed a callback to use to update the meter. -} -type MeterUpdate = Integer -> IO () metered :: Key -> (MeterUpdate -> Annex a) -> Annex a metered key a = withOutputType $ go (keySize key) where diff --git a/Remote/Bup.hs b/Remote/Bup.hs index fb4e5a48c..2249f5b7e 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -113,14 +113,14 @@ bupSplitParams r buprepo k src = do return $ bupParams "split" buprepo (os ++ [Param "-n", Param (bupRef k), src]) -store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool -store r buprepo k _f p = do +store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool +store r buprepo k _f _p = do src <- inRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo k (File src) liftIO $ boolSystem "bup" params -storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool -storeEncrypted r buprepo (cipher, enck) k p = do +storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool +storeEncrypted r buprepo (cipher, enck) k _p = do src <- inRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo enck (Param "-") liftIO $ catchBoolIO $ diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 2bf44634d..9eada0635 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -124,7 +124,7 @@ withCheckedFiles check (Just _) d k a = go $ locations d k withStoredFiles :: ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO Bool withStoredFiles = withCheckedFiles doesFileExist -store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store d chunksize k _f p = do src <- inRepo $ gitAnnexLocation k metered k $ \meterupdate -> @@ -139,7 +139,7 @@ store d chunksize k _f p = do storeSplit meterupdate chunksize dests =<< L.readFile src -storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool +storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted d chunksize (cipher, enck) k p = do src <- inRepo $ gitAnnexLocation k metered k $ \meterupdate -> diff --git a/Remote/Git.hs b/Remote/Git.hs index cd38cac06..c10347f98 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -264,7 +264,7 @@ copyFromRemoteCheap r key file | otherwise = return False {- Tries to copy a key's content to a remote's annex. -} -copyToRemote :: Git.Repo -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +copyToRemote :: Git.Repo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool copyToRemote r key file p | not $ Git.repoIsUrl r = guardUsable r False $ commitOnCleanup r $ do keysrc <- inRepo $ gitAnnexLocation key @@ -285,7 +285,7 @@ copyToRemote r key file p rsyncHelper (Just p) =<< rsyncParamsRemote r False key keysrc file | otherwise = error "copying to non-ssh repo not supported" -rsyncHelper :: Maybe ProgressCallback -> [CommandParam] -> Annex Bool +rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool rsyncHelper callback params = do showOutput -- make way for progress bar ifM (liftIO $ (maybe rsync rsyncProgress callback) params) @@ -297,7 +297,7 @@ rsyncHelper callback params = do {- Copys a file with rsync unless both locations are on the same - filesystem. Then cp could be faster. -} -rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> ProgressCallback -> Annex Bool +rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool rsyncOrCopyFile rsyncparams src dest p = ifM (sameDeviceIds src dest) (dorsync, docopy) where diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index e3cb40df4..880db5c6a 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -45,7 +45,7 @@ encryptionSetup c = case (M.lookup "encryption" c, extractCipher c) of - to support storing and retrieving encrypted content. -} encryptableRemote :: Maybe RemoteConfig - -> ((Cipher, Key) -> Key -> ProgressCallback -> Annex Bool) + -> ((Cipher, Key) -> Key -> MeterUpdate -> Annex Bool) -> ((Cipher, Key) -> Key -> FilePath -> Annex Bool) -> Remote -> Remote diff --git a/Remote/Hook.hs b/Remote/Hook.hs index cf0425590..716a81835 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -103,12 +103,12 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h return False ) -store :: String -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +store :: String -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store h k _f _p = do src <- inRepo $ gitAnnexLocation k runHook h "store" k (Just src) $ return True -storeEncrypted :: String -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool +storeEncrypted :: String -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted h (cipher, enck) k _p = withTmp enck $ \tmp -> do src <- inRepo $ gitAnnexLocation k liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 5384920fb..c3ef94a71 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -104,10 +104,10 @@ rsyncUrls o k = map use annexHashes use h = rsyncUrl o </> h k </> rsyncEscape o (f </> f) f = keyFile k -store :: RsyncOpts -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool +store :: RsyncOpts -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store o k _f p = rsyncSend o p k <=< inRepo $ gitAnnexLocation k -storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool +storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted o (cipher, enck) k p = withTmp enck $ \tmp -> do src <- inRepo $ gitAnnexLocation k liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp @@ -191,7 +191,7 @@ withRsyncScratchDir a = do nuke d = liftIO $ whenM (doesDirectoryExist d) $ removeDirectoryRecursive d -rsyncRemote :: RsyncOpts -> (Maybe ProgressCallback) -> [CommandParam] -> Annex Bool +rsyncRemote :: RsyncOpts -> (Maybe MeterUpdate) -> [CommandParam] -> Annex Bool rsyncRemote o callback params = do showOutput -- make way for progress bar ifM (liftIO $ (maybe rsync rsyncProgress callback) ps) @@ -207,7 +207,7 @@ rsyncRemote o callback params = do {- To send a single key is slightly tricky; need to build up a temporary directory structure to pass to rsync so it can create the hash directories. -} -rsyncSend :: RsyncOpts -> ProgressCallback -> Key -> FilePath -> Annex Bool +rsyncSend :: RsyncOpts -> MeterUpdate -> Key -> FilePath -> Annex Bool rsyncSend o callback k src = withRsyncScratchDir $ \tmp -> do let dest = tmp </> Prelude.head (keyPaths k) liftIO $ createDirectoryIfMissing True $ parentDir dest diff --git a/Remote/S3.hs b/Remote/S3.hs index 12eb96add..65346809e 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -115,14 +115,14 @@ s3Setup u c = handlehost $ M.lookup "host" c -- be human-readable M.delete "bucket" defaults -store :: Remote -> Key -> AssociatedFile -> ProgressCallback -> Annex Bool -store r k _f p = s3Action r False $ \(conn, bucket) -> do +store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool +store r k _f _p = s3Action r False $ \(conn, bucket) -> do dest <- inRepo $ gitAnnexLocation k res <- liftIO $ storeHelper (conn, bucket) r k dest s3Bool res -storeEncrypted :: Remote -> (Cipher, Key) -> Key -> ProgressCallback -> Annex Bool -storeEncrypted r (cipher, enck) k p = s3Action r False $ \(conn, bucket) -> +storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool +storeEncrypted r (cipher, enck) k _p = s3Action r False $ \(conn, bucket) -> -- To get file size of the encrypted content, have to use a temp file. -- (An alternative would be chunking to to a constant size.) withTmp enck $ \tmp -> do diff --git a/Remote/Web.hs b/Remote/Web.hs index 58d95f7f1..78f747a10 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -66,7 +66,7 @@ downloadKey key _file dest = get =<< getUrls key downloadKeyCheap :: Key -> FilePath -> Annex Bool downloadKeyCheap _ _ = return False -uploadKey :: Key -> AssociatedFile -> ProgressCallback -> Annex Bool +uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool uploadKey _ _ _ = do warning "upload to web not supported" return False diff --git a/Types/Remote.hs b/Types/Remote.hs index b89972fdd..d31d9a78f 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -37,8 +37,8 @@ instance Eq (RemoteTypeA a) where type AssociatedFile = Maybe FilePath {- An action that can be run repeatedly, feeding it the number of - - bytes sent or retreived so far. -} -type ProgressCallback = (Integer -> IO ()) + - bytes sent or retrieved so far. -} +type MeterUpdate = (Integer -> IO ()) {- An individual remote. -} data RemoteA a = Remote { @@ -49,7 +49,7 @@ data RemoteA a = Remote { -- Remotes have a use cost; higher is more expensive cost :: Int, -- Transfers a key to the remote. - storeKey :: Key -> AssociatedFile -> ProgressCallback -> a Bool, + storeKey :: Key -> AssociatedFile -> MeterUpdate -> a Bool, -- retrieves a key's contents to a file retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> a Bool, -- retrieves a key's contents to a tmp file, if it can be done cheaply |