summaryrefslogtreecommitdiff
path: root/Logs/Presence.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-10-15 16:21:08 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-10-15 16:21:08 -0400
commit1a29b5b52eec641a5456d7c8dc24356c90107bc0 (patch)
tree0b902c278129bd085e8db986af168a4e46d3dea6 /Logs/Presence.hs
parent279150ccd5ad937a44cbff798ab7bb118ad1dbee (diff)
reorganize log modules
no code changes
Diffstat (limited to 'Logs/Presence.hs')
-rw-r--r--Logs/Presence.hs124
1 files changed, 124 insertions, 0 deletions
diff --git a/Logs/Presence.hs b/Logs/Presence.hs
new file mode 100644
index 000000000..7211eba03
--- /dev/null
+++ b/Logs/Presence.hs
@@ -0,0 +1,124 @@
+{- git-annex presence log
+ -
+ - This is used to store presence information in the git-annex branch in
+ - a way that can be union merged.
+ -
+ - A line of the log will look like: "date N INFO"
+ - Where N=1 when the INFO is present, and 0 otherwise.
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.Presence (
+ LogStatus(..),
+ addLog,
+ readLog,
+ parseLog,
+ logNow,
+ compactLog,
+ currentLog,
+ LogLine
+) where
+
+import Data.Time.Clock.POSIX
+import Data.Time
+import System.Locale
+import qualified Data.Map as M
+
+import Common.Annex
+import qualified Annex.Branch
+
+data LogLine = LogLine {
+ date :: POSIXTime,
+ status :: LogStatus,
+ info :: String
+} deriving (Eq)
+
+data LogStatus = InfoPresent | InfoMissing | Undefined
+ deriving (Eq)
+
+instance Show LogStatus where
+ show InfoPresent = "1"
+ show InfoMissing = "0"
+ show Undefined = "undefined"
+
+instance Read LogStatus where
+ readsPrec _ "1" = [(InfoPresent, "")]
+ readsPrec _ "0" = [(InfoMissing, "")]
+ readsPrec _ _ = [(Undefined, "")]
+
+instance Show LogLine where
+ show (LogLine d s i) = unwords [show d, show s, i]
+
+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
+ i = w !! 2
+ pdate :: Maybe UTCTime
+ pdate = parseTime defaultTimeLocale "%s%Qs" $ head w
+
+ good v = ret $ LogLine (utcTimeToPOSIXSeconds v) s i
+ bad = ret $ LogLine 0 Undefined ""
+ ret v = [(v, "")]
+
+addLog :: FilePath -> LogLine -> Annex ()
+addLog file line = Annex.Branch.change file $ \s ->
+ showLog $ compactLog (line : parseLog s)
+
+{- Reads a log file.
+ - Note that the LogLines returned may be in any order. -}
+readLog :: FilePath -> Annex [LogLine]
+readLog file = parseLog <$> Annex.Branch.get file
+
+parseLog :: String -> [LogLine]
+parseLog = filter parsable . map read . lines
+ where
+ -- some lines may be unparseable, avoid them
+ parsable l = status l /= Undefined
+
+{- Generates a log file. -}
+showLog :: [LogLine] -> String
+showLog = unlines . map show
+
+{- Generates a new LogLine with the current date. -}
+logNow :: LogStatus -> String -> Annex LogLine
+logNow s i = do
+ now <- liftIO getPOSIXTime
+ return $ LogLine now s i
+
+{- Reads a log and returns only the info that is still in effect. -}
+currentLog :: FilePath -> Annex [String]
+currentLog file = map info . filterPresent <$> readLog file
+
+{- Returns the info from LogLines that are in effect. -}
+filterPresent :: [LogLine] -> [LogLine]
+filterPresent = filter (\l -> InfoPresent == status l) . compactLog
+
+{- Compacts a set of logs, returning a subset that contains the current
+ - status. -}
+compactLog :: [LogLine] -> [LogLine]
+compactLog = M.elems . foldr mapLog M.empty
+
+type LogMap = M.Map String LogLine
+
+{- Inserts a log into a map of logs, if the log has better (ie, newer)
+ - information than the other logs in the map -}
+mapLog :: LogLine -> LogMap -> LogMap
+mapLog l m =
+ if better
+ then M.insert i l m
+ else m
+ where
+ better = maybe True newer $ M.lookup i m
+ newer l' = date l' <= date l
+ i = info l