From 8cd1d9ed5ebf96d9e39116f63900ccd7be8d907e Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 20 Jan 2014 16:47:56 -0400
Subject: global numcopies setting

* numcopies: New command, sets global numcopies value that is seen by all
  clones of a repository.
* The annex.numcopies git config setting is deprecated. Once the numcopies
  command is used to set the global number of copies, any annex.numcopies
  git configs will be ignored.
* assistant: Make the prefs page set the global numcopies.

This global numcopies setting is needed to let preferred content
expressions operate on numcopies.

It's also convenient, because typically if you want git-annex to preserve N
copies of files in a repo, you want it to do that no matter which repo it's
running in. Making it global avoids needing to warn the user about gotchas
involving inconsistent annex.numcopies settings.
(See changes to doc/numcopies.mdwn.)

Added a new variety of git-annex branch log file, that holds only 1 value.
Will probably be useful for other stuff later.

This commit was sponsored by Nicolas Pouillard.
---
 Logs/NumCopies.hs   | 33 +++++++++++++++++++++++++++
 Logs/SingleValue.hs | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 98 insertions(+)
 create mode 100644 Logs/NumCopies.hs
 create mode 100644 Logs/SingleValue.hs

(limited to 'Logs')

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)
-- 
cgit v1.2.3