git-annex/Logs/Location.hs

72 lines
2.1 KiB
Haskell
Raw Normal View History

{-# LANGUAGE BangPatterns #-}
2010-10-09 23:22:40 +00:00
{- git-annex location log
-
2011-04-02 19:50:51 +00:00
- git-annex keeps track of which repositories have the contents of annexed
- files.
2010-10-09 23:22:40 +00:00
-
2010-10-12 22:06:34 +00:00
- Repositories record their UUID and the date when they --get or --drop
2010-10-13 00:04:36 +00:00
- a value.
2010-10-10 16:31:14 +00:00
-
- Copyright 2010-2014 Joey Hess <id@joeyh.name>
2010-10-27 20:53:54 +00:00
-
- Licensed under the GNU GPL version 3 or higher.
2010-10-09 23:22:40 +00:00
-}
2011-10-15 20:21:08 +00:00
module Logs.Location (
2010-10-12 22:25:41 +00:00
LogStatus(..),
2012-12-12 23:20:38 +00:00
logStatus,
logChange,
loggedLocations,
loggedLocationsHistorical,
2011-07-01 21:23:01 +00:00
loggedKeys,
loggedKeysFor,
2010-10-11 21:52:46 +00:00
) where
2010-10-09 23:22:40 +00:00
2011-10-05 20:02:51 +00:00
import Common.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.Presence
2012-12-12 23:20:38 +00:00
import Annex.UUID
import Git.Types (RefDate)
2012-12-12 23:20:38 +00:00
{- Log a change in the presence of a key's value in current repository. -}
logStatus :: Key -> LogStatus -> Annex ()
2013-09-05 01:37:13 +00:00
logStatus key s = do
2012-12-12 23:20:38 +00:00
u <- getUUID
2013-09-05 01:37:13 +00:00
logChange key u s
2010-10-09 23:22:40 +00:00
2011-06-22 20:01:32 +00:00
{- Log a change in the presence of a key's value in a repository. -}
2011-11-09 05:15:51 +00:00
logChange :: Key -> UUID -> LogStatus -> Annex ()
logChange key (UUID u) s = addLog (locationLogFile key) =<< logNow s u
2012-04-22 03:32:33 +00:00
logChange _ NoUUID _ = noop
2010-10-12 22:25:41 +00:00
{- Returns a list of repository UUIDs that, according to the log, have
- the value of a key. -}
loggedLocations :: Key -> Annex [UUID]
loggedLocations = getLoggedLocations currentLog
{- Gets the location log on a particular date. -}
loggedLocationsHistorical :: RefDate -> Key -> Annex [UUID]
loggedLocationsHistorical = getLoggedLocations . historicalLog
getLoggedLocations :: (FilePath -> Annex [String]) -> Key -> Annex [UUID]
getLoggedLocations getter key = map toUUID <$> (getter . locationLogFile) key
2011-04-02 19:50:51 +00:00
{- Finds all keys that have location log information.
- (There may be duplicate keys in the list.) -}
loggedKeys :: Annex [Key]
loggedKeys = mapMaybe locationLogFileKey <$> Annex.Branch.files
2011-07-01 21:23:01 +00:00
{- Finds all keys that have location log information indicating
- they are present for the specified repository. -}
loggedKeysFor :: UUID -> Annex [Key]
loggedKeysFor u = filterM isthere =<< loggedKeys
2012-11-11 04:51:07 +00:00
where
{- This should run strictly to avoid the filterM
- building many thunks containing keyLocations data. -}
isthere k = do
us <- loggedLocations k
let !there = u `elem` us
return there