diff options
author | Joey Hess <joey@kitenet.net> | 2014-01-21 16:08:19 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2014-01-21 16:08:59 -0400 |
commit | d5f7fb27aad3e2e9c4bebb9ccd5577af8deb25c7 (patch) | |
tree | 838837e3112942fcf0f82cfc7f68e62a6f4e7a6e | |
parent | 9a8709f064c7608859b3155a752093b29cd8ab98 (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.hs | 3 | ||||
-rw-r--r-- | Annex/Drop.hs | 10 | ||||
-rw-r--r-- | Assistant/Threads/ConfigMonitor.hs | 2 | ||||
-rw-r--r-- | Command.hs | 21 | ||||
-rw-r--r-- | Command/Copy.hs | 1 | ||||
-rw-r--r-- | Command/Drop.hs | 30 | ||||
-rw-r--r-- | Command/Fsck.hs | 19 | ||||
-rw-r--r-- | Command/Get.hs | 1 | ||||
-rw-r--r-- | Command/Info.hs | 1 | ||||
-rw-r--r-- | Command/Mirror.hs | 5 | ||||
-rw-r--r-- | Command/NumCopies.hs | 4 | ||||
-rw-r--r-- | Command/TransferKeys.hs | 12 | ||||
-rw-r--r-- | Config.hs | 7 | ||||
-rw-r--r-- | GitAnnex/Options.hs | 3 | ||||
-rw-r--r-- | Limit.hs | 2 | ||||
-rw-r--r-- | Logs/NumCopies.hs | 62 | ||||
-rw-r--r-- | Logs/SingleValue.hs | 12 | ||||
-rw-r--r-- | Remote/External/Types.hs | 22 | ||||
-rw-r--r-- | Types/NumCopies.hs | 14 |
19 files changed, 135 insertions, 96 deletions
@@ -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 @@ -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) @@ -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 |