2 files changed, 98 insertions, 0 deletions
diff --git a/Logs/NumCopies.hs b/Logs/NumCopies.hs
new file mode 100644
index 000000000..dc345dd0a
--- /dev/null
+++ b/Logs/NumCopies.hs
@@ -0,0 +1,33 @@
+{- git-annex numcopies log
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Logs.NumCopies where
+
+import Common.Annex
+import qualified Annex
+import Logs
+import Logs.SingleValue
+
+instance Serializable Int where
+	serialize = show
+	deserialize = readish
+
+setGlobalNumCopies :: Int -> Annex ()
+setGlobalNumCopies = setLog numcopiesLog
+
+{- Cached for speed. -}
+getGlobalNumCopies :: Annex (Maybe Int)
+getGlobalNumCopies = maybe numCopiesLoad (return . Just)
+	=<< Annex.getState Annex.globalnumcopies
+
+numCopiesLoad :: Annex (Maybe Int)
+numCopiesLoad = do
+	v <- getLog numcopiesLog
+	Annex.changeState $ \s -> s { Annex.globalnumcopies = v }
+	return v
diff --git a/Logs/SingleValue.hs b/Logs/SingleValue.hs
new file mode 100644
index 000000000..03975df92
--- /dev/null
+++ b/Logs/SingleValue.hs
@@ -0,0 +1,65 @@
+{- git-annex single-value log
+ -
+ - This is used to store a value in a way that can be union merged.
+ -
+ - A line of the log will look like: "timestamp value"
+ -
+ - The line with the newest timestamp wins.
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.SingleValue where
+
+import Common.Annex
+import qualified Annex.Branch
+
+import qualified Data.Set as S
+import Data.Time.Clock.POSIX
+import Data.Time
+import System.Locale
+
+class Serializable v where
+	serialize :: v -> String
+	deserialize :: String -> Maybe v
+
+data LogEntry v = LogEntry
+	{ changed :: POSIXTime
+	, value :: v
+	} deriving (Eq, Show, Ord)
+
+type Log v = S.Set (LogEntry v)
+
+showLog :: (Serializable v) => Log v -> String
+showLog = unlines . map showline . S.toList
+  where
+	showline (LogEntry t v) = unwords [show t, serialize v]
+
+parseLog :: (Ord v, Serializable v) => String -> Log v
+parseLog = S.fromList . mapMaybe parse . lines
+  where
+	parse line = do
+		let (ts, s) = splitword line
+		date <- utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts
+		v <- deserialize s
+		Just (LogEntry date v)
+	splitword = separate (== ' ')
+
+newestValue :: Log v -> Maybe v
+newestValue s
+	| S.null s = Nothing
+	| otherwise = Just (value $ S.findMax s)
+
+readLog :: (Ord v, Serializable v) => FilePath -> Annex (Log v)
+readLog = parseLog <$$> Annex.Branch.get
+
+getLog :: (Ord v, Serializable v) => FilePath -> Annex (Maybe v)
+getLog = newestValue <$$> readLog
+
+setLog :: (Serializable v) => FilePath -> v -> Annex ()
+setLog f v = do
+        now <- liftIO getPOSIXTime
+        let ent = LogEntry now v
+	Annex.Branch.change f $ \_old -> showLog (S.singleton ent)