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
|
{- 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
|
