git-annex/Logs/UUID.hs

57 lines
1.5 KiB
Haskell
Raw Normal View History

{- git-annex uuid log
-
- uuid.log stores a list of known uuids, and their descriptions.
-
- Copyright 2010-2019 Joey Hess <id@joeyh.name>
2010-10-27 20:53:54 +00:00
-
- Licensed under the GNU GPL version 3 or higher.
2010-10-12 17:10:07 +00:00
-}
2011-10-15 20:21:08 +00:00
module Logs.UUID (
uuidLog,
2010-10-16 20:15:31 +00:00
describeUUID,
uuidDescMap,
uuidDescMapLoad
2010-10-12 17:10:07 +00:00
) where
import Types.UUID
import Annex.Common
import Annex.VectorClock
import qualified Annex
2011-10-04 04:40:47 +00:00
import qualified Annex.Branch
import Logs
2011-10-15 20:21:08 +00:00
import Logs.UUIDBased
import qualified Annex.UUID
2010-10-12 19:48:00 +00:00
import qualified Data.Map.Strict as M
import qualified Data.ByteString.Lazy as L
import qualified Data.Attoparsec.ByteString.Lazy as A
{- Records a description for a uuid in the log. -}
describeUUID :: UUID -> UUIDDesc -> Annex ()
describeUUID uuid desc = do
c <- liftIO currentVectorClock
Annex.Branch.change uuidLog $
buildLogOld buildUUIDDesc . changeLog c uuid desc . parseUUIDLog
2010-10-14 03:18:58 +00:00
{- 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 . parseUUIDLog <$> 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'
2012-11-11 04:51:07 +00:00
where
preferold = flip const
parseUUIDLog :: L.ByteString -> Log UUIDDesc
parseUUIDLog = parseLogOld (UUIDDesc <$> A.takeByteString)