aboutsummaryrefslogtreecommitdiff
path: root/Logs
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 /Logs
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.
Diffstat (limited to 'Logs')
-rw-r--r--Logs/NumCopies.hs62
-rw-r--r--Logs/SingleValue.hs12
2 files changed, 59 insertions, 15 deletions
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