summaryrefslogtreecommitdiff
path: root/Types
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-01-28 13:47:41 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-01-28 13:50:02 -0400
commitf351b887265f0abce8d52ffcb7b9b2ee7bd8bc81 (patch)
treec7cb719e91b82bee7f4ea8e74732dd3f3d4dc103 /Types
parent6a8efb186432cd9b8fa7a61f8129303f5bcc9e1f (diff)
rework Differences data type
Eliminated complexity and future proofed. The most important change is that all functions over Difference are now total; any Difference that can be expressed should be handled. Avoids needs for sanity checking of inputs, and version skew with the future. Also, the difference.log now serializes a [Difference], not a Differences. This saves space and keeps it simpler. Note that [Difference] might contain conflicting differences (eg, [Version5, Version6]. In this case, one of them needs to consistently win over the others, probably based on Ord.
Diffstat (limited to 'Types')
-rw-r--r--Types/Difference.hs97
1 files changed, 24 insertions, 73 deletions
diff --git a/Types/Difference.hs b/Types/Difference.hs
index 7d0c28224..f92a30736 100644
--- a/Types/Difference.hs
+++ b/Types/Difference.hs
@@ -9,123 +9,74 @@ 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
+-- The serialization is stored in difference.log, so avoid changes that
-- would break compatability.
--
--- Not breaking comparability is why a list of Differences is used, rather
+-- Not breaking compatability 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.
+--
+-- 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
- = 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
+ = ObjectHashLower
+ | OneLevelObjectHash
+ | OneLevelBranchHash
+ deriving (Show, Read, Ord, Eq, Enum, Bounded)
data Differences
= Differences [Difference]
| UnknownDifferences
- deriving (Show, Read, Ord)
instance Eq Differences where
- Differences a == Differences b = simplify (defver:a) == simplify (defver:b)
- _ == _ = False
+ Differences a == Differences b = canon a == canon b
+ _ == _ = False -- UnknownDifferences cannot be equal
instance Monoid Differences where
mempty = Differences []
- mappend (Differences l1) (Differences l2) = Differences (simplify (l1 ++ l2))
+ mappend (Differences l1) (Differences l2) = Differences (canon (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
-
--- 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 _ _ = False
+canon :: [Difference] -> [Difference]
+canon = nub . sort
getDifferences :: Git.Repo -> Differences
-getDifferences r = checksane $ Differences $ catMaybes
- [ ObjectHashLower
- <$> getmaybebool (differenceConfigKey (ObjectHashLower undefined))
- , ObjectHashDirectories
- <$> getmayberead (differenceConfigKey (ObjectHashDirectories undefined))
- , BranchHashDirectories
- <$> getmayberead (differenceConfigKey (BranchHashDirectories undefined))
- ]
+getDifferences r = Differences $ catMaybes $
+ map getmaybe [minBound .. maxBound]
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
+ getmaybe d = case Git.Config.isTrue =<< Git.Config.getMaybe (differenceConfigKey d) r of
+ Just True -> Just d
+ _ -> Nothing
differenceConfigKey :: Difference -> String
-differenceConfigKey (Version _) = "annex.version"
-differenceConfigKey (ObjectHashLower _) = tunable "objecthashlower"
-differenceConfigKey (ObjectHashDirectories _) = tunable "objecthashdirectories"
-differenceConfigKey (BranchHashDirectories _) = tunable "branchhashdirectories"
+differenceConfigKey ObjectHashLower = tunable "objecthashlower"
+differenceConfigKey OneLevelObjectHash = tunable "objecthash1"
+differenceConfigKey OneLevelBranchHash = tunable "branchhash1"
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
+differenceConfigVal _ = Git.Config.boolConfig True
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