diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-01-27 17:38:06 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-01-27 17:38:06 -0400 |
commit | 70736d2b413a321823490c7a6ec31d49535d18d2 (patch) | |
tree | 9aa44cb79a31a939622914947e8765a06562b094 /Types/Difference.hs | |
parent | b11a7b0ace25c0f43558a8a01a94adb387c9cdc3 (diff) |
Repository tuning parameters can now be passed when initializing a repository for the first time.
* init: Repository tuning parameters can now be passed when initializing a
repository for the first time. For details, see
http://git-annex.branchable.com/tuning/
* merge: Refuse to merge changes from a git-annex branch of a repo
that has been tuned in incompatable ways.
Diffstat (limited to 'Types/Difference.hs')
-rw-r--r-- | Types/Difference.hs | 135 |
1 files changed, 135 insertions, 0 deletions
diff --git a/Types/Difference.hs b/Types/Difference.hs new file mode 100644 index 0000000000..cbfad0fceb --- /dev/null +++ b/Types/Difference.hs @@ -0,0 +1,135 @@ +{- git-annex repository differences + - + - Copyright 2015 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.Difference ( + Difference(..), + Differences(..), + getDifferences, + sanityCheckDifferences, + differenceConfigKey, + differenceConfigVal, + hasDifference, +) where + +import Utility.PartialPrelude +import qualified Git +import qualified Git.Config + +import Data.List +import Data.Maybe +import Data.Monoid +import Control.Applicative + +-- Describes differences from the v5 repository format. +-- +-- The serilization is stored in difference.log, so avoid changes that +-- would break compatability. +-- +-- Not breaking comparability is why a list of Differences is used, rather +-- than a sum type. With a sum type, adding a new field for some future +-- difference would serialize to a value that an older version could not +-- parse, even if that new field was not used. With the Differences list, +-- old versions can still parse it, unless the new Difference constructor +-- is used. +data Difference + = Version Int + | ObjectHashLower Bool + | ObjectHashDirectories Int + | BranchHashDirectories Int + deriving (Show, Read, Ord) + +instance Eq Difference where + Version a == Version b = a == b + ObjectHashLower a == ObjectHashLower b = a == b + ObjectHashDirectories a == ObjectHashDirectories b = a == b + BranchHashDirectories a == BranchHashDirectories b = a == b + _ == _ = False + +data Differences + = Differences [Difference] + | UnknownDifferences + deriving (Show, Read, Ord) + +instance Eq Differences where + Differences a == Differences b = simplify (defver:a) == simplify (defver:b) + _ == _ = False + +instance Monoid Differences where + mempty = Differences [] + mappend (Differences l1) (Differences l2) = Differences (simplify (l1 ++ l2)) + mappend _ _ = UnknownDifferences + +-- This is the default repository version that is assumed when no other one +-- is given. Note that [] == [Version 5] +defver :: Difference +defver = Version 5 + +-- Larger values of the same Difference constructor dominate +-- over smaller values, so given [Version 6, Version 5], returns [Version 6] +simplify :: [Difference] -> [Difference] +simplify = go . sort + where + go [] = [] + go (d:[]) = [d] + go (d1:d2:ds) + | like d1 d2 = go (d2:ds) + | otherwise = d1 : go (d2:ds) + + like (Version _) (Version _) = True + like (ObjectHashLower _) (ObjectHashLower _) = True + like (ObjectHashDirectories _) (ObjectHashDirectories _) = True + like (BranchHashDirectories _) (BranchHashDirectories _) = True + like _ _ = False + +getDifferences :: Git.Repo -> Differences +getDifferences r = checksane $ Differences $ catMaybes + [ ObjectHashLower + <$> getmaybebool (differenceConfigKey (ObjectHashLower undefined)) + , ObjectHashDirectories + <$> getmayberead (differenceConfigKey (ObjectHashDirectories undefined)) + , BranchHashDirectories + <$> getmayberead (differenceConfigKey (BranchHashDirectories undefined)) + ] + where + getmaybe k = Git.Config.getMaybe k r + getmayberead k = readish =<< getmaybe k + getmaybebool k = Git.Config.isTrue =<< getmaybe k + checksane = either error id . sanityCheckDifferences + +differenceConfigKey :: Difference -> String +differenceConfigKey (Version _) = "annex.version" +differenceConfigKey (ObjectHashLower _) = tunable "objecthashlower" +differenceConfigKey (ObjectHashDirectories _) = tunable "objecthashdirectories" +differenceConfigKey (BranchHashDirectories _) = tunable "branchhashdirectories" + +differenceConfigVal :: Difference -> String +differenceConfigVal (Version v) = show v +differenceConfigVal (ObjectHashLower b) = Git.Config.boolConfig b +differenceConfigVal (ObjectHashDirectories n) = show n +differenceConfigVal (BranchHashDirectories n) = show n + +tunable :: String -> String +tunable k = "annex.tune." ++ k + +sanityCheckDifferences :: Differences -> Either String Differences +sanityCheckDifferences d@(Differences l) + | null problems = Right d + | otherwise = Left (intercalate "; " problems) + where + problems = catMaybes (map check l) + check (ObjectHashDirectories n) + | n == 1 || n == 2 = Nothing + | otherwise = Just $ "Bad value for objecthashdirectories -- should be 1 or 2, not " ++ show n + check (BranchHashDirectories n) + | n == 1 || n == 2 = Nothing + | otherwise = Just $ "Bad value for branhhashdirectories -- should be 1 or 2, not " ++ show n + check _ = Nothing +sanityCheckDifferences UnknownDifferences = Left "unknown differences detected; update git-annex" + +hasDifference :: (Difference -> Bool) -> Differences -> Bool +hasDifference f (Differences l) = any f l +hasDifference _ UnknownDifferences = False |