vicfg: New command, allows editing (or simply viewing) most of the repository configuration settings stored in the git-annex branch.

Incomplete; I need to finish parsing and saving. This will also be used
for editing transfer control expresssions.

Removed the group display from the status output, I didn't really
like that format, and vicfg can be used to see as well as edit rempository
group membership.

Command/Status.hs

@@ -11,8 +11,8 @@ module Command.Status where
 
 import Control.Monad.State.Strict
 import qualified Data.Map as M
-import qualified Data.Set as S
 import Text.JSON
+import Data.Tuple
 
 import Common.Annex
 import qualified Types.Backend as B
@@ -33,8 +33,7 @@ import Remote
 import Config
 import Utility.Percentage
 import Logs.Transfer
-import Logs.Group
-import Types.Group
+import Types.TrustLevel
 
 -- a named computation that produces a statistic
 type Stat = StatState (Maybe (String, StatState String))
@@ -70,11 +69,10 @@ fast_stats :: [Stat]
 fast_stats = 
 	[ supported_backends
 	, supported_remote_types
-	, remote_list Trusted "trusted"
-	, remote_list SemiTrusted "semitrusted"
-	, remote_list UnTrusted "untrusted"
-	, remote_list DeadTrusted "dead"
-	, group_list
+	, remote_list Trusted
+	, remote_list SemiTrusted
+	, remote_list UnTrusted
+	, remote_list DeadTrusted
 	, transfer_list
 	, disk_size
 	]
@@ -129,14 +127,14 @@ supported_remote_types :: Stat
 supported_remote_types = stat "supported remote types" $ json unwords $
 	return $ map R.typename Remote.remoteTypes
 
-remote_list :: TrustLevel -> String -> Stat
-remote_list level desc = stat n $ nojson $ lift $ do
+remote_list :: TrustLevel -> Stat
+remote_list level = stat n $ nojson $ lift $ do
 	us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name)
 	rs <- fst <$> trustPartition level us
 	s <- prettyPrintUUIDs n rs
 	return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s
 	where
-		n = desc ++ " repositories"
+		n = showTrustLevel level ++ " repositories"
 	
 local_annex_size :: Stat
 local_annex_size = stat "local annex size" $ json id $
@@ -176,14 +174,6 @@ bloom_info = stat "bloom filter size" $ json id $ do
 
 	return $ size ++ note
 
-group_list :: Stat
-group_list = stat "repository groups" $ nojson $ lift $ do
-	m <- uuidsByGroup <$> groupMap
-	ls <- forM (M.toList m) $ \(g, s) -> do
-		l <- Remote.prettyListUUIDs (S.toList s)
-		return $ g ++ ": " ++ intercalate ", " l
-	return $ show (M.size m) ++ multiLine ls
-
 transfer_list :: Stat
 transfer_list = stat "transfers in progress" $ nojson $ lift $ do
 	uuidmap <- Remote.remoteMap id
@@ -228,7 +218,6 @@ backend_usage = stat "backend usage" $ nojson $
 			map (\(n, b) -> b ++ ": " ++ show n) $
 			reverse $ sort $ map swap $ M.toList $
 			M.unionWith (+) x y
-		swap (x, y) = (y, x)
 
 cachedPresentData :: StatState KeyData
 cachedPresentData = do
@@ -299,3 +288,4 @@ aside s = " (" ++ s ++ ")"
 
 multiLine :: [String] -> String
 multiLine = concatMap (\l -> "\n\t" ++ l)
+

Command/Vicfg.hs

@@ -0,0 +1,115 @@
+{- git-annex command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Vicfg where
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import System.Environment (getEnv)
+import Data.Tuple (swap)
+
+import Common.Annex
+import Command
+import Annex.Perms
+import Types.TrustLevel
+import Types.Group
+import Logs.Trust
+import Logs.Group
+import Remote
+
+def :: [Command]
+def = [command "vicfg" paramNothing seek
+	"edit git-annex's configuration"]
+
+seek :: [CommandSeek]
+seek = [withNothing start]
+
+start :: CommandStart
+start = do
+	f <- fromRepo gitAnnexTmpCfgFile
+	createAnnexDirectory (parentDir f)
+	liftIO . writeFile f =<< genCfg <$> getCfg
+	vicfg f
+	stop
+
+vicfg :: FilePath -> Annex ()
+vicfg f = do
+	vi <- liftIO $ catchDefaultIO "vi" $ getEnv "EDITOR"
+	-- Allow EDITOR to be processed by the shell, so it can contain options.
+	unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, f]]) $
+		error $ vi ++ " exited nonzero; aborting"
+	r <- parseCfg <$> liftIO (readFileStrict f)
+	liftIO $ nukeFile f
+	case r of
+		Left s -> do
+			liftIO $ writeFile f s
+			vicfg f
+		Right c -> setCfg c
+
+data Cfg = Cfg
+	{ cfgTrustMap :: TrustMap
+	, cfgGroupMap :: M.Map UUID (S.Set Group)
+	, cfgDescriptions :: M.Map UUID String
+	}
+
+getCfg :: Annex Cfg
+getCfg = Cfg
+	<$> trustMapRaw -- without local trust overrides
+	<*> (groupsByUUID <$> groupMap)
+	<*> uuidDescriptions
+
+setCfg :: Cfg -> Annex ()
+setCfg = error "TODO setCfg"
+
+genCfg :: Cfg -> String
+genCfg cfg = unlines $ concat
+	[intro, trustintro, trust, defaulttrust, groupsintro, groups, defaultgroups]
+	where
+		intro =
+			[ com "git-annex configuration"
+			, com ""
+			, com "Changes saved to this file will be recorded in the git-annex branch."
+			, com ""
+			, com "Lines in this file have the format:"
+			, com "  setting repo = value"
+			]
+		trustintro =
+			[ ""
+			, com "Repository trust configuration"
+			, com "(Valid trust levels: " ++
+			  unwords (map showTrustLevel [Trusted .. DeadTrusted]) ++
+			  ")"
+			]
+		trust = map (\(t, u) -> line "trust" u $ showTrustLevel t) $
+			sort $ map swap $ M.toList $ cfgTrustMap cfg
+		defaulttrust = map (\u -> pcom $ line "trust" u $ showTrustLevel SemiTrusted) $
+			missing cfgTrustMap
+		groupsintro = 
+			[ ""
+			, com "Repository groups"
+			, com "(Separate group names with spaces)"
+			]
+		groups = map (\(s, u) -> line "group" u $ unwords $ S.toList s) $
+			sort $ map swap $ M.toList $ cfgGroupMap cfg
+		defaultgroups = map (\u -> pcom $ line "group" u "") $
+			missing cfgGroupMap
+		line setting u value = unwords
+			[ setting
+			, showu u
+			, "=" 
+			, value
+			]
+		com s = "# " ++ s
+		pcom s = "#" ++ s
+		showu u = fromMaybe (fromUUID u) $
+			M.lookup u (cfgDescriptions cfg)
+		missing field = S.toList $ M.keysSet (cfgDescriptions cfg) `S.difference` M.keysSet (field cfg)
+
+{- If there's a parse error, returns a new version of the file,
+ - with the problem lines noted. -}
+parseCfg :: String -> Either String Cfg
+parseCfg = undefined