diff options
Diffstat (limited to 'LocationLog.hs')
| -rw-r--r-- | LocationLog.hs | 103 |
1 files changed, 2 insertions, 101 deletions
diff --git a/LocationLog.hs b/LocationLog.hs index b7deb3ed9..a5db7d121 100644 --- a/LocationLog.hs +++ b/LocationLog.hs @@ -5,11 +5,6 @@ - - Repositories record their UUID and the date when they --get or --drop - a value. - - - - A line of the log will look like: "date N UUID" - - Where N=1 when the repo has the file, and 0 otherwise. - - (After the UUID can optionally come a white space and other data, - - for future expansion.) - - Copyright 2010-2011 Joey Hess <joey@kitenet.net> - @@ -25,61 +20,16 @@ module LocationLog ( loggedKeys ) where -import Data.Time.Clock.POSIX -import Data.Time -import System.Locale import System.FilePath -import qualified Data.Map as Map import Control.Monad (when) import Data.Maybe -import Control.Monad.State (liftIO) import qualified Git import qualified Branch import UUID import Types import Locations - -data LogLine = LogLine { - date :: POSIXTime, - status :: LogStatus, - uuid :: UUID -} deriving (Eq) - -data LogStatus = ValuePresent | ValueMissing | Undefined - deriving (Eq) - -instance Show LogStatus where - show ValuePresent = "1" - show ValueMissing = "0" - show Undefined = "undefined" - -instance Read LogStatus where - readsPrec _ "1" = [(ValuePresent, "")] - readsPrec _ "0" = [(ValueMissing, "")] - readsPrec _ _ = [(Undefined, "")] - -instance Show LogLine where - show (LogLine d s u) = unwords [show d, show s, u] - -instance Read LogLine where - -- This parser is robust in that even unparsable log lines are - -- read without an exception being thrown. - -- Such lines have a status of Undefined. - readsPrec _ string = - if length w >= 3 - then maybe bad good pdate - else bad - where - w = words string - s = read $ w !! 1 - u = w !! 2 - pdate :: Maybe UTCTime - pdate = parseTime defaultTimeLocale "%s%Qs" $ head w - - good v = ret $ LogLine (utcTimeToPOSIXSeconds v) s u - bad = ret $ LogLine 0 Undefined "" - ret v = [(v, "")] +import PresenceLog {- Log a change in the presence of a key's value in a repository. -} logChange :: Git.Repo -> Key -> UUID -> LogStatus -> Annex () @@ -92,59 +42,10 @@ logChange repo key u s = do ls <- readLog f writeLog f (compactLog $ line:ls) -{- Reads a log file. - - Note that the LogLines returned may be in any order. -} -readLog :: FilePath -> Annex [LogLine] -readLog file = return . parseLog =<< Branch.get file - -parseLog :: String -> [LogLine] -parseLog s = filter parsable $ map read $ lines s - where - -- some lines may be unparseable, avoid them - parsable l = status l /= Undefined - -{- Stores a set of lines in a log file -} -writeLog :: FilePath -> [LogLine] -> Annex () -writeLog file ls = Branch.change file (unlines $ map show ls) - -{- Generates a new LogLine with the current date. -} -logNow :: LogStatus -> UUID -> Annex LogLine -logNow s u = do - now <- liftIO $ getPOSIXTime - return $ LogLine now s u - {- Returns a list of repository UUIDs that, according to the log, have - the value of a key. -} keyLocations :: Key -> Annex [UUID] -keyLocations key = do - ls <- readLog $ logFile key - return $ map uuid $ filterPresent ls - -{- Filters the list of LogLines to find ones where the value - - is (or should still be) present. -} -filterPresent :: [LogLine] -> [LogLine] -filterPresent ls = filter (\l -> ValuePresent == status l) $ compactLog ls - -type LogMap = Map.Map UUID LogLine - -{- Compacts a set of logs, returning a subset that contains the current - - status. -} -compactLog :: [LogLine] -> [LogLine] -compactLog ls = compactLog' Map.empty ls -compactLog' :: LogMap -> [LogLine] -> [LogLine] -compactLog' m [] = Map.elems m -compactLog' m (l:ls) = compactLog' (mapLog m l) ls - -{- Inserts a log into a map of logs, if the log has better (ie, newer) - - information about a repo than the other logs in the map -} -mapLog :: LogMap -> LogLine -> LogMap -mapLog m l = - if better - then Map.insert u l m - else m - where - better = maybe True (\l' -> date l' <= date l) $ Map.lookup u m - u = uuid l +keyLocations key = currentLog $ logFile key {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} |