summaryrefslogtreecommitdiff
path: root/LocationLog.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-07-01 15:24:07 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-07-01 15:30:42 -0400
commitcdbcd6f495580ee927a85af0581661b486c8ef77 (patch)
tree87f3f882bb543bbed05147ce416805387a45082d /LocationLog.hs
parentceb887d82669b3ec694f31a899b59eefe0f5f352 (diff)
add web special remote
Generalized LocationLog to PresenceLog, and use a presence log to record urls for the web special remote.
Diffstat (limited to 'LocationLog.hs')
-rw-r--r--LocationLog.hs103
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.) -}