40ecf58d4b
This does not change the overall license of the git-annex program, which was already AGPL due to a number of sources files being AGPL already. Legally speaking, I'm adding a new license under which these files are now available; I already released their current contents under the GPL license. Now they're dual licensed GPL and AGPL. However, I intend for all my future changes to these files to only be released under the AGPL license, and I won't be tracking the dual licensing status, so I'm simply changing the license statement to say it's AGPL. (In some cases, others wrote parts of the code of a file and released it under the GPL; but in all cases I have contributed a significant portion of the code in each file and it's that code that is getting the AGPL license; the GPL license of other contributors allows combining with AGPL code.)
99 lines
3.3 KiB
Haskell
99 lines
3.3 KiB
Haskell
{- git-annex transitions log
|
|
-
|
|
- This is used to record transitions that have been performed on the
|
|
- git-annex branch, and when the transition was first started.
|
|
-
|
|
- We can quickly detect when the local branch has already had an transition
|
|
- done that is listed in the remote branch by checking that the local
|
|
- branch contains the same transition, with the same or newer start time.
|
|
-
|
|
- Copyright 2013-2019 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Logs.Transitions where
|
|
|
|
import Annex.Common
|
|
import Annex.VectorClock
|
|
import Logs.Line
|
|
|
|
import qualified Data.Set as S
|
|
import Data.Either
|
|
import Data.ByteString (ByteString)
|
|
import Data.ByteString.Builder
|
|
import qualified Data.ByteString.Lazy as L
|
|
import qualified Data.Attoparsec.ByteString.Lazy as A
|
|
import qualified Data.Attoparsec.ByteString.Char8 as A8
|
|
|
|
transitionsLog :: FilePath
|
|
transitionsLog = "transitions.log"
|
|
|
|
data Transition
|
|
= ForgetGitHistory
|
|
| ForgetDeadRemotes
|
|
deriving (Show, Ord, Eq, Read)
|
|
|
|
data TransitionLine = TransitionLine
|
|
{ transitionStarted :: VectorClock
|
|
-- New transitions that we don't know about yet are preserved.
|
|
, transition :: Either ByteString Transition
|
|
} deriving (Ord, Eq)
|
|
|
|
type Transitions = S.Set TransitionLine
|
|
|
|
describeTransition :: Transition -> String
|
|
describeTransition ForgetGitHistory = "forget git history"
|
|
describeTransition ForgetDeadRemotes = "forget dead remotes"
|
|
|
|
noTransitions :: Transitions
|
|
noTransitions = S.empty
|
|
|
|
addTransition :: VectorClock -> Transition -> Transitions -> Transitions
|
|
addTransition c t = S.insert $ TransitionLine c (Right t)
|
|
|
|
buildTransitions :: Transitions -> Builder
|
|
buildTransitions = mconcat . map genline . S.elems
|
|
where
|
|
genline tl = buildt (transition tl) <> charUtf8 ' '
|
|
<> buildVectorClock (transitionStarted tl) <> charUtf8 '\n'
|
|
buildt (Left b) = byteString b
|
|
buildt (Right t) = byteString (encodeBS (show t))
|
|
|
|
parseTransitions :: L.ByteString -> Transitions
|
|
parseTransitions = fromMaybe S.empty . A.maybeResult . A.parse
|
|
(S.fromList <$> parseLogLines transitionLineParser)
|
|
|
|
parseTransitionsStrictly :: String -> L.ByteString -> Transitions
|
|
parseTransitionsStrictly source b =
|
|
let ts = parseTransitions b
|
|
in if S.null $ S.filter (isLeft . transition) ts
|
|
then ts
|
|
else giveup $ "unknown transitions listed in " ++ source ++ "; upgrade git-annex!"
|
|
|
|
showTransitionLine :: TransitionLine -> String
|
|
showTransitionLine (TransitionLine c t) = unwords [show t, formatVectorClock c]
|
|
|
|
transitionLineParser :: A.Parser TransitionLine
|
|
transitionLineParser = do
|
|
t <- (parsetransition <$> A.takeByteString)
|
|
_ <- A8.char ' '
|
|
c <- vectorClockParser
|
|
return $ TransitionLine c t
|
|
where
|
|
parsetransition b = case readish (decodeBS b) of
|
|
Just t -> Right t
|
|
Nothing -> Left b
|
|
|
|
combineTransitions :: [Transitions] -> Transitions
|
|
combineTransitions = S.unions
|
|
|
|
{- Unknown types of transitions are omitted. -}
|
|
knownTransitionList :: Transitions -> [Transition]
|
|
knownTransitionList = nub . rights . map transition . S.elems
|
|
|
|
{- Typically ran with Annex.Branch.change, but we can't import Annex.Branch
|
|
- here since it depends on this module. -}
|
|
recordTransitions :: (FilePath -> (L.ByteString -> Builder) -> Annex ()) -> Transitions -> Annex ()
|
|
recordTransitions changer t = changer transitionsLog $
|
|
buildTransitions . S.union t . parseTransitionsStrictly "local"
|