diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs index f5833c0bca..9d306fe802 100644 --- a/Annex/Branch/Transitions.hs +++ b/Annex/Branch/Transitions.hs @@ -19,6 +19,7 @@ import Types.TrustLevel import Types.UUID import qualified Data.Map as M +import Data.Default data FileTransition = ChangeFile String @@ -60,4 +61,4 @@ dropDeadFromPresenceLog :: TrustMap -> [Presence.LogLine] -> [Presence.LogLine] dropDeadFromPresenceLog trustmap = filter $ notDead trustmap (toUUID . Presence.info) notDead :: TrustMap -> (v -> UUID) -> v -> Bool -notDead trustmap a v = M.findWithDefault SemiTrusted (a v) trustmap /= DeadTrusted +notDead trustmap a v = M.findWithDefault def (a v) trustmap /= DeadTrusted diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index 26a75dab22..834fde4e1a 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -5,6 +5,8 @@ - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE RankNTypes #-} + module Command.Vicfg where import qualified Data.Map as M @@ -12,6 +14,7 @@ import qualified Data.Set as S import System.Environment (getEnv) import Data.Tuple (swap) import Data.Char (isSpace) +import Data.Default import Common.Annex import Command @@ -49,7 +52,7 @@ vicfg curcfg f = do -- Allow EDITOR to be processed by the shell, so it can contain options. unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $ error $ vi ++ " exited nonzero; aborting" - r <- parseCfg curcfg <$> liftIO (readFileStrict f) + r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f) liftIO $ nukeFile f case r of Left s -> do @@ -85,6 +88,21 @@ setCfg curcfg newcfg = do mapM_ (uncurry groupPreferredContentSet) $ M.toList $ cfgGroupPreferredContentMap diff mapM_ (uncurry scheduleSet) $ M.toList $ cfgScheduleMap diff +{- Default config has all the keys from the input config, but with their + - default values. -} +defCfg :: Cfg -> Cfg +defCfg curcfg = Cfg + { cfgTrustMap = mapdef $ cfgTrustMap curcfg + , cfgGroupMap = mapdef $ cfgGroupMap curcfg + , cfgPreferredContentMap = mapdef $ cfgPreferredContentMap curcfg + , cfgRequiredContentMap = mapdef $ cfgRequiredContentMap curcfg + , cfgGroupPreferredContentMap = mapdef $ cfgGroupPreferredContentMap curcfg + , cfgScheduleMap = mapdef $ cfgScheduleMap curcfg + } + where + mapdef :: forall k v. Default v => M.Map k v -> M.Map k v + mapdef = M.map (const Data.Default.def) + diffCfg :: Cfg -> Cfg -> Cfg diffCfg curcfg newcfg = Cfg { cfgTrustMap = diff cfgTrustMap @@ -124,7 +142,7 @@ genCfg cfg descs = unlines $ intercalate [""] , com "(Valid trust levels: " ++ trustlevels ++ ")" ] (\(t, u) -> line "trust" u $ showTrustLevel t) - (\u -> lcom $ line "trust" u $ showTrustLevel SemiTrusted) + (\u -> lcom $ line "trust" u $ showTrustLevel Data.Default.def) where trustlevels = unwords $ map showTrustLevel [Trusted .. DeadTrusted] @@ -203,7 +221,7 @@ 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. -} parseCfg :: Cfg -> String -> Either String Cfg -parseCfg curcfg = go [] curcfg . lines +parseCfg defcfg = go [] defcfg . lines where go c cfg [] | null (mapMaybe fst c) = Right cfg diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 047a728f4b..b880f44de7 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -19,6 +19,7 @@ module Logs.Trust ( ) where import qualified Data.Map as M +import Data.Default import Common.Annex import Types.TrustLevel @@ -38,7 +39,7 @@ trustGet level = M.keys . M.filter (== level) <$> trustMap {- Returns the TrustLevel of a given repo UUID. -} lookupTrust :: UUID -> Annex TrustLevel -lookupTrust u = (fromMaybe SemiTrusted . M.lookup u) <$> trustMap +lookupTrust u = (fromMaybe def . M.lookup u) <$> trustMap {- Partitions a list of UUIDs to those matching a TrustLevel and not. -} trustPartition :: TrustLevel -> [UUID] -> Annex ([UUID], [UUID]) diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs index 66c1dd5ef4..a60445a658 100644 --- a/Types/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -9,6 +9,7 @@ module Types.StandardGroups where import Types.Remote (RemoteConfig) import Types.Group +import Data.Default import qualified Data.Map as M import Data.Maybe diff --git a/Types/TrustLevel.hs b/Types/TrustLevel.hs index a72dbb8c62..4af71294ae 100644 --- a/Types/TrustLevel.hs +++ b/Types/TrustLevel.hs @@ -14,6 +14,7 @@ module Types.TrustLevel ( ) where import qualified Data.Map as M +import Data.Default import Types.UUID @@ -22,6 +23,9 @@ import Types.UUID data TrustLevel = Trusted | SemiTrusted | UnTrusted | DeadTrusted deriving (Eq, Enum, Ord, Bounded) +instance Default TrustLevel where + def = SemiTrusted + type TrustMap = M.Map UUID TrustLevel readTrustLevel :: String -> Maybe TrustLevel diff --git a/debian/changelog b/debian/changelog index fc809b4578..4724b63dee 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +git-annex (5.20141014) UNRELEASED; urgency=medium + + * vicfg: Deleting configurations now resets to the default, where + before it has no effect. + + -- Joey Hess Tue, 14 Oct 2014 14:09:24 -0400 + git-annex (5.20141013) unstable; urgency=medium * Adjust cabal file to support building w/o assistant on the hurd. diff --git a/doc/todo/vicfg_comment_gotcha.mdwn b/doc/todo/vicfg_comment_gotcha.mdwn index 33befd383e..910af01a49 100644 --- a/doc/todo/vicfg_comment_gotcha.mdwn +++ b/doc/todo/vicfg_comment_gotcha.mdwn @@ -9,8 +9,12 @@ but that way lies madness. Also, it's not at all clear what the "default" should be in response to such an action. The default varies per type of configuration, and vicfg does't know about defaults. +> [[fixed|done]]; this was a job for Data.Default! --[[Joey]] + Instead, I think it should detect when a setting provided in the input version of the file is not present in the output version, and plop the user back into the editor with an error, telling them that cannot be handled, and suggesting they instead change the value to the value they now want it to have. + +> Nah, too complicated.