summaryrefslogtreecommitdiff
path: root/Logs/Transitions.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-08-28 15:57:42 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-08-28 15:57:42 -0400
commit0ffe5408ae1b396453f080bef2858542317daf23 (patch)
tree1fe478130f94ac1d1535ce650aff6c0b86a831b8 /Logs/Transitions.hs
parent0a297232a206af8330dc4fe9acc5916d6ba32f19 (diff)
untested transition detection on merging, and transition running code
Diffstat (limited to 'Logs/Transitions.hs')
-rw-r--r--Logs/Transitions.hs30
1 files changed, 17 insertions, 13 deletions
diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs
index e548a2f23..41f4b2635 100644
--- a/Logs/Transitions.hs
+++ b/Logs/Transitions.hs
@@ -46,6 +46,10 @@ data TransitionLine = TransitionLine
type Transitions = S.Set TransitionLine
+describeTransition :: Transition -> String
+describeTransition ForgetGitHistory = "forget git history"
+describeTransition ForgetDeadRemotes = "forget dead remotes"
+
addTransition :: POSIXTime -> Transition -> Transitions -> Transitions
addTransition ts t = S.insert $ TransitionLine ts t
@@ -60,6 +64,11 @@ parseTransitions = check . map parseTransitionLine . lines
| all isJust l = Just $ S.fromList $ catMaybes l
| otherwise = Nothing
+parseTransitionsStrictly :: String -> String -> Transitions
+parseTransitionsStrictly source = fromMaybe badsource . parseTransitions
+ where
+ badsource = error $ "unknown transitions listed in " ++ source ++ "; upgrade git-annex!"
+
showTransitionLine :: TransitionLine -> String
showTransitionLine (TransitionLine ts t) = unwords [show t, show ts]
@@ -71,17 +80,14 @@ parseTransitionLine s = TransitionLine <$> pdate ds <*> readish ts
ds = unwords $ Prelude.tail ws
pdate = parseTime defaultTimeLocale "%s%Qs" >=*> utcTimeToPOSIXSeconds
-{- Compares two sets of transitions, and returns a list of any transitions
- - from the second set that have not yet been perfomed in the first,
- - and a list of any transitions from the first set that have not yet been
- - performed in the second. -}
-diffTransitions :: Transitions -> Transitions -> ([Transition], [Transition])
-diffTransitions a b = (b `diff` a, a `diff` b)
- where
- diff x y = map transition $ S.elems $ S.difference x y
+combineTransitions :: [Transitions] -> Transitions
+combineTransitions = S.unions
+
+inTransitions :: Transition -> Transitions -> Bool
+inTransitions t = not . S.null . S.filter (\l -> transition l == t)
-sameTransitions :: Transitions -> Transitions -> Bool
-sameTransitions a b = let (x, y) = diffTransitions a b in null x && null y
+transitionList :: Transitions -> [Transition]
+transitionList = map transition . S.elems
{- Typically ran with Annex.Branch.change, but we can't import Annex.Branch
- here since it depends on this module. -}
@@ -89,6 +95,4 @@ recordTransition :: (FilePath -> (String -> String) -> Annex ()) -> Transition -
recordTransition changer o = do
t <- liftIO getPOSIXTime
changer transitionsLog $
- showTransitions . addTransition t o . fromMaybe badlog . parseTransitions
- where
- badlog = error $ "unknown transitions exist in " ++ transitionsLog
+ showTransitions . addTransition t o . parseTransitionsStrictly "local"