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.
This commit is contained in:
parent
e38a21a768
commit
b40df4f0d0
20 changed files with 137 additions and 98 deletions
3
Annex.hs
3
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -82,7 +82,7 @@ prefsAForm def = PrefsForm
|
|||
getPrefs :: Annex PrefsForm
|
||||
getPrefs = PrefsForm
|
||||
<$> (T.pack . roughSize storageUnits False . annexDiskReserve <$> Annex.getGitConfig)
|
||||
<*> (maybe deprecatedNumCopies return =<< getGlobalNumCopies)
|
||||
<*> (fromNumCopies <$> (maybe deprecatedNumCopies return =<< getGlobalNumCopies))
|
||||
<*> inAutoStartFile
|
||||
<*> (annexAutoUpgrade <$> Annex.getGitConfig)
|
||||
<*> (annexDebug <$> Annex.getGitConfig)
|
||||
|
@ -90,7 +90,7 @@ getPrefs = PrefsForm
|
|||
storePrefs :: PrefsForm -> Annex ()
|
||||
storePrefs p = do
|
||||
setConfig (annexConfig "diskreserve") (T.unpack $ diskReserve p)
|
||||
setGlobalNumCopies (numCopies p)
|
||||
setGlobalNumCopies (NumCopies $ numCopies p)
|
||||
unsetConfig (annexConfig "numcopies") -- deprecated
|
||||
setConfig (annexConfig "autoupgrade") (fromAutoUpgrade $ autoUpgrade p)
|
||||
unlessM ((==) <$> pure (autoStart p) <*> inAutoStartFile) $ do
|
||||
|
|
21
Command.hs
21
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 )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
2
Limit.hs
2
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
22
Remote/External/Types.hs
vendored
22
Remote/External/Types.hs
vendored
|
@ -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
|
||||
|
|
14
Types/NumCopies.hs
Normal file
14
Types/NumCopies.hs
Normal file
|
@ -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
|
Loading…
Add table
Reference in a new issue