diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/Status.hs | 30 | ||||
| -rw-r--r-- | Command/Vicfg.hs | 115 |
2 files changed, 125 insertions, 20 deletions
diff --git a/Command/Status.hs b/Command/Status.hs index a3f5f1df7..ab7dbb007 100644 --- a/Command/Status.hs +++ b/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) + diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs new file mode 100644 index 000000000..7e073a00a --- /dev/null +++ b/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 |