bfc9039ead
Most of the individual logs are not converted yet, only presense logs have an efficient ByteString Builder implemented so far. The rest convert to and from String.
81 lines
2.5 KiB
Haskell
81 lines
2.5 KiB
Haskell
{- git-annex uuid log
|
|
-
|
|
- uuid.log stores a list of known uuids, and their descriptions.
|
|
-
|
|
- Copyright 2010-2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Logs.UUID (
|
|
uuidLog,
|
|
describeUUID,
|
|
uuidDescMap,
|
|
uuidDescMapLoad
|
|
) where
|
|
|
|
import Types.UUID
|
|
import Annex.Common
|
|
import Annex.VectorClock
|
|
import qualified Annex
|
|
import qualified Annex.Branch
|
|
import Logs
|
|
import Logs.UUIDBased
|
|
import qualified Annex.UUID
|
|
|
|
import qualified Data.Map.Strict as M
|
|
|
|
{- Records a description for a uuid in the log. -}
|
|
describeUUID :: UUID -> UUIDDesc -> Annex ()
|
|
describeUUID uuid desc = do
|
|
c <- liftIO currentVectorClock
|
|
Annex.Branch.change uuidLog $
|
|
encodeBL . showLog id . changeLog c uuid (fromUUIDDesc desc) . fixBadUUID . parseLog Just . decodeBL
|
|
|
|
{- Temporarily here to fix badly formatted uuid logs generated by
|
|
- versions 3.20111105 and 3.20111025.
|
|
-
|
|
- Those logs contain entries with the UUID and description flipped.
|
|
- Due to parsing, if the description is multiword, only the first
|
|
- will be taken to be the UUID. So, if the UUID of an entry does
|
|
- not look like a UUID, and the last word of the description does,
|
|
- flip them back.
|
|
-}
|
|
fixBadUUID :: Log String -> Log String
|
|
fixBadUUID = M.fromList . map fixup . M.toList
|
|
where
|
|
fixup (k, v)
|
|
| isbad = (fixeduuid, LogEntry (newertime v) fixedvalue)
|
|
| otherwise = (k, v)
|
|
where
|
|
kuuid = fromUUID k
|
|
isbad = not (isuuid kuuid) && not (null ws) && isuuid lastword
|
|
ws = words $ value v
|
|
lastword = Prelude.last ws
|
|
fixeduuid = toUUID lastword
|
|
fixedvalue = unwords $ kuuid: Prelude.init ws
|
|
-- For the fixed line to take precidence, it should be
|
|
-- slightly newer, but only slightly.
|
|
newertime (LogEntry (VectorClock c) _) = VectorClock (c + minimumPOSIXTimeSlice)
|
|
newertime (LogEntry Unknown _) = VectorClock minimumPOSIXTimeSlice
|
|
minimumPOSIXTimeSlice = 0.000001
|
|
isuuid s = length s == 36 && length (splitc '-' s) == 5
|
|
|
|
{- The map is cached for speed. -}
|
|
uuidDescMap :: Annex UUIDDescMap
|
|
uuidDescMap = maybe uuidDescMapLoad return =<< Annex.getState Annex.uuiddescmap
|
|
|
|
{- Read the uuidLog into a simple Map.
|
|
-
|
|
- The UUID of the current repository is included explicitly, since
|
|
- it may not have been described and otherwise would not appear. -}
|
|
uuidDescMapLoad :: Annex UUIDDescMap
|
|
uuidDescMapLoad = do
|
|
m <- (simpleMap . parseLog (Just . UUIDDesc . encodeBS)) . decodeBL
|
|
<$> Annex.Branch.get uuidLog
|
|
u <- Annex.UUID.getUUID
|
|
let m' = M.insertWith preferold u mempty m
|
|
Annex.changeState $ \s -> s { Annex.uuiddescmap = Just m' }
|
|
return m'
|
|
where
|
|
preferold = flip const
|