summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Command/Vicfg.hs140
-rw-r--r--Logs/PreferredContent.hs4
-rw-r--r--Logs/PreferredContent/Raw.hs22
-rw-r--r--Types/StandardGroups.hs5
-rw-r--r--debian/changelog1
-rw-r--r--doc/git-annex.mdwn4
6 files changed, 124 insertions, 52 deletions
diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs
index 7608959c2..94fc36184 100644
--- a/Command/Vicfg.hs
+++ b/Command/Vicfg.hs
@@ -1,6 +1,6 @@
{- git-annex command
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -60,7 +60,8 @@ vicfg curcfg f = do
data Cfg = Cfg
{ cfgTrustMap :: TrustMap
, cfgGroupMap :: M.Map UUID (S.Set Group)
- , cfgPreferredContentMap :: M.Map UUID String
+ , cfgPreferredContentMap :: M.Map UUID PreferredContentExpression
+ , cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression
, cfgScheduleMap :: M.Map UUID [ScheduledActivity]
}
@@ -69,25 +70,40 @@ getCfg = Cfg
<$> trustMapRaw -- without local trust overrides
<*> (groupsByUUID <$> groupMap)
<*> preferredContentMapRaw
+ <*> groupPreferredContentMapRaw
<*> scheduleMap
setCfg :: Cfg -> Cfg -> Annex ()
setCfg curcfg newcfg = do
- let (trustchanges, groupchanges, preferredcontentchanges, schedulechanges) = diffCfg curcfg newcfg
- mapM_ (uncurry trustSet) $ M.toList trustchanges
- mapM_ (uncurry groupSet) $ M.toList groupchanges
- mapM_ (uncurry preferredContentSet) $ M.toList preferredcontentchanges
- mapM_ (uncurry scheduleSet) $ M.toList schedulechanges
-
-diffCfg :: Cfg -> Cfg -> (TrustMap, M.Map UUID (S.Set Group), M.Map UUID String, M.Map UUID [ScheduledActivity])
-diffCfg curcfg newcfg = (diff cfgTrustMap, diff cfgGroupMap, diff cfgPreferredContentMap, diff cfgScheduleMap)
+ let diff = diffCfg curcfg newcfg
+ mapM_ (uncurry trustSet) $ M.toList $ cfgTrustMap diff
+ mapM_ (uncurry groupSet) $ M.toList $ cfgGroupMap diff
+ mapM_ (uncurry preferredContentSet) $ M.toList $ cfgPreferredContentMap diff
+ mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff
+ mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff
+
+diffCfg :: Cfg -> Cfg -> Cfg
+diffCfg curcfg newcfg = Cfg
+ { cfgTrustMap = diff cfgTrustMap
+ , cfgGroupMap = diff cfgGroupMap
+ , cfgPreferredContentMap = diff cfgPreferredContentMap
+ , cfgGroupPreferredContentMap = diff cfgGroupPreferredContentMap
+ , cfgScheduleMap = diff cfgScheduleMap
+ }
where
diff f = M.differenceWith (\x y -> if x == y then Nothing else Just x)
(f newcfg) (f curcfg)
genCfg :: Cfg -> M.Map UUID String -> String
-genCfg cfg descs = unlines $ concat
- [intro, trust, groups, preferredcontent, schedule]
+genCfg cfg descs = unlines $ intercalate [""]
+ [ intro
+ , trust
+ , groups
+ , preferredcontent
+ , grouppreferredcontent
+ , standardgroups
+ , schedule
+ ]
where
intro =
[ com "git-annex configuration"
@@ -95,22 +111,20 @@ genCfg cfg descs = unlines $ concat
, 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 uuid = value"
+ , com " setting field = value"
]
- trust = settings cfgTrustMap
- [ ""
- , com "Repository trust configuration"
+ trust = settings cfg descs cfgTrustMap
+ [ com "Repository trust configuration"
, com "(Valid trust levels: " ++ trustlevels ++ ")"
]
(\(t, u) -> line "trust" u $ showTrustLevel t)
(\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted)
where
- trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted]
+ trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted]
- groups = settings cfgGroupMap
- [ ""
- , com "Repository groups"
+ groups = settings cfg descs cfgGroupMap
+ [ com "Repository groups"
, com $ "(Standard groups: " ++ grouplist ++ ")"
, com "(Separate group names with spaces)"
]
@@ -119,33 +133,60 @@ genCfg cfg descs = unlines $ concat
where
grouplist = unwords $ map fromStandardGroup [minBound..]
- preferredcontent = settings cfgPreferredContentMap
- [ ""
- , com "Repository preferred contents"
+ preferredcontent = settings cfg descs cfgPreferredContentMap
+ [ com "Repository preferred contents" ]
+ (\(s, u) -> line "wanted" u s)
+ (\u -> line "wanted" u "standard")
+
+ grouppreferredcontent = settings' cfg allgroups cfgGroupPreferredContentMap
+ [ com "Group preferred contents"
+ , com "(Used by repositories with \"groupwanted\" in their preferred contents)"
]
- (\(s, u) -> line "content" u s)
- (\u -> line "content" u "")
+ (\(s, g) -> gline g s)
+ (\g -> gline g "standard")
+ where
+ gline g value = [ unwords ["groupwanted", g, "=", value] ]
+ allgroups = S.unions $ stdgroups : M.elems (cfgGroupMap cfg)
+ stdgroups = S.fromList $ map fromStandardGroup [minBound..maxBound]
- schedule = settings cfgScheduleMap
- [ ""
- , com "Scheduled activities"
+ standardgroups =
+ [ com "Standard preferred contents"
+ , com "(Used by wanted or groupwanted expressions containing \"standard\")"
+ , com "(For reference only; built-in and cannot be changed!)"
+ ]
+ ++ map gline [minBound..maxBound]
+ where
+ gline g = com $ unwords
+ [ "standard"
+ , fromStandardGroup g, "=", preferredContent g
+ ]
+
+ schedule = settings cfg descs cfgScheduleMap
+ [ com "Scheduled activities"
, com "(Separate multiple activities with \"; \")"
]
(\(l, u) -> line "schedule" u $ fromScheduledActivities l)
(\u -> line "schedule" u "")
- settings field desc showvals showdefaults = concat
- [ desc
- , concatMap showvals $ sort $ map swap $ M.toList $ field cfg
- , concatMap (lcom . showdefaults) $ missing field
- ]
-
line setting u value =
[ com $ "(for " ++ fromMaybe "" (M.lookup u descs) ++ ")"
, unwords [setting, fromUUID u, "=", value]
]
- lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l)
- missing field = S.toList $ M.keysSet descs `S.difference` M.keysSet (field cfg)
+
+settings :: Ord v => Cfg -> M.Map UUID String -> (Cfg -> M.Map UUID v) -> [String] -> ((v, UUID) -> [String]) -> (UUID -> [String]) -> [String]
+settings cfg descs = settings' cfg (M.keysSet descs)
+
+settings' :: (Ord v, Ord f) => Cfg -> S.Set f -> (Cfg -> M.Map f v) -> [String] -> ((v, f) -> [String]) -> (f -> [String]) -> [String]
+settings' cfg s field desc showvals showdefaults = concat
+ [ desc
+ , concatMap showvals $ sort $ map swap $ M.toList $ field cfg
+ , concatMap (lcom . showdefaults) missing
+ ]
+ where
+ missing = S.toList $ s `S.difference` M.keysSet (field cfg)
+
+lcom :: [String] -> [String]
+lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l)
{- If there's a parse error, returns a new version of the file,
- with the problem lines noted. -}
@@ -163,16 +204,16 @@ parseCfg curcfg = go [] curcfg . lines
parse l cfg
| null l = Right cfg
| "#" `isPrefixOf` l = Right cfg
- | null setting || null u = Left "missing repository uuid"
- | otherwise = handle cfg (toUUID u) setting value'
+ | null setting || null f = Left "missing field"
+ | otherwise = handle cfg f setting value'
where
(setting, rest) = separate isSpace l
(r, value) = separate (== '=') rest
value' = trimspace value
- u = reverse $ trimspace $ reverse $ trimspace r
+ f = reverse $ trimspace $ reverse $ trimspace r
trimspace = dropWhile isSpace
- handle cfg u setting value
+ handle cfg f setting value
| setting == "trust" = case readTrustLevel value of
Nothing -> badval "trust value" value
Just t ->
@@ -181,18 +222,26 @@ parseCfg curcfg = go [] curcfg . lines
| setting == "group" =
let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)
in Right $ cfg { cfgGroupMap = m }
- | setting == "content" =
+ | setting == "wanted" =
case checkPreferredContentExpression value of
Just e -> Left e
Nothing ->
let m = M.insert u value (cfgPreferredContentMap cfg)
in Right $ cfg { cfgPreferredContentMap = m }
+ | setting == "groupwanted" =
+ case checkPreferredContentExpression value of
+ Just e -> Left e
+ Nothing ->
+ let m = M.insert f value (cfgGroupPreferredContentMap cfg)
+ in Right $ cfg { cfgGroupPreferredContentMap = m }
| setting == "schedule" = case parseScheduledActivities value of
Left e -> Left e
Right l ->
let m = M.insert u l (cfgScheduleMap cfg)
in Right $ cfg { cfgScheduleMap = m }
| otherwise = badval "setting" setting
+ where
+ u = toUUID f
showerr (Just msg, l) = [parseerr ++ msg, l]
showerr (Nothing, l)
@@ -203,11 +252,12 @@ parseCfg curcfg = go [] curcfg . lines
badval desc val = Left $ "unknown " ++ desc ++ " \"" ++ val ++ "\""
badheader =
- [ com "There was a problem parsing your input."
- , com "Search for \"Parse error\" to find the bad lines."
- , com "Either fix the bad lines, or delete them (to discard your changes)."
+ [ com "** There was a problem parsing your input!"
+ , com "** Search for \"Parse error\" to find the bad lines."
+ , com "** Either fix the bad lines, or delete them (to discard your changes)."
+ , ""
]
- parseerr = com "Parse error in next line: "
+ parseerr = com "** Parse error in next line: "
com :: String -> String
com s = "# " ++ s
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index 2bc5f08d6..93609da5e 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -1,6 +1,6 @@
{- git-annex preferred content matcher configuration
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -8,10 +8,12 @@
module Logs.PreferredContent (
preferredContentLog,
preferredContentSet,
+ groupPreferredContentSet,
isPreferredContent,
preferredContentMap,
preferredContentMapLoad,
preferredContentMapRaw,
+ groupPreferredContentMapRaw,
checkPreferredContentExpression,
setStandardGroup,
) where
diff --git a/Logs/PreferredContent/Raw.hs b/Logs/PreferredContent/Raw.hs
index 63f6118e4..ce91c2dcd 100644
--- a/Logs/PreferredContent/Raw.hs
+++ b/Logs/PreferredContent/Raw.hs
@@ -1,6 +1,6 @@
{- unparsed preferred content expressions
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -15,17 +15,35 @@ import qualified Annex.Branch
import qualified Annex
import Logs
import Logs.UUIDBased
+import Logs.MapLog
import Types.StandardGroups
+import Types.Group
{- Changes the preferred content configuration of a remote. -}
preferredContentSet :: UUID -> PreferredContentExpression -> Annex ()
preferredContentSet uuid@(UUID _) val = do
ts <- liftIO getPOSIXTime
Annex.Branch.change preferredContentLog $
- showLog id . changeLog ts uuid val . parseLog Just
+ showLog id
+ . changeLog ts uuid val
+ . parseLog Just
Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
preferredContentSet NoUUID _ = error "unknown UUID; cannot modify"
+{- Changes the preferred content configuration of a group. -}
+groupPreferredContentSet :: Group -> PreferredContentExpression -> Annex ()
+groupPreferredContentSet g val = do
+ ts <- liftIO getPOSIXTime
+ Annex.Branch.change groupPreferredContentLog $
+ showMapLog id id
+ . changeMapLog ts g val
+ . parseMapLog Just Just
+ Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
+
preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
preferredContentMapRaw = simpleMap . parseLog Just
<$> Annex.Branch.get preferredContentLog
+
+groupPreferredContentMapRaw :: Annex (M.Map Group PreferredContentExpression)
+groupPreferredContentMapRaw = simpleMap . parseMapLog Just Just
+ <$> Annex.Branch.get groupPreferredContentLog
diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs
index 2f5cd4b30..63182d2a1 100644
--- a/Types/StandardGroups.hs
+++ b/Types/StandardGroups.hs
@@ -8,6 +8,7 @@
module Types.StandardGroups where
import Types.Remote (RemoteConfig)
+import Types.Group
import qualified Data.Map as M
import Data.Maybe
@@ -27,7 +28,7 @@ data StandardGroup
| UnwantedGroup
deriving (Eq, Ord, Enum, Bounded, Show)
-fromStandardGroup :: StandardGroup -> String
+fromStandardGroup :: StandardGroup -> Group
fromStandardGroup ClientGroup = "client"
fromStandardGroup TransferGroup = "transfer"
fromStandardGroup BackupGroup = "backup"
@@ -39,7 +40,7 @@ fromStandardGroup ManualGroup = "manual"
fromStandardGroup PublicGroup = "public"
fromStandardGroup UnwantedGroup = "unwanted"
-toStandardGroup :: String -> Maybe StandardGroup
+toStandardGroup :: Group -> Maybe StandardGroup
toStandardGroup "client" = Just ClientGroup
toStandardGroup "transfer" = Just TransferGroup
toStandardGroup "backup" = Just BackupGroup
diff --git a/debian/changelog b/debian/changelog
index c73c83f6e..797f4d576 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -20,6 +20,7 @@ git-annex (5.20140307) UNRELEASED; urgency=medium
* "standard" can now be used as a first-class keyword in preferred content
expressions. For example "standard or (include=otherdir/*)"
* Avoid encoding errors when using the unused log file.
+ * vicfg: Allows editing preferred content expressions for groups.
-- Joey Hess <joeyh@debian.org> Thu, 06 Mar 2014 16:17:01 -0400
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 37975c4c9..e73c08ca2 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -477,8 +477,8 @@ subdirectories).
* `vicfg`
Opens EDITOR on a temp file containing most of the above configuration
- settings, and when it exits, stores any changes made back to the git-annex
- branch.
+ settings, as well as a few others, and when it exits, stores any changes
+ made back to the git-annex branch.
* `direct`
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 07:29:17 +0000