aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-01-21 16:08:19 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-01-21 16:08:59 -0400
commitd5f7fb27aad3e2e9c4bebb9ccd5577af8deb25c7 (patch)
tree838837e3112942fcf0f82cfc7f68e62a6f4e7a6e
parent9a8709f064c7608859b3155a752093b29cd8ab98 (diff)
reorganize numcopies code (no behavior changes)
Move stuff into Logs.NumCopies. Add a NumCopies newtype. Better names for various serialization classes that are specific to one thing or another.
-rw-r--r--Annex.hs3
-rw-r--r--Annex/Drop.hs10
-rw-r--r--Assistant/Threads/ConfigMonitor.hs2
-rw-r--r--Command.hs21
-rw-r--r--Command/Copy.hs1
-rw-r--r--Command/Drop.hs30
-rw-r--r--Command/Fsck.hs19
-rw-r--r--Command/Get.hs1
-rw-r--r--Command/Info.hs1
-rw-r--r--Command/Mirror.hs5
-rw-r--r--Command/NumCopies.hs4
-rw-r--r--Command/TransferKeys.hs12
-rw-r--r--Config.hs7
-rw-r--r--GitAnnex/Options.hs3
-rw-r--r--Limit.hs2
-rw-r--r--Logs/NumCopies.hs62
-rw-r--r--Logs/SingleValue.hs12
-rw-r--r--Remote/External/Types.hs22
-rw-r--r--Types/NumCopies.hs14
19 files changed, 135 insertions, 96 deletions
diff --git a/Annex.hs b/Annex.hs
index d77d0973c..cdb65fe7b 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -56,6 +56,7 @@ import Types.Group
import Types.Messages
import Types.UUID
import Types.FileMatcher
+import Types.NumCopies
import qualified Utility.Matcher
import qualified Data.Map as M
import qualified Data.Set as S
@@ -94,7 +95,7 @@ data AnnexState = AnnexState
, checkattrhandle :: Maybe CheckAttrHandle
, checkignorehandle :: Maybe (Maybe CheckIgnoreHandle)
, forcebackend :: Maybe String
- , globalnumcopies :: Maybe Int
+ , globalnumcopies :: Maybe NumCopies
, limit :: Matcher (MatchInfo -> Annex Bool)
, uuidmap :: Maybe UUIDMap
, preferredcontentmap :: Maybe PreferredContentMap
diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index e307852f2..afd6303b0 100644
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -9,6 +9,7 @@ module Annex.Drop where
import Common.Annex
import Logs.Trust
+import Logs.NumCopies
import Types.Remote (uuid)
import qualified Remote
import qualified Command.Drop
@@ -59,8 +60,9 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runn
where
getcopies fs = do
(untrusted, have) <- trustPartition UnTrusted locs
- numcopies <- maximum <$> mapM (getNumCopies <=< numCopies) fs
- return (length have, numcopies, S.fromList untrusted)
+ numcopies <- maximum
+ <$> mapM (getNumCopies <=< getFileNumCopies) fs
+ return (NumCopies (length have), numcopies, S.fromList untrusted)
{- Check that we have enough copies still to drop the content.
- When the remote being dropped from is untrusted, it was not
@@ -72,7 +74,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runn
| otherwise = have > numcopies
decrcopies (have, numcopies, untrusted) Nothing =
- (have - 1, numcopies, untrusted)
+ (NumCopies (fromNumCopies have - 1), numcopies, untrusted)
decrcopies v@(_have, _numcopies, untrusted) (Just u)
| S.member u untrusted = v
| otherwise = decrcopies v Nothing
@@ -92,7 +94,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runn
[ "dropped"
, afile
, "(from " ++ maybe "here" show u ++ ")"
- , "(copies now " ++ show (have - 1) ++ ")"
+ , "(copies now " ++ show (fromNumCopies have - 1) ++ ")"
, ": " ++ reason
]
return $ decrcopies n u
diff --git a/Assistant/Threads/ConfigMonitor.hs b/Assistant/Threads/ConfigMonitor.hs
index 8fefc06eb..a92c7d785 100644
--- a/Assistant/Threads/ConfigMonitor.hs
+++ b/Assistant/Threads/ConfigMonitor.hs
@@ -60,7 +60,7 @@ configFilesActions =
, (remoteLog, void $ liftAnnex remoteListRefresh)
, (trustLog, void $ liftAnnex trustMapLoad)
, (groupLog, void $ liftAnnex groupMapLoad)
- , (numcopiesLog, void $ liftAnnex numCopiesLoad)
+ , (numcopiesLog, void $ liftAnnex globalNumCopiesLoad)
, (scheduleLog, void updateScheduleLog)
-- Preferred content settings depend on most of the other configs,
-- so will be reloaded whenever any configs change.
diff --git a/Command.hs b/Command.hs
index e3f748dc5..1943fc06e 100644
--- a/Command.hs
+++ b/Command.hs
@@ -19,8 +19,6 @@ module Command (
whenAnnexed,
ifAnnexed,
isBareRepo,
- numCopies,
- numCopiesCheck,
checkAuto,
module ReExported
) where
@@ -29,17 +27,12 @@ import Common.Annex
import qualified Backend
import qualified Annex
import qualified Git
-import qualified Remote
import Types.Command as ReExported
import Types.Option as ReExported
import Seek as ReExported
import Checks as ReExported
import Usage as ReExported
import RunCommand as ReExported
-import Logs.Trust
-import Logs.NumCopies
-import Config
-import Annex.CheckAttr
{- Generates a normal command -}
command :: String -> String -> CommandSeek -> CommandSection -> String -> Command
@@ -87,20 +80,6 @@ ifAnnexed file yes no = maybe no yes =<< Backend.lookupFile file
isBareRepo :: Annex Bool
isBareRepo = fromRepo Git.repoIsLocalBare
-numCopies :: FilePath -> Annex (Maybe Int)
-numCopies file = do
- global <- getGlobalNumCopies
- case global of
- Just n -> return $ Just n
- Nothing -> readish <$> checkAttr "annex.numcopies" file
-
-numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v
-numCopiesCheck file key vs = do
- numcopiesattr <- numCopies file
- needed <- getNumCopies numcopiesattr
- have <- trustExclude UnTrusted =<< Remote.keyLocations key
- return $ length have `vs` needed
-
checkAuto :: Annex Bool -> Annex Bool
checkAuto checker = ifM (Annex.getState Annex.auto)
( checker , return True )
diff --git a/Command/Copy.hs b/Command/Copy.hs
index fd16cea29..090bd3a9a 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -13,6 +13,7 @@ import GitAnnex.Options
import qualified Command.Move
import qualified Remote
import Annex.Wanted
+import Logs.NumCopies
def :: [Command]
def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 97208eff7..9609cf830 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -14,8 +14,8 @@ import qualified Annex
import Annex.UUID
import Logs.Location
import Logs.Trust
+import Logs.NumCopies
import Annex.Content
-import Config
import qualified Option
import Annex.Wanted
import Types.Key
@@ -43,17 +43,17 @@ start from file (key, _) = checkDropAuto from file key $ \numcopies ->
then startLocal (Just file) numcopies key Nothing
else startRemote (Just file) numcopies key remote
-startLocal :: AssociatedFile -> Maybe Int -> Key -> Maybe Remote -> CommandStart
+startLocal :: AssociatedFile -> Maybe NumCopies -> Key -> Maybe Remote -> CommandStart
startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
showStart "drop" (fromMaybe (key2file key) afile)
next $ performLocal key numcopies knownpresentremote
-startRemote :: AssociatedFile -> Maybe Int -> Key -> Remote -> CommandStart
+startRemote :: AssociatedFile -> Maybe NumCopies -> Key -> Remote -> CommandStart
startRemote afile numcopies key remote = do
showStart ("drop " ++ Remote.name remote) (fromMaybe (key2file key) afile)
next $ performRemote key numcopies remote
-performLocal :: Key -> Maybe Int -> Maybe Remote -> CommandPerform
+performLocal :: Key -> Maybe NumCopies -> Maybe Remote -> CommandPerform
performLocal key numcopies knownpresentremote = lockContent key $ do
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
let trusteduuids' = case knownpresentremote of
@@ -65,7 +65,7 @@ performLocal key numcopies knownpresentremote = lockContent key $ do
removeAnnex key
next $ cleanupLocal key
-performRemote :: Key -> Maybe Int -> Remote -> CommandPerform
+performRemote :: Key -> Maybe NumCopies -> Remote -> CommandPerform
performRemote key numcopies remote = lockContent key $ do
-- Filter the remote it's being dropped from out of the lists of
-- places assumed to have the key, and places to check.
@@ -98,23 +98,23 @@ cleanupRemote key remote ok = do
{- Checks specified remotes to verify that enough copies of a key exist to
- allow it to be safely removed (with no data loss). Can be provided with
- some locations where the key is known/assumed to be present. -}
-canDropKey :: Key -> Maybe Int -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
+canDropKey :: Key -> Maybe NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
canDropKey key numcopiesM have check skip = do
force <- Annex.getState Annex.force
- if force || numcopiesM == Just 0
+ if force || numcopiesM == Just (NumCopies 0)
then return True
else do
need <- getNumCopies numcopiesM
findCopies key need skip have check
-findCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
+findCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
findCopies key need skip = helper [] []
where
helper bad missing have []
- | length have >= need = return True
+ | NumCopies (length have) >= need = return True
| otherwise = notEnoughCopies key need have (skip++missing) bad
helper bad missing have (r:rs)
- | length have >= need = return True
+ | NumCopies (length have) >= need = return True
| otherwise = do
let u = Remote.uuid r
let duplicate = u `elem` have
@@ -125,12 +125,12 @@ findCopies key need skip = helper [] []
(False, Right False) -> helper bad (u:missing) have rs
_ -> helper bad missing have rs
-notEnoughCopies :: Key -> Int -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
+notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> Annex Bool
notEnoughCopies key need have skip bad = do
unsafe
showLongNote $
"Could only verify the existence of " ++
- show (length have) ++ " out of " ++ show need ++
+ show (length have) ++ " out of " ++ show (fromNumCopies need) ++
" necessary copies"
Remote.showTriedRemotes bad
Remote.showLocations key (have++skip)
@@ -146,9 +146,9 @@ notEnoughCopies key need have skip bad = do
-
- Passes any numcopies attribute of the file on to the action as an
- optimisation. -}
-checkDropAuto :: Maybe Remote -> FilePath -> Key -> (Maybe Int -> CommandStart) -> CommandStart
+checkDropAuto :: Maybe Remote -> FilePath -> Key -> (Maybe NumCopies -> CommandStart) -> CommandStart
checkDropAuto mremote file key a = do
- numcopiesattr <- numCopies file
+ numcopiesattr <- getFileNumCopies file
Annex.getState Annex.auto >>= auto numcopiesattr
where
auto numcopiesattr False = a numcopiesattr
@@ -158,6 +158,6 @@ checkDropAuto mremote file key a = do
uuid <- getUUID
let remoteuuid = fromMaybe uuid $ Remote.uuid <$> mremote
locs' <- trustExclude UnTrusted $ filter (/= remoteuuid) locs
- if length locs' >= needed
+ if NumCopies (length locs') >= needed
then a numcopiesattr
else stop
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 8b320f209..839ab1d71 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -25,6 +25,7 @@ import Annex.Perms
import Annex.Link
import Logs.Location
import Logs.Trust
+import Logs.NumCopies
import Annex.UUID
import Utility.DataUnits
import Utility.FileMode
@@ -111,14 +112,14 @@ getIncremental = do
start :: Maybe Remote -> Incremental -> FilePath -> (Key, Backend) -> CommandStart
start from inc file (key, backend) = do
- numcopies <- numCopies file
+ numcopies <- getFileNumCopies file
case from of
Nothing -> go $ perform key file backend numcopies
Just r -> go $ performRemote key file backend numcopies r
where
go = runFsck inc file key
-perform :: Key -> FilePath -> Backend -> Maybe Int -> Annex Bool
+perform :: Key -> FilePath -> Backend -> Maybe NumCopies -> Annex Bool
perform key file backend numcopies = check
-- order matters
[ fixLink key file
@@ -132,7 +133,7 @@ perform key file backend numcopies = check
{- To fsck a remote, the content is retrieved to a tmp file,
- and checked locally. -}
-performRemote :: Key -> FilePath -> Backend -> Maybe Int -> Remote -> Annex Bool
+performRemote :: Key -> FilePath -> Backend -> Maybe NumCopies -> Remote -> Annex Bool
performRemote key file backend numcopies remote =
dispatch =<< Remote.hasKey remote key
where
@@ -368,11 +369,11 @@ checkBackendOr' bad backend key file postcheck =
, return True
)
-checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
+checkKeyNumCopies :: Key -> FilePath -> Maybe NumCopies -> Annex Bool
checkKeyNumCopies key file numcopies = do
needed <- getNumCopies numcopies
(untrustedlocations, safelocations) <- trustPartition UnTrusted =<< Remote.keyLocations key
- let present = length safelocations
+ let present = NumCopies (length safelocations)
if present < needed
then do
ppuuids <- Remote.prettyPrintUUIDs "untrusted" untrustedlocations
@@ -380,15 +381,15 @@ checkKeyNumCopies key file numcopies = do
return False
else return True
-missingNote :: String -> Int -> Int -> String -> String
-missingNote file 0 _ [] =
+missingNote :: String -> NumCopies -> NumCopies -> String -> String
+missingNote file (NumCopies 0) _ [] =
"** No known copies exist of " ++ file
-missingNote file 0 _ untrusted =
+missingNote file (NumCopies 0) _ untrusted =
"Only these untrusted locations may have copies of " ++ file ++
"\n" ++ untrusted ++
"Back it up to trusted locations with git-annex copy."
missingNote file present needed [] =
- "Only " ++ show present ++ " of " ++ show needed ++
+ "Only " ++ show (fromNumCopies present) ++ " of " ++ show (fromNumCopies needed) ++
" trustworthy copies exist of " ++ file ++
"\nBack it up with git-annex copy."
missingNote file present needed untrusted =
diff --git a/Command/Get.hs b/Command/Get.hs
index c83692a8d..74d5068d3 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -12,6 +12,7 @@ import Command
import qualified Remote
import Annex.Content
import Logs.Transfer
+import Logs.NumCopies
import Annex.Wanted
import GitAnnex.Options
import qualified Command.Move
diff --git a/Command/Info.hs b/Command/Info.hs
index fde51968d..c62dc3844 100644
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -29,6 +29,7 @@ import Annex.Content
import Types.Key
import Logs.UUID
import Logs.Trust
+import Logs.NumCopies
import Remote
import Config
import Utility.Percentage
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index cf4663cb5..e5ce33ec0 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -16,6 +16,7 @@ import qualified Command.Get
import qualified Remote
import Annex.Content
import qualified Annex
+import Logs.NumCopies
def :: [Command]
def = [withOptions (fromToOptions ++ keyOptions) $
@@ -33,10 +34,10 @@ seek ps = do
start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start to from file (key, _backend) = do
- numcopies <- numCopies file
+ numcopies <- getFileNumCopies file
startKey numcopies to from (Just file) key
-startKey :: Maybe Int -> Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
+startKey :: Maybe NumCopies -> Maybe Remote -> Maybe Remote -> Maybe FilePath -> Key -> CommandStart
startKey numcopies to from afile key = do
noAuto
case (from, to) of
diff --git a/Command/NumCopies.hs b/Command/NumCopies.hs
index 804faff58..51bde2e68 100644
--- a/Command/NumCopies.hs
+++ b/Command/NumCopies.hs
@@ -39,7 +39,7 @@ startGet = next $ next $ do
Annex.setOutput QuietOutput
v <- getGlobalNumCopies
case v of
- Just n -> liftIO $ putStrLn $ show n
+ Just n -> liftIO $ putStrLn $ show $ fromNumCopies n
Nothing -> do
liftIO $ putStrLn $ "global numcopies is not set"
old <- annexNumCopies <$> Annex.getGitConfig
@@ -52,5 +52,5 @@ startSet :: Int -> CommandStart
startSet n = do
showStart "numcopies" (show n)
next $ next $ do
- setGlobalNumCopies n
+ setGlobalNumCopies $ NumCopies n
return True
diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs
index 9c05702be..b42628609 100644
--- a/Command/TransferKeys.hs
+++ b/Command/TransferKeys.hs
@@ -106,34 +106,34 @@ readResponse h = fromMaybe False . deserialize <$> hGetLine h
fieldSep :: String
fieldSep = "\0"
-class Serialized a where
+class TCSerialized a where
serialize :: a -> String
deserialize :: String -> Maybe a
-instance Serialized Bool where
+instance TCSerialized Bool where
serialize True = "1"
serialize False = "0"
deserialize "1" = Just True
deserialize "0" = Just False
deserialize _ = Nothing
-instance Serialized Direction where
+instance TCSerialized Direction where
serialize Upload = "u"
serialize Download = "d"
deserialize "u" = Just Upload
deserialize "d" = Just Download
deserialize _ = Nothing
-instance Serialized AssociatedFile where
+instance TCSerialized AssociatedFile where
serialize (Just f) = f
serialize Nothing = ""
deserialize "" = Just Nothing
deserialize f = Just $ Just f
-instance Serialized UUID where
+instance TCSerialized UUID where
serialize = fromUUID
deserialize = Just . toUUID
-instance Serialized Key where
+instance TCSerialized Key where
serialize = key2file
deserialize = file2key
diff --git a/Config.hs b/Config.hs
index 0ccf1b5c0..376a3a488 100644
--- a/Config.hs
+++ b/Config.hs
@@ -69,13 +69,6 @@ setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)
setRemoteAvailability :: Git.Repo -> Availability -> Annex ()
setRemoteAvailability r c = setConfig (remoteConfig r "availability") (show c)
-getNumCopies :: Maybe Int -> Annex Int
-getNumCopies (Just v) = return v
-getNumCopies Nothing = deprecatedNumCopies
-
-deprecatedNumCopies :: Annex Int
-deprecatedNumCopies = fromMaybe 1 . annexNumCopies <$> Annex.getGitConfig
-
isDirect :: Annex Bool
isDirect = annexDirect <$> Annex.getGitConfig
diff --git a/GitAnnex/Options.hs b/GitAnnex/Options.hs
index ad1e0c93b..063ca995b 100644
--- a/GitAnnex/Options.hs
+++ b/GitAnnex/Options.hs
@@ -14,6 +14,7 @@ import qualified Git.Config
import Git.Types
import Command
import Types.TrustLevel
+import Types.NumCopies
import Types.Messages
import qualified Annex
import qualified Remote
@@ -65,7 +66,7 @@ options = Option.common ++
where
trustArg t = ReqArg (Remote.forceTrust t) paramRemote
setnumcopies v = maybe noop
- (\n -> Annex.changeState $ \s -> s { Annex.globalnumcopies = Just n })
+ (\n -> Annex.changeState $ \s -> s { Annex.globalnumcopies = Just $ NumCopies n })
(readish v)
setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
setgitconfig v = inRepo (Git.Config.store v)
diff --git a/Limit.hs b/Limit.hs
index c0d32c68e..9d62fecc1 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -197,7 +197,7 @@ limitNumCopiesNeeded want = case readish want of
gv <- getGlobalNumCopies
case gv of
Nothing -> return False
- Just numcopies -> do
+ Just (NumCopies numcopies) -> do
us <- filter (`S.notMember` notpresent)
<$> (trustExclude UnTrusted =<< Remote.keyLocations key)
return $ numcopies - length us >= needed
diff --git a/Logs/NumCopies.hs b/Logs/NumCopies.hs
index dc345dd0a..2fd6f75f8 100644
--- a/Logs/NumCopies.hs
+++ b/Logs/NumCopies.hs
@@ -7,27 +7,71 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Logs.NumCopies where
+module Logs.NumCopies (
+ module Types.NumCopies,
+ setGlobalNumCopies,
+ getGlobalNumCopies,
+ globalNumCopiesLoad,
+ getFileNumCopies,
+ numCopiesCheck,
+ getNumCopies,
+ deprecatedNumCopies,
+) where
import Common.Annex
import qualified Annex
+import Types.NumCopies
import Logs
import Logs.SingleValue
+import Logs.Trust
+import Annex.CheckAttr
+import qualified Remote
-instance Serializable Int where
- serialize = show
- deserialize = readish
+instance SingleValueSerializable NumCopies where
+ serialize (NumCopies n) = show n
+ deserialize = NumCopies <$$> readish
-setGlobalNumCopies :: Int -> Annex ()
+setGlobalNumCopies :: NumCopies -> Annex ()
setGlobalNumCopies = setLog numcopiesLog
{- Cached for speed. -}
-getGlobalNumCopies :: Annex (Maybe Int)
-getGlobalNumCopies = maybe numCopiesLoad (return . Just)
+getGlobalNumCopies :: Annex (Maybe NumCopies)
+getGlobalNumCopies = maybe globalNumCopiesLoad (return . Just)
=<< Annex.getState Annex.globalnumcopies
-numCopiesLoad :: Annex (Maybe Int)
-numCopiesLoad = do
+globalNumCopiesLoad :: Annex (Maybe NumCopies)
+globalNumCopiesLoad = do
v <- getLog numcopiesLog
Annex.changeState $ \s -> s { Annex.globalnumcopies = v }
return v
+
+{- Numcopies value for a file, from .gitattributes or global,
+ - but not the deprecated git config. -}
+getFileNumCopies :: FilePath -> Annex (Maybe NumCopies)
+getFileNumCopies file = do
+ global <- getGlobalNumCopies
+ case global of
+ Just n -> return $ Just n
+ Nothing -> (NumCopies <$$> readish)
+ <$> checkAttr "annex.numcopies" file
+
+deprecatedNumCopies :: Annex NumCopies
+deprecatedNumCopies = NumCopies . fromMaybe 1 . annexNumCopies
+ <$> Annex.getGitConfig
+
+{- Checks if numcopies are satisfied by running a comparison
+ - between the number of (not untrusted) copies that are
+ - belived to exist, and the configured value.
+ -
+ - Includes the deprecated annex.numcopies git config if
+ - nothing else specifies a numcopies value. -}
+numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v
+numCopiesCheck file key vs = do
+ numcopiesattr <- getFileNumCopies file
+ NumCopies needed <- getNumCopies numcopiesattr
+ have <- trustExclude UnTrusted =<< Remote.keyLocations key
+ return $ length have `vs` needed
+
+getNumCopies :: Maybe NumCopies -> Annex NumCopies
+getNumCopies (Just v) = return v
+getNumCopies Nothing = deprecatedNumCopies
diff --git a/Logs/SingleValue.hs b/Logs/SingleValue.hs
index 03975df92..cbebdc8e5 100644
--- a/Logs/SingleValue.hs
+++ b/Logs/SingleValue.hs
@@ -21,7 +21,7 @@ import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
-class Serializable v where
+class SingleValueSerializable v where
serialize :: v -> String
deserialize :: String -> Maybe v
@@ -32,12 +32,12 @@ data LogEntry v = LogEntry
type Log v = S.Set (LogEntry v)
-showLog :: (Serializable v) => Log v -> String
+showLog :: (SingleValueSerializable v) => Log v -> String
showLog = unlines . map showline . S.toList
where
showline (LogEntry t v) = unwords [show t, serialize v]
-parseLog :: (Ord v, Serializable v) => String -> Log v
+parseLog :: (Ord v, SingleValueSerializable v) => String -> Log v
parseLog = S.fromList . mapMaybe parse . lines
where
parse line = do
@@ -52,13 +52,13 @@ newestValue s
| S.null s = Nothing
| otherwise = Just (value $ S.findMax s)
-readLog :: (Ord v, Serializable v) => FilePath -> Annex (Log v)
+readLog :: (Ord v, SingleValueSerializable v) => FilePath -> Annex (Log v)
readLog = parseLog <$$> Annex.Branch.get
-getLog :: (Ord v, Serializable v) => FilePath -> Annex (Maybe v)
+getLog :: (Ord v, SingleValueSerializable v) => FilePath -> Annex (Maybe v)
getLog = newestValue <$$> readLog
-setLog :: (Serializable v) => FilePath -> v -> Annex ()
+setLog :: (SingleValueSerializable v) => FilePath -> v -> Annex ()
setLog f v = do
now <- liftIO getPOSIXTime
let ent = LogEntry now v
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs
index 42c71b760..1e17a2c4c 100644
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@@ -229,11 +229,11 @@ type ProtocolVersion = Int
supportedProtocolVersions :: [ProtocolVersion]
supportedProtocolVersions = [1]
-class Serializable a where
+class ExternalSerializable a where
serialize :: a -> String
deserialize :: String -> Maybe a
-instance Serializable Direction where
+instance ExternalSerializable Direction where
serialize Upload = "STORE"
serialize Download = "RETRIEVE"
@@ -241,23 +241,23 @@ instance Serializable Direction where
deserialize "RETRIEVE" = Just Download
deserialize _ = Nothing
-instance Serializable Key where
+instance ExternalSerializable Key where
serialize = key2file
deserialize = file2key
-instance Serializable [Char] where
+instance ExternalSerializable [Char] where
serialize = id
deserialize = Just
-instance Serializable ProtocolVersion where
+instance ExternalSerializable ProtocolVersion where
serialize = show
deserialize = readish
-instance Serializable Cost where
+instance ExternalSerializable Cost where
serialize = show
deserialize = readish
-instance Serializable Availability where
+instance ExternalSerializable Availability where
serialize GloballyAvailable = "GLOBAL"
serialize LocallyAvailable = "LOCAL"
@@ -265,7 +265,7 @@ instance Serializable Availability where
deserialize "LOCAL" = Just LocallyAvailable
deserialize _ = Nothing
-instance Serializable BytesProcessed where
+instance ExternalSerializable BytesProcessed where
serialize (BytesProcessed n) = show n
deserialize = BytesProcessed <$$> readish
@@ -283,15 +283,15 @@ parse0 :: a -> Parser a
parse0 mk "" = Just mk
parse0 _ _ = Nothing
-parse1 :: Serializable p1 => (p1 -> a) -> Parser a
+parse1 :: ExternalSerializable p1 => (p1 -> a) -> Parser a
parse1 mk p1 = mk <$> deserialize p1
-parse2 :: (Serializable p1, Serializable p2) => (p1 -> p2 -> a) -> Parser a
+parse2 :: (ExternalSerializable p1, ExternalSerializable p2) => (p1 -> p2 -> a) -> Parser a
parse2 mk s = mk <$> deserialize p1 <*> deserialize p2
where
(p1, p2) = splitWord s
-parse3 :: (Serializable p1, Serializable p2, Serializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a
+parse3 :: (ExternalSerializable p1, ExternalSerializable p2, ExternalSerializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a
parse3 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3
where
(p1, rest) = splitWord s
diff --git a/Types/NumCopies.hs b/Types/NumCopies.hs
new file mode 100644
index 000000000..b93fcf968
--- /dev/null
+++ b/Types/NumCopies.hs
@@ -0,0 +1,14 @@
+{- git-annex numcopies type
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.NumCopies where
+
+newtype NumCopies = NumCopies Int
+ deriving (Ord, Eq)
+
+fromNumCopies :: NumCopies -> Int
+fromNumCopies (NumCopies n) = n