9a5ddda511
Drop support for building with ghc older than 8.4.4, and with older versions of serveral haskell libraries than will be included in Debian 10. The only remaining version ifdefs in the entire code base are now a couple for aws! This commit should only be merged after the Debian 10 release. And perhaps it will need to wait longer than that; it would make backporting new versions of git-annex to Debian 9 (stretch) which has been actively happening as recently as this year. This commit was sponsored by Ilya Shlyakhter.
132 lines
4.1 KiB
Haskell
132 lines
4.1 KiB
Haskell
{- git-annex repository differences
|
|
-
|
|
- Copyright 2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
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
|
|
|
|
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
|