1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
|
{- git-annex repository differences
-
- Copyright 2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Types.Difference (
Difference(..),
Differences(..),
readDifferences,
showDifferences,
getDifferences,
differenceConfigKey,
differenceConfigVal,
hasDifference,
listDifferences,
) where
import Utility.PartialPrelude
import qualified Git
import qualified Git.Config
import Data.Maybe
import Data.Monoid
import qualified Data.Set as S
import qualified Data.Semigroup as Sem
import Prelude
-- Describes differences from the v5 repository format.
--
-- The serialization is stored in difference.log, so avoid changes that
-- would break compatability.
--
-- Not breaking compatability is why a list of Differences is used, rather
-- than a record type. With a record 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.
--
-- The constructors intentionally do not have parameters; this is to
-- ensure that any Difference that can be expressed is supported.
-- So, a new repository version would be Version6, rather than Version Int.
data Difference
= ObjectHashLower
| OneLevelObjectHash
| OneLevelBranchHash
deriving (Show, Read, Eq, Ord, Enum, Bounded)
-- This type is used internally for efficient checking for differences,
-- but converted to S.Set Difference for serialization.
data Differences
= Differences
{ objectHashLower :: Bool
, oneLevelObjectHash :: Bool
, oneLevelBranchHash :: Bool
}
| UnknownDifferences
-- UnknownDifferences cannot be equal
instance Eq Differences where
UnknownDifferences == _ = False
_ == UnknownDifferences = False
a == b = all (\f -> f a == f b)
[ objectHashLower
, oneLevelObjectHash
, oneLevelBranchHash
]
appendDifferences :: Differences -> Differences -> Differences
appendDifferences a@(Differences {}) b@(Differences {}) = a
{ objectHashLower = objectHashLower a || objectHashLower b
, oneLevelObjectHash = oneLevelObjectHash a || oneLevelObjectHash b
, oneLevelBranchHash = oneLevelBranchHash a || oneLevelBranchHash b
}
appendDifferences _ _ = UnknownDifferences
instance Sem.Semigroup Differences where
(<>) = appendDifferences
instance Monoid Differences where
mempty = Differences False False False
#if ! MIN_VERSION_base(4,11,0)
mappend = (Sem.<>)
#endif
readDifferences :: String -> Differences
readDifferences = maybe UnknownDifferences mkDifferences . readish
showDifferences :: Differences -> String
showDifferences = show . S.fromList . listDifferences
getDifferences :: Git.Repo -> Differences
getDifferences r = mkDifferences $ S.fromList $
mapMaybe getmaybe [minBound .. maxBound]
where
getmaybe d = case Git.Config.isTrue =<< Git.Config.getMaybe (differenceConfigKey d) r of
Just True -> Just d
_ -> Nothing
differenceConfigKey :: Difference -> String
differenceConfigKey ObjectHashLower = tunable "objecthashlower"
differenceConfigKey OneLevelObjectHash = tunable "objecthash1"
differenceConfigKey OneLevelBranchHash = tunable "branchhash1"
differenceConfigVal :: Difference -> String
differenceConfigVal _ = Git.Config.boolConfig True
tunable :: String -> String
tunable k = "annex.tune." ++ k
hasDifference :: Difference -> Differences -> Bool
hasDifference _ UnknownDifferences = False
hasDifference ObjectHashLower ds = objectHashLower ds
hasDifference OneLevelObjectHash ds = oneLevelObjectHash ds
hasDifference OneLevelBranchHash ds = oneLevelBranchHash ds
listDifferences :: Differences -> [Difference]
listDifferences d@(Differences {}) = map snd $
filter (\(f, _) -> f d)
[ (objectHashLower, ObjectHashLower)
, (oneLevelObjectHash, OneLevelObjectHash)
, (oneLevelBranchHash, OneLevelBranchHash)
]
listDifferences UnknownDifferences = []
mkDifferences :: S.Set Difference -> Differences
mkDifferences s = Differences
{ objectHashLower = check ObjectHashLower
, oneLevelObjectHash = check OneLevelObjectHash
, oneLevelBranchHash = check OneLevelBranchHash
}
where
check f = f `S.member` s
|