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
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue